aboutsummaryrefslogtreecommitdiff
path: root/demos/transforms.tcl
blob: 26bc14fa3d608325fb75eeeacd5b91711aa00151 (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
493
494
495
496
497
498
499
500
501
502
503
504
505
506
# $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."
}

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

    variable defaultfont [font create -family Helvetica -size 14 -weight normal]

    grid [button $w.dismiss -text Dismiss -command "destroy $w"] -row 3 -column 0 -pady 10
    grid [button $w.code -text "See Code" -command "showCode $w"] -row 3 -column 1 -pady 10


    ###########################################
    # Text zone
    ###########################################
    grid [text $w.text -relief sunken -borderwidth 2 -setgrid true -height 12] \
	-row 0 -column 0 -columnspan 2 -sticky ew

    $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 coordinates
	Drag Button 1    on item/group axes, translate that item coordinates
	Home             reset the transformation
	Shift-Home       reset a group direct children transformations
	+/-              scale the selected item up/down
	Ctrl-Left/Right  rotate the selected item right/left
	Shift-Up/Down    swap the selected item Y axis
	Shift-Left/Right swap the selected item X axis
	4 arrows         translate in the 4 directions
	Delete           destroy the selected item}
    $w.text configure -state disabled

    ###########################################
    # Zinc
    ###########################################
    variable zincWidth 600
    variable zincHeight 500

    grid [zinc $w.zinc -width $zincWidth -height $zincHeight \
	-font $defaultfont -borderwidth 3 -relief sunken -takefocus 1 -render 0] \
	-row 1 -column 0 -columnspan 2 -sticky news
    grid columnconfigure $w 0 -weight 1
    grid columnconfigure $w 1 -weight 1
    grid rowconfigure $w 1 -weight 2

    variable top 1

    variable inactiveAxisColor blue
    variable activeAxisColor red
    variable worldAxisColor \#a5a5a5

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

    image create photo logo -file [file join $::zinc_demos images zinc.gif]

    grid [frame $w.f] -row 2 -column 0 -columnspan 2 -sticky w

    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 "::transforms::addItem $w.zinc"
    grid $w.f.add -row 0 -column 2 -padx 10 -sticky ew

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

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

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

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


    variable world [$w.zinc add group $top]
    variable 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]
    $w.zinc lower axis:$world

    bind $w.zinc <1> {::transforms::mouseAdd %W Item %x %y}
    bind $w.zinc <2> {::transforms::mouseAdd %W Group %x %y}
    bind $w.zinc <Up> {::transforms::moveUp %W}
    bind $w.zinc <Left> {::transforms::moveLeft %W}
    bind $w.zinc <Right> {::transforms::moveRight %W}
    bind $w.zinc <Down> {::transforms::moveDown %W}
    bind $w.zinc <minus> {::transforms::scaleDown %W}
    bind $w.zinc <KP_Subtract> {::transforms::scaleDown %W}
    bind $w.zinc <plus> {::transforms::scaleUp %W}
    bind $w.zinc <KP_Add> {::transforms::scaleUp %W}
    bind $w.zinc <Home> {::transforms::reset %W}
    bind $w.zinc <Shift-Home> {::transforms::resetChildren %W}
    bind $w.zinc <Control-Left> {::transforms::rotateLeft %W}
    bind $w.zinc <Control-Right> {::transforms::rotateRight %W}
    bind $w.zinc <Shift-Up> {::transforms::swapAxis %W y}
    bind $w.zinc <Shift-Down> {::transforms::swapAxis %W y}
    bind $w.zinc <Shift-Left> {::transforms::swapAxis %W x}
    bind $w.zinc <Shift-Right> {::transforms::swapAxis %W x}
    bind $w.zinc <Delete> {::transforms::removeItem %W}

    bind $w.zinc <Configure> {::transforms::resize %W %w %h}

    focus $w.zinc
    tk_focusFollowsMouse


    proc resize {z width height} {
	variable world

	set x [expr $width/2]
	set y [expr $height/2]
	
	$z treset $world
	$z treset axis:$world
	$z translate $world $x $y
	$z translate axis:$world $x $y
    }

    proc swapAxis {z axis} {
	variable currentItem

	set sx 1
	set sy 1
	if { $axis eq "x" } {
	    set sx -1
	} elseif { $axis eq "y" } {
	    set sy -1
	}
	if {$currentItem != 0} {
	    $z scale $currentItem $sx $sy
	    $z scale axisgrp:$currentItem $sx $sy
	}
    }

    proc toggleComposeRot {z} {
	variable currentItem
	variable composeRot

	if {$currentItem != 0} {
	    $z itemconfigure $currentItem -composerotation $composeRot
	    $z itemconfigure axisgrp:$currentItem -composerotation $composeRot
	}
    }

    proc toggleComposeScale {z} {
	variable currentItem
	variable composeScale
	
	if {$currentItem != 0} {
	    $z itemconfigure $currentItem -composescale $composeScale
	    $z itemconfigure axisgrp:$currentItem -composescale $composeScale
	}
    }

    proc removeItem {z} { 
	variable currentGroup
	variable currentItem
	variable world
	
	if {$currentItem != 0} {
	    $z remove $currentItem axisgrp:$currentItem
	    if {$currentItem == $currentGroup} {
		set currentGroup $world
	    }
	    set currentItem 0
	    set composeScale 1
	    set composeRot 1
	}
    }

    proc dragItem {z x y} {
	variable drag
	variable currentItem

	set drag 1
	if {$currentItem == 0} {
	    return
	}
	
	set group [$z group $currentItem]
	foreach {x y} [$z transform $group [list $x $y]] break
	
	$z treset $currentItem
	$z treset axisgrp:$currentItem
	$z translate $currentItem $x $y
	$z translate axisgrp:$currentItem $x $y
    }

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

    proc changeItem {z item} {
	variable currentItem
	variable currentGroup
	variable composeRot
	variable composeScale
	variable drag
	variable activeAxisColor
	variable inactiveAxisColor

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

    proc selectGroup {z} {
	foreach t [$z gettags current] {
	    if {[regexp {^axis:(\d+)} $t m item]} {
		changeGroup $z $item
		return
	    }
	}
    }

    proc changeGroup {z grp} {
	variable currentItem
	variable currentGroup
	variable world
	
	changeItem $z $grp
	if {$currentItem != 0} {
	    set currentGroup $currentItem
	} else {
	    set currentGroup $world
	}
    }

    proc reset {z } {
	variable currentItem

	if {$currentItem != 0} {
	    $z treset $currentItem
	    $z treset axisgrp:$currentItem
	}
    }

    proc resetChildren {z} {
	variable currentItem

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

    proc moveUp {z} {
	move $z 0 20
    }

    proc moveDown {z} {
	move $z 0 -20
    }

    proc moveRight {z} {
	move $z 20 0
    }

    proc moveLeft {z} {
	move $z -20 0
    }

    proc move {z dx dy} {
	variable currentItem

	if {$currentItem != 0} {
	    $z translate $currentItem $dx $dy
	    $z translate axisgrp:$currentItem $dx $dy
	}
    }

    proc scaleUp {z} {
	scale $z 1.1 1.1
    }

    proc scaleDown {z} {
	scale $z 0.9 0.9
    }

    proc scale {z dx dy} {
	variable currentItem

	if {$currentItem != 0} {
	    $z scale $currentItem $dx $dy
	    $z scale axisgrp:$currentItem $dx $dy
	}
    }

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

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

    proc rotate {z angle} {
	variable currentItem
	
	if {$currentItem != 0} {
	    $z rotate $currentItem $angle
	    $z rotate axisgrp:$currentItem $angle
	}
    }

    proc newRectangle {z} {
	variable currentGroup

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

    proc newArc {z} {
	variable currentGroup

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

    proc newCurve {z} {
	variable currentGroup

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

    proc newText {z} {
	variable currentGroup

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

    proc newIcon {z} {
	variable currentGroup

	return [$z add icon $currentGroup -image logo -anchor center]
    }

    proc newTriangles {z} {
	variable currentGroup

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

    proc newTrack {z} {
	variable currentGroup

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

	return $item;
    }

    proc newWayPoint {z} {
	variable currentGroup

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

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

	return $item;
    }

    proc newTabular {z} {
	variable 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 [$z add tabular $currentGroup 7 -labelformat $labelformat]
	$z itemconfigure $item 0 -filled 1 -border contour \
	    -bordercolor black -backcolor gray60
	$z itemconfigure $item 1 -alignment center -text AFR6128
	$z itemconfigure $item 2 -alignment center -text 390
	$z itemconfigure $item 3 -alignment center -text 370
	$z itemconfigure $item 4 -alignment center -text 350
	$z itemconfigure $item 5 -alignment center -text 330
	$z itemconfigure $item 6 -alignment center -text TUR

	return $item;
    }

    proc addAxes {z item length command inFront} {
	variable currentGroup

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

    proc addItem {z} {
	variable itemType

	set length 25
	set itemOnTop 0

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

	addAxes $z $item 25 select $itemOnTop
	changeItem $z $item
    }

    proc addGroup {z} {
	variable currentGroup

	set item [$z add group $currentGroup]

	addAxes $z $item 80 selectGroup 1
	changeGroup $z $item
    }

    proc mouseAdd {z itemOrGroup x y} {
	variable currentGroup
	variable currentItem

	if {[llength [$z find withtag current]] != 0} {
	    return
	}

	foreach {x y} [$z transform $currentGroup [list $x $y]] break

	eval "add$itemOrGroup $z"

	$z translate $currentItem $x $y
	$z translate axisgrp:$currentItem $x $y
    }
}