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