1# This file creates a screen to exercise Postscript generation
2# for images in canvases.  It is part of the Tk visual test suite,
3# which is invoked via the "visual" script.
4#
5# RCS: @(#) $Id: canvPsImg.tcl,v 1.2 2002/07/12 13:40:59 dgp Exp $
6
7# Build a test image in a canvas
8proc BuildTestImage {} {
9    global BitmapImage PhotoImage visual level
10    catch {destroy .t.f}
11    frame .t.f -visual $visual -colormap new
12    pack .t.f -side top -after .t.top
13    bind .t.f <Enter> {wm colormapwindows .t {.t.f .t}}
14    bind .t.f <Leave> {wm colormapwindows .t {.t .t.f}}
15    canvas .t.f.c -width 550 -height 350 -borderwidth 2 -relief raised
16    pack .t.f.c
17    .t.f.c create rectangle 25 25 525 325 -fill {} -outline black
18    .t.f.c create image 50 50 -anchor nw -image $BitmapImage
19    .t.f.c create image 250 50 -anchor nw -image $PhotoImage
20}
21
22# Put postscript in a file
23proc FilePostscript { canvas } {
24    global level
25    $canvas postscript -file /tmp/test.ps -colormode $level
26}
27
28# Send postscript output to printer
29proc PrintPostcript { canvas } {
30    global level
31    $canvas postscript -file tmp.ps -colormode $level
32    exec lpr tmp.ps
33}
34
35catch {destroy .t}
36toplevel .t
37wm title .t "Postscript Tests for Canvases: Images"
38wm iconname .t "Postscript"
39
40message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets for images.  Click the buttons below to select a Visual type for the canvas and colormode for the Postscript output.  Then click "Print" to send the results to the default printer, or "Print to file" to put the Postscript output in a file called "/tmp/test.ps".  You can also click on items in the canvas to delete them.
41NOTE: Some Postscript printers may not be able to handle Postscript generated in color mode.} -width 6i
42pack .t.m -side top -fill both
43
44frame .t.top
45pack .t.top -side top
46frame .t.top.l -relief raised -borderwidth 2
47frame .t.top.r -relief raised -borderwidth 2
48pack .t.top.l .t.top.r -side left -fill both -expand 1
49
50label .t.visuals -text "Visuals"
51pack .t.visuals -in .t.top.l
52
53set visual [lindex [winfo visualsavailable .] 0]
54foreach v [winfo visualsavailable .] {
55    # The hack below is necessary for some systems, which have more than one
56    # visual of the same type...
57    if {![winfo exists .t.$v]} {
58        radiobutton .t.$v -text $v -variable visual -value $v \
59		-command BuildTestImage
60        pack .t.$v -in .t.top.l -anchor w
61    }
62}
63
64label .t.levels -text "Color Levels"
65pack .t.levels -in .t.top.r
66set level monochrome
67foreach l { monochrome gray color } {
68    radiobutton .t.$l -text $l -variable level -value $l
69    pack .t.$l -in .t.top.r -anchor w
70}
71
72set BitmapImage [image create bitmap -file $tk_library/demos/images/face.bmp \
73	-background white -foreground black]
74set PhotoImage [image create photo -file $tk_library/demos/images/teapot.ppm]
75
76BuildTestImage
77
78frame .t.bot
79pack .t.bot -side top -fill x -expand 1
80
81button .t.file -text "Print to File" -command { FilePostscript .t.f.c }
82button .t.print -text "Print" -command { PrintPostscript .t.f.c }
83button .t.quit -text "Quit" -command { destroy .t }
84pack .t.file .t.print .t.quit -in .t.bot -side left -fill x -expand 1
85