blob: 7f245dc9296213169f39c31a32ec6ca976727e8f (
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
|
# $Id$
# this simple demo has been developped by C. Mertz <mertz@cena.fr>
# Ported to Tcl by P.Lecoanet
if {![info exists zincDemo]} {
error "This script should be run from the zinc-widget demo."
}
set w .iconTransform
catch {destroy $w}
toplevel $w
wm title $w "Zinc icon scale/rotate Demonstration"
wm iconname $w zincTransform
set defaultfont "-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*"
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 -height 5
pack $w.text -expand yes -fill both
$w.text insert end {This demo needs openGL for rescaling/rotating the icon
You can transform this earth gif image with your mouse:
Drag-Button 1 for zooming the earth,
Drag-Button 2 for rotating the earth,
Drag-Button 3 for moving the earth,
Shift-Drag-Button 1 for modifying the earth transparency.}
###########################################
# Zinc
##########################################
zinc $w.zinc -width 350 -height 250 -render 1 -font 10x20 \
-borderwidth 3 -relief sunken
pack $w.zinc
set topGroup [$w.zinc add group 1]
image create photo earth -file [file join $tk_library demos images earth.gif]
set earth [$w.zinc add icon $topGroup -image earth \
-composescale 1 -composerotation 1]
$w.zinc add text $topGroup -connecteditem $earth \
-text {try to zoom/resize the earth!} -color white \
-composescale 1 -composerotation 1
#
# Controls for the window transform.
#
bind $w.zinc <ButtonPress-1> "press motion %x %y"
bind $w.zinc <ButtonRelease-1> release
bind $w.zinc <ButtonPress-2> "press zoom %x %y"
bind $w.zinc <ButtonRelease-2> release
#
# Controls for alpha and gradient
#
bind $w.zinc <Shift-ButtonPress-1> "press modifyAlpha %x %y"
bind $w.zinc <Shift-ButtonRelease-1> release
set curX 0
set curY 0
set curAngle 0
proc press {action x y} {
global w curAngle curX curY
set curX $x
set curY $y
set curAngle [expr atan2($y, $x)]
bind $w.zinc <Motion> "$action %x %y"
}
proc motion {x y} {
global w topGroup curX curY
foreach {x1 y1 x2 y2} [$w.zinc transform $topGroup \
[list $x $y $curX $curY]] break
$w.zinc translate $topGroup [expr $x1 - $x2] [expr $y1 - $y2]
set curX $x
set curY $y
}
proc zoom {x y} {
global w topGroup curX curY
if {$x > $curX} {
set maxX $x
} else {
set maxX $curX
}
if {$y > $curY} {
set maxY $y
} else {
set maxY $curY
}
if {($maxX == 0) || ($maxY == 0)} {
return;
}
set sx [expr 1.0 + (double($x - $curX) / $maxX)]
set sy [expr 1.0 + (double($y - $curY) / $maxY)]
$w.zinc scale $topGroup $sx $sx
set curX $x
set curY $y
}
proc mouseRotate {x y} {
global w curAngle topGroup
set lAngle [expr atan2($y, $x)]
$w.zinc rotate $topGroup [expr -($lAngle - $curAngle)]
set curAngle $lAngle
}
proc release {} {
global w
bind $w.zinc <Motion> {}
}
proc modifyAlpha {x y} {
global w
set xRate [expr double($x) / [$w.zinc cget -width]]
set xRate [expr ($xRate < 0) ? 0 : ($xRate > 1) ? 1 : $xRate]
set alpha [expr $xRate * 100]
$w.zinc itemconfigure $group -alpha $alpha
}
|
