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$ 10 11package require tcltest 2.1 12eval tcltest::configure $argv 13tcltest::loadTestedCommands 14 15canvas .c -width 400 -height 300 -bd 2 -relief sunken 16.c create rectangle 20 20 80 80 -fill red 17pack .c 18update 19 20test canvPs-1.1 {test writing to a file} -constraints { 21 unixOrPc 22} -setup { 23 set foo [makeFile {} foo.ps] 24} -body { 25 .c postscript -file $foo 26 file exists $foo 27} -cleanup { 28 removeFile foo.ps 29} -result 1 30test canvPs-1.2 {test writing to a file, idempotency} -constraints { 31 unixOrPc 32} -setup { 33 set foo [makeFile {} foo.ps] 34 set bar [makeFile {} bar.ps] 35} -body { 36 .c postscript -file $foo 37 .c postscript -file $bar 38 set status ok 39 if {[file size $bar] != [file size $foo]} { 40 set status broken 41 } 42 set status 43} -cleanup { 44 removeFile foo.ps 45 removeFile bar.ps 46} -result ok 47 48test canvPs-2.1 {test writing to a channel} -constraints { 49 unixOrPc 50} -setup { 51 set foo [makeFile {} foo.ps] 52 file delete $foo 53} -body { 54 set chan [open $foo w] 55 fconfigure $chan -translation lf 56 .c postscript -channel $chan 57 close $chan 58 file exists $foo 59} -cleanup { 60 removeFile foo.ps 61} -result 1 62test canvPs-2.2 {test writing to channel, idempotency} -constraints { 63 unixOrPc 64} -setup { 65 set foo [makeFile {} foo.ps] 66 set bar [makeFile {} bar.ps] 67 file delete $foo 68 file delete $bar 69} -body { 70 set c1 [open $foo w] 71 set c2 [open $bar w] 72 fconfigure $c1 -translation lf 73 fconfigure $c2 -translation lf 74 .c postscript -channel $c1 75 .c postscript -channel $c2 76 close $c1 77 close $c2 78 set status ok 79 if {[file size $bar] != [file size $foo]} { 80 set status broken 81 } 82 set status 83} -cleanup { 84 removeFile foo.ps 85 removeFile bar.ps 86} -result ok 87test canvPs-2.3 {test writing to channel and file, same output} -constraints { 88 unix 89} -setup { 90 set foo [makeFile {} foo.ps] 91 set bar [makeFile {} bar.ps] 92 file delete $foo 93 file delete $bar 94} -body { 95 set c1 [open $foo w] 96 fconfigure $c1 -translation lf 97 .c postscript -channel $c1 98 close $c1 99 .c postscript -file $bar 100 set status ok 101 if {[file size $foo] != [file size $bar]} { 102 set status broken 103 } 104 set status 105} -cleanup { 106 removeFile foo.ps 107 removeFile bar.ps 108} -result ok 109test canvPs-2.4 {test writing to channel and file, same output} -constraints { 110 win 111} -setup { 112 set foo [makeFile {} foo.ps] 113 set bar [makeFile {} bar.ps] 114 file delete $foo 115 file delete $bar 116} -body { 117 set c1 [open $foo w] 118 fconfigure $c1 -translation crlf 119 .c postscript -channel $c1 120 close $c1 121 .c postscript -file $bar 122 set status ok 123 if {[file size $foo] != [file size $bar]} { 124 set status broken 125 } 126 set status 127} -cleanup { 128 removeFile foo.ps 129 removeFile bar.ps 130} -result ok 131 132test canvPs-3.1 {test ps generation with an embedded window} -setup { 133 set bar [makeFile {} bar.ps] 134 file delete $bar 135} -constraints { 136 notAqua 137} -body { 138 destroy .c 139 pack [canvas .c -width 200 -height 200 -background white] 140 .c create rect 20 20 150 150 -tags rect0 -dash . -width 2 141 .c create arc 0 50 200 200 -tags arc0 \ 142 -dash {4 4} -stipple question -outline red -fill green 143 144 image create photo logo \ 145 -file [file join [file dirname [info script]] pwrdLogo150.gif] 146 .c create image 200 50 -image logo -anchor nw 147 148 entry .c.e -background pink -foreground blue -width 14 149 .c.e insert 0 "we gonna be postscripted" 150 .c create window 50 180 -anchor nw -window .c.e 151 update 152 .c postscript -file $bar 153 file exists $bar 154} -cleanup { 155 removeFile bar.ps 156} -result 1 157test canvPs-3.2 {test ps generation with an embedded window not mapped} -setup { 158 set bar [makeFile {} bar.ps] 159 file delete $bar 160} -body { 161 destroy .c 162 pack [canvas .c -width 200 -height 200 -background white] 163 entry .c.e -background pink -foreground blue -width 14 164 .c.e insert 0 "we gonna be postscripted" 165 .c create window 50 180 -anchor nw -window .c.e 166 .c postscript -file $bar 167 file exists $bar 168} -cleanup { 169 removeFile bar.ps 170} -result 1 171 172test canvPs-4.1 {test ps generation with single-point uncolored poly, bug 734498} {} { 173 destroy .c 174 pack [canvas .c] 175 .c create poly 10 20 10 20 176 catch {.c postscript} 177} 0 178 179# cleanup 180unset -nocomplain foo bar 181deleteWindows 182cleanupTests 183return 184