# 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. # # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # # RCS: @(#) $Id: canvPs.test,v 1.2 1998/09/14 18:23:43 stanton Exp $ if {[info procs test] != "test"} { source defs } 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 # Clean-up removeFile foo.ps removeFile bar.ps foreach i [winfo children .] { destroy $i }