aboutsummaryrefslogtreecommitdiff
path: root/demos/tkZincLogo.tcl
blob: 9943b9677881e66ceb6081cc00ad227b8e767f21 (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
#
# $Id: tkZincLogo.tcl 1471 2004-05-07 15:31:01Z lecoanet $
# this simple demo has been adapted by C. Mertz <mertz@cena.fr> from the original
# work of JL. Vinot <vinot@cena.fr>
# Ported to Tcl by P.Lecoanet

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

namespace eval tkZincLogo {
    #
    # We need the zincLogo support
    package require zincLogo


    variable w .tkZincLogo
    catch {destroy $w}
    toplevel $w
    wm title $w "Zinc logo Demonstration"
    wm iconname $w tkZincLogo

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

    ###########################################
    # Text zone
    #######################
    ####################

    grid [text $w.text -relief sunken -borderwidth 2 -height 7] \
	-row 0 -column 0 -columnspan 2 -sticky ew

    $w.text insert end {This tkZinc logo should used openGL for a correct rendering!
	You can transform this logo with your mouse:
	Drag-Button 1 for moving the logo,
	Drag-Button 2 for zooming the logo,
	Drag-Button 3 for rotating the logo,
	Shift-Drag-Button 1 for modifying the logo transparency,
	Shift-Drag-Button 2 for modifying the logo gradient.}


    ###########################################
    # Zinc
    ##########################################
    grid [ zinc $w.zinc -width 350 -height 250 -render 1 \
	-borderwidth 3 -relief sunken] -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 topGroup [$w.zinc add group 1]

    variable logo [zincLogo::create $w.zinc $topGroup 800 40 70 0.6 0.6]

    #
    # Controls for the window transform.
    #
    bind $w.zinc <ButtonPress-1>  "::tkZincLogo::press motion %x %y"
    bind $w.zinc <ButtonRelease-1>  ::tkZincLogo::release
    bind $w.zinc <ButtonPress-2>  "::tkZincLogo::press zoom %x %y"
    bind $w.zinc <ButtonRelease-2>  ::tkZincLogo::release
    bind $w.zinc <ButtonPress-3> "::tkZincLogo::press mouseRotate %x %y"
    bind $w.zinc <ButtonRelease-3> ::tkZincLogo::release

    #
    # Controls for alpha and gradient
    #
    bind $w.zinc <Shift-ButtonPress-1> "::tkZincLogo::press modifyAlpha %x %y"
    bind $w.zinc <Shift-ButtonRelease-1> ::tkZincLogo::release
    bind $w.zinc <Shift-ButtonPress-2> "::tkZincLogo::press modifyGradient %x %y"
    bind $w.zinc <Shift-ButtonRelease-2> ::tkZincLogo::release


    variable curX 0
    variable curY 0
    variable curAngle 0

    proc press {action x y} {
	variable w
	variable curAngle
	variable curX
	variable curY

	set curX $x
	set curY $y
	set curAngle [expr atan2($y, $x)]
	bind $w.zinc <Motion> "::tkZincLogo::$action %x %y"
    }

    proc motion {x y} {
	variable w
	variable topGroup
	variable curX
	variable 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} {
	variable w
	variable topGroup
	variable curX
	variable 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} {
	variable w
	variable curAngle
	variable logo

	set lAngle [expr atan2($y, $x)]
	$w.zinc rotate $logo [expr $lAngle - $curAngle]
	set curAngle  $lAngle
    }

    proc release {} {
	variable w

	bind $w.zinc <Motion> {}
    }

    proc modifyAlpha {x y} {
	variable w
	variable topGroup

	set xRate [expr double($x) / [$w.zinc cget -width]]
	set xRate [expr ($xRate < 0) ? 0 : ($xRate > 1) ? 1 : $xRate]
	set alpha [expr int($xRate * 100)]

	$w.zinc itemconfigure $topGroup -alpha $alpha
    }

    proc modifyGradient {x y} {
	variable w

	set yRate [expr double($y) / [$w.zinc cget -height]]
	set yRate [expr ($yRate < 0) ? 0 : ($yRate > 1) ? 1 : $yRate]
	set gradPercent [expr int($yRate * 100)]
	
	$w.zinc itemconfigure letters -fillcolor "=axial 270|#ffffff;100 0 28|#66848c;100 $gradPercent|#7192aa;100 100"
    }
}