aboutsummaryrefslogtreecommitdiff
path: root/demos/transforms.tcl
blob: be0273ef3f467be69336c243f1c83548e34699ec (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
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
# $Id$
# This simple demo has been developped by P. Lecoanet <lecoanet@cena.fr>

#
# TODO:
#
# Add the building of missing items
#

if {![info exists zincDemo]} {
    error "This script should be run from the zinc-widget demo."
}

set w .transforms
catch {destroy $w}
toplevel $w
wm title $w "Zinc Transformation Demonstration"
wm iconname $w Transformation

set defaultfont [font create -family Helvetica -size 10 -weight bold]

frame $w.buttons
pack $w.buttons -side bottom -fill x -pady 2m
button $w.buttons.dismiss -text Dismiss -command "destroy $w"
button $w.buttons.code -text "See Code" -command "showCode $w"
pack $w.buttons.dismiss $w.buttons.code -side left -expand 1


###########################################
# Text zone
###########################################
text $w.text -relief sunken -borderwidth 2 -setgrid true -height 12

pack $w.text -expand yes -fill x

$w.text insert 0.0 {Items are always added to the current group.
The available commands are:
   Button 1       on the background, add an item with initial translation
   Button 2       on the background, add a group with initial translation
   Button 1       on item/group axes, select/deselect that item space
   Drag Button 1  on item/group axes, translate that item space
   Del            reset the transformation
   Shift-Del      reset a group direct children transformations
   PageUp/Down    scale up/down
   End/Home       rotate right/left
   Ins            swap the Y axis
   4 arrows       translate in the 4 directions}
$w.text configure -state disabled

###########################################
# Zinc
###########################################
set zinc_width 600
set zinc_height 500;
zinc $w.zinc -width $zinc_width -height $zinc_height \
    -font 10x20 -borderwidth 3 -relief sunken -takefocus 1 -render 0
pack $w.zinc -expand y -fill both


set top 1

set inactiveAxisColor black
set activeAxisColor red
set worldAxisColor \#a5a5a5

set composeRot 1
set composeScale 1
set drag 0
set itemType Rectangle
set currentItem 0

image create photo logo -file [file join $zinc_library demos images zinc.gif]

frame $w.f
pack $w.f -expand 0 -fill x

tk_optionMenu $w.f.types itemType Rectangle Arc Curve Icon Tabular \
    Text Track Triangles WayPoint
grid $w.f.types -row 0 -column 1 -sticky w

button $w.f.add -text {Add item} -command addItem
grid $w.f.add -row 0 -column 2 -padx 10 -sticky ew

button $w.f.addg -text {Add group} -command addGroup
grid $w.f.addg -row 0 -column 3 -padx 10 -sticky ew

button $w.f.remove -text Remove -command removeItem
grid $w.f.remove -row 0 -column 4 -padx 10 -sticky ew

checkbutton $w.f.cscale -text -composescale -command toggleComposeScale \
    -variable composeScale
grid $w.f.cscale -row 0 -column 6 -sticky w

checkbutton $w.f.crot -text -composesrotation -command toggleComposeRot \
    -variable composeRot
grid $w.f.crot -row 1 -column 6 -sticky w


set world [$w.zinc add group $top]
set currentGroup $world
$w.zinc add curve $top {0 0 80 0} -linewidth 3 \
    -linecolor $worldAxisColor -lastend {6 8 3} -tags "axis:$world"
$w.zinc add curve $top {0 0 0 80} -linewidth 3 \
    -linecolor $worldAxisColor -lastend {6 8 3} -tags "axis:$world"
$w.zinc add rectangle $top {-2 -2 2 2} -filled 1 \
    -fillcolor $worldAxisColor -linecolor $worldAxisColor \
    -linewidth 3 -tags "axis:$world"
$w.zinc add text $top -text "This is the origin\nof the world" \
    -anchor s -color $worldAxisColor -alignment center \
    -tags [list "axis:$world" text]


bind $w.zinc <1> "mouseAdd Item %x %y"
bind $w.zinc <2> "mouseAdd Group %x %y"
bind $w.zinc <Up> moveUp
bind $w.zinc <Left> moveLeft
bind $w.zinc <Right> moveRight
bind $w.zinc <Down> moveDown
bind $w.zinc <Next> scaleDown
bind $w.zinc <Prior> scaleUp
bind $w.zinc <Delete> reset
bind $w.zinc <Shift-Delete> resetChildren
bind $w.zinc <End> rotateLeft
bind $w.zinc <Home> rotateRight
bind $w.zinc <Insert> swapAxis

bind $w.zinc <Configure> "resize %w %h"

focus $w.zinc
tk_focusFollowsMouse


proc resize {width height} {
    global w world

    set x [expr $width/2]
    set y [expr $height/2]
    
    $w.zinc treset $world
    $w.zinc treset "axis:$world"
    $w.zinc translate $world $x $y
    $w.zinc translate "axis:$world" $x $y
}

proc swapAxis {} {
    global w currentItem

    if {$currentItem != 0} {
	$w.zinc scale $currentitem 1 -1
	$w.zinc scale "axisgrp:$currentItem" 1 -1
    }
}

proc toggleComposeRot {} {
    global w currentItem composeRot

    if {$currentItem != 0} {
    $w.zinc itemconfigure $currentItem -composerotation $composeRot
    $w.zinc itemconfigure "axisgrp:$currentItem" -composerotation $composeRot
  }
}

proc toggleComposeScale {} {
    global w currentItem composeScale
    
    if {$currentItem != 0} {
	$w.zinc itemconfigure $currentItem -composescale $composeScale
	$w.zinc itemconfigure "axisgrp:$currentItem" -composescale $composeScale
    }
}

proc dragItem {x y} {
    global w drag currentItem

    set drag 1
    if {$currentItem == 0} {
	return
    }
    
    set group [$w.zinc group $currentItem]
    foreach {x y} [$w.zinc transform $group "$x $y"] break
    
    $w.zinc treset $currentItem
    $w.zinc treset "axisgrp:$currentItem"
    $w.zinc translate $currentItem $x $y
    $w.zinc translate "axisgrp:$currentItem" $x $y
}

proc select {} {
    global w
    
    foreach t [$w.zinc gettags current] {
	if {[regexp {^axis:(\d+)} $t m item]} {
	    changeItem $item
	}
    }
}

proc changeItem {item} {
    global w currentItem currentGroup
    global drag activeAxisColor inactiveAxisColor

    if {($currentItem != 0) && !$drag} {
	$w.zinc itemconfigure "axis:$currentItem && !text" \
	    -linecolor $inactiveAxisColor -fillcolor $inactiveAxisColor
	if {$currentItem != $currentGroup} {
	    $w.zinc itemconfigure "axis:$currentItem && !text" -linewidth 1
	}
    }
    if {($currentItem == 0) || ($item != $currentItem)} {
	$w.zinc itemconfigure "axis:$item && !text" \
	    -linecolor $activeAxisColor -fillcolor $activeAxisColor -linewidth 3
	set currentItem $item
	set composeRot [$w.zinc itemcget $currentItem -composerotation]
	$w.zinc itemconfigure "axisgrp:$currentItem" -composerotation $composeRot
	set composeScale [$w.zinc itemcget $currentItem -composescale]
	$w.zinc itemconfigure "axisgrp:$currentItem" -composescale $composeScale
    } elseif {!$drag} {
	set currentItem 0
	set composeRot 1
	set composeScale 1
    }
    set drag 0
}

proc selectGroup {} {
    global w

    foreach t [$w.zinc gettags current] {
	if {[regexp {^axis:(\d+)} $t m item]} {
	    changeGroup $item
	}
    }
}

proc changeGroup {grp} {
    global w currentItem currentGroup world
    
    changeItem $grp
    $w.zinc itemconfigure "axis:$currentGroup && !text" -linewidth 1
    if {$currentItem != 0} {
	set currentGroup $currentItem
    } else {
	set currentGroup $world
    }

    $w.zinc itemconfigure "axis:$currentGroup && !text" -linewidth 3
}

proc reset {} {
    global w currentItem

    if {$currentItem != 0} {
	$w.zinc treset $currentItem
	$w.zinc treset "axisgrp:$currentItem"
    }
}

proc resetChildren {} {
    global w currentItem

    if {($currentItem != 0) && ([$w.zinc type $currentItem] == "group")} {
	$w.zinc addtag rt withtag all $currentItem 0
	$w.zinc treset rt
	$w.zinc dtag rt rt
    }
}

proc moveUp {} {
  move 0 20
}

proc moveDown {} {
  move 0 -20
}

proc moveRight {} {
  move 20 0
}

proc moveLeft {} {
  move -20 0
}

proc move {dx dy} {
    global w currentItem

    if {$currentItem != 0} {
	$w.zinc translate $currentItem $dx $dy
	$w.zinc translate "axisgrp:$currentItem" $dx $dy
    }
}

proc scaleUp {} {
  scale 1.1 1.1
}

proc scaleDown {} {
  scale 0.9 0.9
}

proc scale {dx dy} {
    global w currentItem

    if {$currentItem != 0} {
	$w.zinc scale $currentItem $dx $dy
	$w.zinc scale "axisgrp:$currentItem" $dx $dy
    }
}

proc rotateLeft {} {
    rotate [expr -3.14159/18]
}

proc rotateRight {} {
    rotate [expr 3.14159/18]
}

proc rotate {angle} {
    global w currentItem
    
    if {$currentItem != 0} {
	$w.zinc rotate $currentItem $angle
	$w.zinc rotate "axisgrp:$currentItem" $angle
    }
}

proc newRectangle {} {
    global w currentGroup

    return [$w.zinc add rectangle $currentGroup {-15 -15 15 15} \
		-filled 1 -linewidth 0 -fillcolor tan]
}

proc newArc {} {
    global w currentGroup

    return [$w.zinc add arc $currentGroup {-25 -15 25 15} \
		-filled 1 -linewidth 0 -fillcolor tan]
}

proc newCurve {} {
    global w currentGroup

    return [$w.zinc add curve $currentGroup {-15 -15 -15 15 15 15 15 -15} \
		-filled 1 -linewidth 0 -fillcolor tan]
}

proc newText {} {
    global w currentGroup

    set item [$w.zinc add text $currentGroup -anchor s]
    $w.zinc itemconfigure $item -text "Item id: $item"
    return $item;
}

proc newIcon {} {
    global w currentGroup

    return [$w.zinc add icon $currentGroup -image logo -anchor center]
}

proc newTriangles {} {
    global w currentGroup

    return [$w.zinc add triangles $currentGroup \
		{-25 15 -10 -15 5 15 20 -15 35 15 50 -30} \
		-colors {tan wheat tan wheat}]
}

proc newTrack {} {
    global w currentGroup

    set labelformat {x80x50+0+0 a0a0^0^0 a0a0^0>1 a0a0>2>1 x30a0>3>1 a0a0^0>2}
    
    set item [$w.zinc add track $currentGroup 6 -labelformat $labelformat \
		  -speedvector {30 -15} -markersize 20]
    $w.zinc itemconfigure $item 0 -filled 0 -bordercolor DarkGreen -border contour
    $w.zinc itemconfigure $item 1 -filled 1 -backcolor gray60 -text AFR6128
    $w.zinc itemconfigure $item 2 -filled 0 -backcolor gray65 -text 390
    $w.zinc itemconfigure $item 3 -filled 0 -backcolor gray65 -text /
    $w.zinc itemconfigure $item 4 -filled 0 -backcolor gray65 -text 350
    $w.zinc itemconfigure $item 5 -filled 0 -backcolor gray65 -text TUR

    return $item;
}

proc newWayPoint {} {
    global w currentGroup

    set labelformat {a0a0+0+0 a0a0>0^1}

    set item [$w.zinc add waypoint $currentGroup 2 -labelformat $labelformat]
    $w.zinc itemconfigure $item 0 -filled 1 -backcolor DarkGreen -text TUR
    $w.zinc itemconfigure $item 1 -text >>>

    return $item;
}

proc newTabular {} {
    global w currentGroup

    set labelformat {f700f600+0+0 f700a0^0^0 f700a0^0>1 \
			 f700a0^0>2 f700a0^0>3 f700a0^0>4 f700a0^0>5}

    set item [$w.zinc add tabular $currentGroup 7 -labelformat $labelformat]
    $w.zinc itemconfigure $item 0 -filled 1 -border contour \
	-bordercolor black -backcolor gray60
    $w.zinc itemconfigure $item 1 -alignment center -text AFR6128
    $w.zinc itemconfigure $item 2 -alignment center -text 390
    $w.zinc itemconfigure $item 3 -alignment center -text 370
    $w.zinc itemconfigure $item 4 -alignment center -text 350
    $w.zinc itemconfigure $item 5 -alignment center -text 330
    $w.zinc itemconfigure $item 6 -alignment center -text TUR

    return $item;
}

proc addAxes {item length command inFront} {
    global w currentGroup

    set axesGroup [$w.zinc add group $currentGroup -tags "axisgrp:$item"]
    $w.zinc add curve $axesGroup "0 0 $length 0" -linewidth 2 \
	-lastend {6 8 3} -tags "axis:$item"
    $w.zinc add curve $axesGroup "0 0 0 $length" -linewidth 2 \
	-lastend {6 8 3} -tags "axis:$item"
    $w.zinc add rectangle $axesGroup {-2 -2 2 2} -filled 1 \
	-linewidth 0 -composescale 0 -tags "axis:$item"
    if {$inFront} {
	$w.zinc raise $item $axesGroup
    }
    $w.zinc bind "axis:$item" <B1-Motion> "dragItem %x %y"
    $w.zinc bind "axis:$item" <ButtonRelease-1> $command
}

proc addItem {} {
    global itemType

    set length 25
    set itemOnTop 0

    set item [eval "new$itemType"]
    if {($itemType == "Track") || ($itemType == "WayPoint")} {
	set itemOnTop 1
    }

    addAxes $item 25 select $itemOnTop
    changeItem $item
}

proc addGroup {} {
    global w currentGroup

    set item [$w.zinc add group $currentGroup]

    addAxes $item 80 selectGroup 1
    changeGroup $item
}

proc mouseAdd {itemOrGroup x y} {
    global w currentGroup currentItem

    foreach {x y} [$w.zinc transform $currentGroup "$x $y"] break
    set item [$w.zinc find withtag current]

    if {[llength $item] != 0} {
	foreach t [$w.zinc gettags [lindex $item 0]] {
	    if {[regexp {^axis} $t]} {
		return;
	    }
	}
    }

    eval "add$itemOrGroup"

    $w.zinc translate $currentItem $x $y
    $w.zinc translate "axisgrp:$currentItem" $x $y
}

proc removeItem {} { 
    global w currentGroup currentItem world
    
    if {$currentItem != 0} {
	$w.zinc remove $currentItem "axisgrp:$currentItem"
	if {$currentItem == $currentGroup} {
	    set currentGroup $world
	}
	set currentItem 0
	set composeScale 1
	set composeRot 1
    }
}