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