# 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.1.1.1 2007/07/10 15:05:18 duncan Exp $ package require tcltest 2.1 namespace import -force tcltest::configure namespace import -force tcltest::testsDirectory configure -testdir [file join [pwd] [file dirname [info script]]] configure -loadfile [file join [testsDirectory] constraints.tcl] tcltest::loadTestedCommands namespace import -force tcltest::makeFile namespace import -force tcltest::removeFile 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 test canvPs-3.1 {test ps generation with an embedded window} {notAqua} { removeFile bar.ps destroy .c pack [canvas .c -width 200 -height 200 -background white] .c create rect 20 20 150 150 -tags rect0 -dash . -width 2 .c create arc 0 50 200 200 -tags arc0 \ -dash {4 4} -stipple question -outline red -fill green image create photo logo \ -file [file join $tk_library images pwrdLogo150.gif] .c create image 200 50 -image logo -anchor nw entry .c.e -background pink -foreground blue -width 14 .c.e insert 0 "we gonna be postscripted" .c create window 50 180 -anchor nw -window .c.e update .c postscript -file bar.ps file exists bar.ps } 1 test canvPs-3.2 {test ps generation with an embedded window not mapped} {} { removeFile bar.ps destroy .c pack [canvas .c -width 200 -height 200 -background white] entry .c.e -background pink -foreground blue -width 14 .c.e insert 0 "we gonna be postscripted" .c create window 50 180 -anchor nw -window .c.e .c postscript -file bar.ps file exists bar.ps } 1 test canvPs-4.1 {test ps generation with single-point uncolored poly, bug 734498} {} { destroy .c pack [canvas .c] .c create poly 10 20 10 20 catch {.c postscript} } 0 # cleanup removeFile foo.ps removeFile bar.ps deleteWindows ::tcltest::cleanupTests return