aboutsummaryrefslogtreecommitdiff
path: root/demos/zinc-widget
blob: 1ff1f05ffdbd723462a6cc3c6f5da86171748c12 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
#!/bin/sh
# the next line restarts using wish \
    exec wish "$0" "$@"

#
# Locate the zinc top level directory.
#
set zincRoot [file join [file dirname [info script]] ..]

#
# And adjust the paths accordingly.
#
lappend auto_path $zincRoot
set zinc_library $zincRoot

package require Tkzinc 3.2
set zincVersion [lindex [zinc] 0]

eval destroy [winfo child .]
wm title . "Zinc Widget Demonstration"
set zincDemo	1

set font {Helvetica 14}

menu .menuBar -tearoff 0
.menuBar add cascade -menu .menuBar.file -label File -underline 0
menu .menuBar.file -tearoff 0

.menuBar.file add command -label "About..." -command "aboutBox" \
    -underline 0 -accelerator "<F1>"
.menuBar.file add sep
.menuBar.file add command -label Quit -command exit -underline 0 \
    -accelerator Meta-Q
. configure -menu .menuBar
bind . <F1> aboutBox

frame .statusBar
label .statusBar.lab -text " " -relief sunken -bd 1 \
    -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
label .statusBar.foo -width 8 -relief sunken -bd 1 \
    -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
pack .statusBar.lab -side left -padx 2 -expand yes -fill both
pack .statusBar.foo -side left -padx 2
pack .statusBar -side bottom -fill x -pady 2

frame .textFrame
scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \
    -takefocus 1
pack .s -in .textFrame -side right -fill y
text .t -yscrollcommand {.s set} -wrap word -width 60 -height 30 -font $font \
    -setgrid 1 -highlightthickness 0 -padx 4 -pady 2 -takefocus 0
pack .t -in .textFrame -expand y -fill both -padx 1
pack .textFrame -expand yes -fill both

# Create a bunch of tags to use in the text widget, such as those for
# section titles and demo descriptions. Also define the bindings for
# tags.

.t tag configure title -font {Helvetica 18 bold}

# We put some "space" characters to the left and right of each demo description
# so that the descriptions are highlighted only when the mouse cursor
# is right over them (but not when the cursor is to their left or right)
#
.t tag configure demospace -lmargin1 1c -lmargin2 1c


if {[winfo depth .] == 1} {
    .t tag configure demo -lmargin1 1c -lmargin2 1c -underline 1
    .t tag configure visited -lmargin1 1c -lmargin2 1c \
	-underline 1
    .t tag configure hot -background black -foreground white
} else {
    .t tag configure demo -lmargin1 1c -lmargin2 1c \
	-foreground blue -underline 1
    .t tag configure visited -lmargin1 1c -lmargin2 1c \
	-foreground #303080 -underline 1
    .t tag configure hot -foreground red -underline 1
}
.t tag bind demo <ButtonRelease-1> {
    invoke [.t index {@%x,%y}]
}
set lastLine ""
.t tag bind demo <Enter> {
    set lastLine [.t index {@%x,%y linestart}]
    .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
    .t config -cursor hand2
    showStatus [.t index {@%x,%y}]
}
.t tag bind demo <Leave> {
    .t tag remove hot 1.0 end
    .t config -cursor xterm
    .statusBar.lab config -text ""
}
.t tag bind demo <Motion> {
    set newLine [.t index {@%x,%y linestart}]
    if {[string compare $newLine $lastLine] != 0} {
	.t tag remove hot 1.0 end
	set lastLine $newLine

	set tags [.t tag names {@%x,%y}]
	set i [lsearch -glob $tags demo-*]
	if {$i >= 0} {
	    .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
	}
    }
    showStatus [.t index {@%x,%y}]
}

# Create the text for the text widget.

.t insert end "Zinc/Tk Widget Demonstrations $zincVersion\n" title
.t insert end {
    This application provides a front end for several short scripts in Tcl/Tk that demonstrate what you can do with the TkZinc widget. Each of the numbered lines below describes a demonstration; you can click on it to invoke the demonstration. Once the demonstration window appears, you can click the "See Code" button to see the Tcl/Tk code that created the demonstration.
}
.t insert end "\n" {} "Small applications\n" title
.t insert end "1. The famous tiger (better with openGL).\n" {demo demo-tiger}
.t insert end "2. A toy radar display.\n" {demo demo-simpleRadar}
.t insert end "3. ATC electronic strips demo (better with openGL).\n" {demo demo-groupsInAtcStrips}
.t insert end "3. A magic lens simulation (need openGL).\n" {demo demo-magicLens}
.t insert end "4. A demo of the Graphics tcl module (based on curves).\n" {demo demo-testGraphics}

.t insert end "\n" {} "All Items\n" title
.t insert end "1. Exemples of all items.\n" {demo demo-items}
.t insert end "2. All items options (and their types).\n" {demo demo-allOptions}
.t insert end "3. Examples of line style and line termination.\n" {demo demo-lines}
.t insert end "4. Curves with multiple contours.\n" {demo demo-contours}
.t insert end "7. Curves with cubic bezier control points.\n" {demo demo-curveBezier}
.t insert end "8. Curves with multiple contours and various fillrule.\n" {demo demo-fillRule}

.t insert end "\n" {} "Groups, Priority, Clipping and PathTags\n" title
.t insert end "1. Groups and Priorities.\n" {demo demo-groupsPriority}
.t insert end "2. Clipping examples (with simple or multiple contours).\n" {demo demo-clipping}
.t insert end "3. Group atomicity.\n" {demo demo-atomicGroups}
.t insert end "4. \"Windows\" with four glasses using curve with multiple contours.\n" {demo demo-windowContours}
.t insert end "5. Pathtags demonstration.\n" {demo demo-pathTags}

.t insert end "\n" {} "Transformation\n" title
.t insert end "1. Transformation testbed.\n" {demo demo-transforms}

.t insert end "\n" {} "Use of open GL\n" title
.t insert end "1. The TkZinc Logo.\n" {demo demo-tkZincLogo}
.t insert end "2. Applying transformations to an icon.\n" {demo demo-iconTransform}
.t insert end "3. Using the alpha information from an image (Need Img ext.).\n" {demo demo-photoAlpha}
.t insert end "4. Axial color variation on the X axis.\n" {demo demo-colorX}
.t insert end "5. Axial color variation on the Y axis.\n" {demo demo-colorY}
.t insert end "6. Circular color variation.\n" {demo demo-colorCircular}
.t insert end "7. The triangles item.\n" {demo demo-triangles}
.t insert end "8. Relief testbed.\n" {demo demo-reliefs}

.t insert end "\n" {} "ATC oriented features and items\n" title
.t insert end "1. Examples of labelformat.\n" {demo demo-labelformat}
.t insert end "2. Simple interaction on a track.\n" {demo demo-simpleInteractionTrack}
.t insert end "3. Text input in a text item and a track item.\n" {demo demo-textInput}

.t configure -state disabled
focus .s

# positionWindow --
# This procedure is invoked by most of the demos to position a
# new demo window.
#
# Arguments:
# w -		The name of the window to position.

proc positionWindow w {
    wm geometry $w +300+300
}

# showVars --
# Displays the values of one or more variables in a window, and
# updates the display whenever any of the variables changes.
#
# Arguments:
# w -		Name of new window to create for display.
# args -	Any number of names of variables.

proc showVars {w args} {
    catch {destroy $w}
    toplevel $w
    wm title $w "Variable values"
    label $w.title -text "Variable values:" -width 20 -anchor center \
	-font {Helvetica 18}
    pack $w.title -side top -fill x
    set len 1
    foreach i $args {
	if {[string length $i] > $len} {
	    set len [string length $i]
	}
    }
    foreach i $args {
	frame $w.$i
	label $w.$i.name -text "$i: " -width [expr $len + 2] -anchor w
	label $w.$i.value -textvar $i -anchor w
	pack $w.$i.name -side left
	pack $w.$i.value -side left -expand 1 -fill x
	pack $w.$i -side top -anchor w -fill x
    }
    button $w.ok -text OK -command "destroy $w" -default active
    bind $w <Return> "tkButtonInvoke $w.ok"
    pack $w.ok -side bottom -pady 2
}

# invoke --
# This procedure is called when the user clicks on a demo description.
# It is responsible for invoking the demonstration.
#
# Arguments:
# index -	The index of the character that the user clicked on.

proc invoke index {
    global zinc_library

    set tags [.t tag names $index]
    set i [lsearch -glob $tags demo-*]
    if {$i < 0} {
	return
    }
    set cursor [.t cget -cursor]
    .t configure -cursor watch
    update
    set demo [string range [lindex $tags $i] 5 end]
    uplevel [list source [file join $zinc_library demos $demo.tcl]]
    update
    .t configure -cursor $cursor

    .t tag add visited "$index linestart +1 chars" "$index lineend -1 chars"
}

# showStatus --
#
#	Show the name of the demo program in the status bar. This procedure
#	is called when the user moves the cursor over a demo description.
#
proc showStatus index {
    global zinc_library
    set tags [.t tag names $index]
    set i [lsearch -glob $tags demo-*]
    set cursor [.t cget -cursor]
    if {$i < 0} {
	.statusBar.lab config -text " "
	set newcursor xterm
    } else {
	set demo [string range [lindex $tags $i] 5 end]
	.statusBar.lab config -text "Run the \"$demo\" sample program"
	set newcursor hand2
    }
    if [string compare $cursor $newcursor] {
	.t config -cursor $newcursor
    }
}


# showCode --
# This procedure creates a toplevel window that displays the code for
# a demonstration and allows it to be edited and reinvoked.
#
# Arguments:
# w -		The name of the demonstration's window, which can be
#		used to derive the name of the file containing its code.

proc showCode w {
    global zinc_library
    set file [string range $w 1 end].tcl
    if ![winfo exists .code] {
	toplevel .code
	frame .code.buttons
	pack .code.buttons -side bottom -fill x
	button .code.buttons.dismiss -text Dismiss \
	    -default active -command "destroy .code"
	button .code.buttons.rerun -text "Rerun Demo" -command {
	    eval [.code.text get 1.0 end]
	}
	pack .code.buttons.dismiss .code.buttons.rerun -side left \
	    -expand 1 -pady 2
	frame .code.frame
	pack .code.frame -expand yes -fill both -padx 1 -pady 1
	text .code.text -height 40 -wrap word\
	    -xscrollcommand ".code.xscroll set" \
	    -yscrollcommand ".code.yscroll set" \
	    -setgrid 1 -highlightthickness 0 -pady 2 -padx 3
	scrollbar .code.xscroll -command ".code.text xview" \
	    -highlightthickness 0 -orient horizontal
	scrollbar .code.yscroll -command ".code.text yview" \
	    -highlightthickness 0 -orient vertical

	grid .code.text -in .code.frame -padx 1 -pady 1 \
	    -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
	grid .code.yscroll -in .code.frame -padx 1 -pady 1 \
	    -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
	#	grid .code.xscroll -in .code.frame -padx 1 -pady 1 \
	    #	 -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
	grid rowconfig .code.frame 0 -weight 1 -minsize 0
	grid columnconfig .code.frame 0 -weight 1 -minsize 0
    } else {
	wm deiconify .code
	raise .code
    }
    wm title .code "Demo code: [file join $zinc_library demos $file]"
    wm iconname .code $file
    set id [open [file join $zinc_library demos $file]]
    .code.text delete 1.0 end
    .code.text insert 1.0 [read $id]
    .code.text mark set insert 1.0
    close $id
}

# aboutBox --
#
#	Pops up a message box with an "about" message
#
proc aboutBox {} {
    tk_messageBox -icon info -type ok -title "About Zinc Demo" -message \
	"Tkzinc widget demonstration\n\n\
Copyright (c) 2003 CENA\n\n
The demo framework \n
Copyright (c) 1996-1997 Sun Microsystems, Inc."
    }