# This file is a Tcl script to test out procedures to write postscript
# for canvases to files and channels. It exercises the procedure
# TkCanvPostscriptCmd in generic/tkCanvPs.c
#
# Copyright (c) 1995 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @(#) $Id: canvPs.test,v 1.3 1999/04/16 01:51:34 stanton Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .

canvas .c -width 400 -height 300 -bd 2 -relief sunken
.c create rectangle 20 20 80 80 -fill red
pack .c
update

test canvPs-1.1 {test writing to a file} {unixOrPc} {
    removeFile foo.ps
    .c postscript -file foo.ps
    file exists foo.ps
} 1
test canvPs-1.2 {test writing to a file, idempotency} {unixOrPc} {
    removeFile foo.ps
    removeFile bar.ps
    .c postscript -file foo.ps
    .c postscript -file bar.ps
    set status ok
    if {[file size bar.ps] != [file size foo.ps]} {
	set status broken
    }
    set status
} ok

test canvPs-2.1 {test writing to a channel} {unixOrPc} {
    removeFile foo.ps
    set chan [open foo.ps w]
    fconfigure $chan -translation lf
    .c postscript -channel $chan
    close $chan
    file exists foo.ps
} 1
test canvPs-2.2 {test writing to channel, idempotency} {unixOrPc} {
    removeFile foo.ps
    removeFile bar.ps
    set c1 [open foo.ps w]
    set c2 [open bar.ps w]
    fconfigure $c1 -translation lf
    fconfigure $c2 -translation lf
    .c postscript -channel $c1
    .c postscript -channel $c2
    close $c1
    close $c2
    set status ok
    if {[file size bar.ps] != [file size foo.ps]} {
	set status broken
    }
    set status
} ok
test canvPs-2.3 {test writing to channel and file, same output} {unixOnly} {
    removeFile foo.ps
    removeFile bar.ps
    set c1 [open foo.ps w]
    fconfigure $c1 -translation lf
    .c postscript -channel $c1
    close $c1
    .c postscript -file bar.ps
    set status ok
    if {[file size foo.ps] != [file size bar.ps]} {
	set status broken
    }
    set status
} ok
test canvPs-2.4 {test writing to channel and file, same output} {pcOnly} {
    removeFile foo.ps
    removeFile bar.ps
    set c1 [open foo.ps w]
    fconfigure $c1 -translation crlf
    .c postscript -channel $c1
    close $c1
    .c postscript -file bar.ps
    set status ok
    if {[file size foo.ps] != [file size bar.ps]} {
	set status broken
    }
    set status
} ok

# cleanup
removeFile foo.ps
removeFile bar.ps
foreach i [winfo children .] {
    destroy $i
}
::tcltest::cleanupTests
return