1# This file creates a screen to exercise Postscript generation
2# for some of the graphical objects in canvases.  It is part of the Tk
3# visual test suite, which is invoked via the "visual" script.
4#
5# RCS: @(#) $Id: canvPsGrph.tcl,v 1.3 1999/04/16 01:51:35 stanton Exp $
6
7catch {destroy .t}
8toplevel .t
9wm title .t "Postscript Tests for Canvases"
10wm iconname .t "Postscript"
11wm geom .t +0+0
12wm minsize .t 1 1
13
14set c .t.mid.c
15
16message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets.  Select what you want to display with the buttons below, then click on "Print" to print it to your default printer.  You can click on items in the canvas to delete them.} -width 4i
17pack .t.m -side top -fill both
18
19frame .t.top
20pack .t.top -side top -fill both
21set what rect
22radiobutton .t.top.rect -text Rectangles -variable what -value rect \
23	-command "mkObjs $c" -relief flat
24radiobutton .t.top.oval -text Ovals -variable what -value oval \
25	-command "mkObjs $c" -relief flat
26radiobutton .t.top.poly -text Polygons -variable what -value poly \
27	-command "mkObjs $c" -relief flat
28radiobutton .t.top.line -text Lines -variable what -value line \
29	-command "mkObjs $c" -relief flat
30pack .t.top.rect .t.top.oval .t.top.poly .t.top.line \
31	-side left -pady 2m -ipadx 2m -ipady 1m -expand 1
32
33frame .t.bot
34pack .t.bot -side bottom -fill both
35button .t.bot.quit -text Quit -command {destroy .t}
36button .t.bot.print -text Print -command "lpr $c"
37pack .t.bot.print .t.bot.quit -side left -pady 1m -expand 1
38
39frame .t.mid -relief sunken -bd 2
40pack .t.mid -side top -expand yes -fill both -padx 2m -pady 2m
41canvas $c -width 400 -height 350 -bd 0 -relief sunken
42pack $c -expand yes -fill both -padx 1 -pady 1
43
44proc mkObjs c {
45    global what
46    $c delete all
47    if {$what == "rect"} {
48	$c create rect 0 0 400 350 -outline black
49	$c create rect 2 2 100 50 -fill black -stipple gray25
50	$c create rect -20 180 80 320 -fill black -stipple gray50 -width .5c
51	$c create rect 200 -20 240 20 -fill black
52	$c create rect 380 200 420 240 -fill black
53	$c create rect 200 330 240 370 -fill black
54    }
55
56    if {$what == "oval"} {
57	$c create oval 50 10 150 80 -fill black -stipple gray25 -outline {}
58	$c create oval 100 100 200 150 -outline {} -fill black -stipple gray50
59	$c create oval 250 100 400 300 -width .5c
60    }
61
62    if {$what == "poly"} {
63	$c create poly 100 200 200 50 300 200 -smooth yes -stipple gray25 \
64		-outline black -width 4
65	$c create poly 100 300 100 250 350 250 350 300 350 300 100 300 100 300 \
66		-fill red -smooth yes
67	$c create poly 20 10 40 10 40 60 80 60 80 25 30 25 30 \
68		35 50 35 50 45 20 45
69	$c create poly 300 20 300 120 380 80 320 100 -fill blue -outline black
70	$c create poly 20 200 100 220 90 100 40 250 \
71		-fill {} -outline brown -width 3
72    }
73
74    if {$what == "line"} {
75	$c create line 20 20 120 20 -arrow both -width 5
76	$c create line 20 80 150 80 20 200 150 200 -smooth yes
77	$c create line 150 20 150 150 250 150 -width .5c -smooth yes \
78		-arrow both -arrowshape {.75c 1.0c .5c} -stipple gray25
79	$c create line 50 340 100 250 150 340 -join round -cap round -width 10
80	$c create line 200 340 250 250 300 340 -join bevel -cap project \
81		-width 10
82	$c create line 300 20 380 20 300 150 380 150 -join miter -cap butt \
83		-width 10 -stipple gray25
84    }
85}
86
87mkObjs $c
88
89
90
91
92
93
94
95
96
97
98
99
100
101