1# This file is a Tcl script to test out procedures to write postscript 2# for canvases to files and channels. It exercises the procedure 3# TkCanvPostscriptCmd in generic/tkCanvPs.c 4# 5# Copyright (c) 1995 Sun Microsystems, Inc. 6# Copyright (c) 1998-1999 by Scriptics Corporation. 7# All rights reserved. 8# 9# RCS: @(#) $Id: canvPs.test,v 1.5.2.2 2006/03/14 04:59:44 dgp Exp $ 10 11package require tcltest 2.1 12namespace import -force tcltest::configure 13namespace import -force tcltest::testsDirectory 14configure -testdir [file join [pwd] [file dirname [info script]]] 15configure -loadfile [file join [testsDirectory] constraints.tcl] 16tcltest::loadTestedCommands 17 18namespace import -force tcltest::makeFile 19namespace import -force tcltest::removeFile 20 21canvas .c -width 400 -height 300 -bd 2 -relief sunken 22.c create rectangle 20 20 80 80 -fill red 23pack .c 24update 25 26test canvPs-1.1 {test writing to a file} {unixOrPc} { 27 removeFile foo.ps 28 .c postscript -file foo.ps 29 file exists foo.ps 30} 1 31test canvPs-1.2 {test writing to a file, idempotency} {unixOrPc} { 32 removeFile foo.ps 33 removeFile bar.ps 34 .c postscript -file foo.ps 35 .c postscript -file bar.ps 36 set status ok 37 if {[file size bar.ps] != [file size foo.ps]} { 38 set status broken 39 } 40 set status 41} ok 42 43test canvPs-2.1 {test writing to a channel} {unixOrPc} { 44 removeFile foo.ps 45 set chan [open foo.ps w] 46 fconfigure $chan -translation lf 47 .c postscript -channel $chan 48 close $chan 49 file exists foo.ps 50} 1 51test canvPs-2.2 {test writing to channel, idempotency} {unixOrPc} { 52 removeFile foo.ps 53 removeFile bar.ps 54 set c1 [open foo.ps w] 55 set c2 [open bar.ps w] 56 fconfigure $c1 -translation lf 57 fconfigure $c2 -translation lf 58 .c postscript -channel $c1 59 .c postscript -channel $c2 60 close $c1 61 close $c2 62 set status ok 63 if {[file size bar.ps] != [file size foo.ps]} { 64 set status broken 65 } 66 set status 67} ok 68test canvPs-2.3 {test writing to channel and file, same output} {unixOnly} { 69 removeFile foo.ps 70 removeFile bar.ps 71 set c1 [open foo.ps w] 72 fconfigure $c1 -translation lf 73 .c postscript -channel $c1 74 close $c1 75 .c postscript -file bar.ps 76 set status ok 77 if {[file size foo.ps] != [file size bar.ps]} { 78 set status broken 79 } 80 set status 81} ok 82test canvPs-2.4 {test writing to channel and file, same output} {pcOnly} { 83 removeFile foo.ps 84 removeFile bar.ps 85 set c1 [open foo.ps w] 86 fconfigure $c1 -translation crlf 87 .c postscript -channel $c1 88 close $c1 89 .c postscript -file bar.ps 90 set status ok 91 if {[file size foo.ps] != [file size bar.ps]} { 92 set status broken 93 } 94 set status 95} ok 96 97test canvPs-3.1 {test ps generation with an embedded window} {notAqua} { 98 removeFile bar.ps 99 destroy .c 100 pack [canvas .c -width 200 -height 200 -background white] 101 .c create rect 20 20 150 150 -tags rect0 -dash . -width 2 102 .c create arc 0 50 200 200 -tags arc0 \ 103 -dash {4 4} -stipple question -outline red -fill green 104 105 image create photo logo \ 106 -file [file join $tk_library images pwrdLogo150.gif] 107 .c create image 200 50 -image logo -anchor nw 108 109 entry .c.e -background pink -foreground blue -width 14 110 .c.e insert 0 "we gonna be postscripted" 111 .c create window 50 180 -anchor nw -window .c.e 112 update 113 .c postscript -file bar.ps 114 file exists bar.ps 115} 1 116test canvPs-3.2 {test ps generation with an embedded window not mapped} {} { 117 removeFile bar.ps 118 destroy .c 119 pack [canvas .c -width 200 -height 200 -background white] 120 entry .c.e -background pink -foreground blue -width 14 121 .c.e insert 0 "we gonna be postscripted" 122 .c create window 50 180 -anchor nw -window .c.e 123 .c postscript -file bar.ps 124 file exists bar.ps 125} 1 126 127test canvPs-4.1 {test ps generation with single-point uncolored poly, bug 734498} {} { 128 destroy .c 129 pack [canvas .c] 130 .c create poly 10 20 10 20 131 catch {.c postscript} 132} 0 133 134# cleanup 135removeFile foo.ps 136removeFile bar.ps 137deleteWindows 138::tcltest::cleanupTests 139return 140