1# copyright (C) 1995-2004 Jean-Luc Fontaine (mailto:jfontain@free.fr)
2
3package require Tk 8.3
4package require stooop
5
6
7::stooop::class slice {
8    variable PI 3.14159265358979323846
9}
10
11proc slice::slice {this canvas xRadius yRadius args} switched {$args} {
12    # all parameter dimensions must be in pixels
13    # note: all slice elements are tagged with slice($this)
14    set ($this,canvas) $canvas
15    set ($this,xRadius) $xRadius
16    set ($this,yRadius) $yRadius
17    switched::complete $this
18    # wait till all options have been set for initial configuration
19    complete $this
20    update $this
21}
22
23proc slice::~slice {this} {
24    if {[string length $switched::($this,-deletecommand)] > 0} {
25        # always invoke command at global level
26        uplevel #0 $switched::($this,-deletecommand)
27    }
28    $($this,canvas) delete slice($this)
29}
30
31proc slice::options {this} {
32    return [list\
33        [list -bottomcolor {} {}]\
34        [list -deletecommand {} {}]\
35        [list -height 0 0]\
36        [list -scale {1 1} {1 1}]\
37        [list -startandextent {0 0} {0 0}]\
38        [list -topcolor {} {}]\
39    ]
40}
41
42proc slice::set-height {this value} {      ;# not a dynamic option: see complete
43    if {$switched::($this,complete)} {
44        error {option -height cannot be set dynamically}
45    }
46}
47
48proc slice::set-bottomcolor {this value} {
49    if {![info exists ($this,startBottomArcFill)]} return
50    set canvas $($this,canvas)
51    $canvas itemconfigure $($this,startBottomArcFill)\
52        -fill $value -outline $value
53    $canvas itemconfigure $($this,startPolygon) -fill $value
54    $canvas itemconfigure $($this,endBottomArcFill) -fill $value -outline $value
55    $canvas itemconfigure $($this,endPolygon) -fill $value
56}
57
58proc slice::set-topcolor {this value} {
59    if {![info exists ($this,topArc)]} return
60    $($this,canvas) itemconfigure $($this,topArc) -fill $value
61}
62
63# data is stored at switched level
64proc slice::set-deletecommand {this value} {}
65
66proc slice::set-scale {this value} {
67    if {$switched::($this,complete) && ($value > 0)} {
68        # check for valid value following a non reproducible bug report
69        update $this                   ;# requires initialization to be complete
70    }
71}
72
73proc slice::set-startandextent {this value} {
74    foreach {start extent} $value {}
75    set ($this,start) [normalizedAngle $start]
76    if {$extent < 0} {
77        set ($this,extent) 0                 ;# a negative extent is meaningless
78    } elseif {$extent >= 360} {
79        # get as close as possible to 360, which would not work as it is
80        # equivalent to 0
81        set ($this,extent) [expr {360 - pow(10, -$::tcl_precision + 3)}]
82    } else {
83        set ($this,extent) $extent
84    }
85    if {$switched::($this,complete)} {
86        update $this                   ;# requires initialization to be complete
87    }
88}
89
90proc slice::normalizedAngle {value} {
91    # normalize value between -180 and 180 degrees (not included)
92    while {$value >= 180} {
93        set value [expr {$value - 360}]
94    }
95    while {$value < -180} {
96        set value [expr {$value + 360}]
97    }
98    return $value
99}
100
101proc slice::complete {this} {
102    set canvas $($this,canvas)
103    set xRadius $($this,xRadius)
104    set yRadius $($this,yRadius)
105    set bottomColor $switched::($this,-bottomcolor)
106    # use an empty image as an origin marker with only 2 coordinates
107    set ($this,origin)\
108        [$canvas create image -$xRadius -$yRadius -tags slice($this)]
109    if {$switched::($this,-height) > 0} {                                  ;# 3D
110        set ($this,startBottomArcFill) [$canvas create arc\
111            0 0 0 0 -style chord -extent 0 -fill $bottomColor\
112            -outline $bottomColor -tags slice($this)\
113        ]
114        set ($this,startPolygon) [$canvas create polygon 0 0 0 0 0 0\
115            -fill $bottomColor -tags slice($this)\
116        ]
117        set ($this,startBottomArc) [$canvas create arc 0 0 0 0\
118            -style arc -extent 0 -fill black -tags slice($this)\
119        ]
120        set ($this,endBottomArcFill) [$canvas create arc 0 0 0 0\
121            -style chord -extent 0 -fill $bottomColor\
122            -outline $bottomColor -tags slice($this)\
123        ]
124        set ($this,endPolygon) [$canvas create polygon 0 0 0 0 0 0\
125            -fill $bottomColor -tags slice($this)\
126        ]
127        set ($this,endBottomArc) [$canvas create arc 0 0 0 0\
128            -style arc -extent 0 -fill black -tags slice($this)\
129        ]
130        set ($this,startLeftLine)\
131            [$canvas create line 0 0 0 0 -tags slice($this)]
132        set ($this,startRightLine)\
133            [$canvas create line 0 0 0 0 -tags slice($this)]
134        set ($this,endLeftLine) [$canvas create line 0 0 0 0 -tags slice($this)]
135        set ($this,endRightLine)\
136            [$canvas create line 0 0 0 0 -tags slice($this)]
137    }
138    set ($this,topArc) [$canvas create arc\
139        -$xRadius -$yRadius $xRadius $yRadius\
140        -fill $switched::($this,-topcolor) -tags slice($this)\
141    ]
142    # move slice so upper-left corner is at requested coordinates
143    $canvas move slice($this) $xRadius $yRadius
144}
145
146proc slice::update {this} {
147    set canvas $($this,canvas)
148    # first store slice position in case it was moved as a whole
149    set coordinates [$canvas coords $($this,origin)]
150    set xRadius $($this,xRadius)
151    set yRadius $($this,yRadius)
152    $canvas coords $($this,origin) -$xRadius -$yRadius
153    $canvas coords $($this,topArc) -$xRadius -$yRadius $xRadius $yRadius
154    $canvas itemconfigure $($this,topArc)\
155        -start $($this,start) -extent $($this,extent)
156    if {$switched::($this,-height) > 0} {                                  ;# 3D
157        updateBottom $this
158    }
159    # now position slice at the correct coordinates
160    $canvas move slice($this) [expr {[lindex $coordinates 0] + $xRadius}]\
161        [expr {[lindex $coordinates 1] + $yRadius}]
162    # finally apply scale
163    eval $canvas scale slice($this) $coordinates $switched::($this,-scale)
164}
165
166proc slice::updateBottom {this} {
167    variable PI
168
169    set start $($this,start)
170    set extent $($this,extent)
171
172    set canvas $($this,canvas)
173    set xRadius $($this,xRadius)
174    set yRadius $($this,yRadius)
175    set height $switched::($this,-height)
176
177    # first make all bottom parts invisible
178    $canvas itemconfigure $($this,startBottomArcFill) -extent 0
179    $canvas coords $($this,startBottomArcFill)\
180        -$xRadius -$yRadius $xRadius $yRadius
181    $canvas move $($this,startBottomArcFill) 0 $height
182    $canvas itemconfigure $($this,startBottomArc) -extent 0
183    $canvas coords $($this,startBottomArc) -$xRadius -$yRadius $xRadius $yRadius
184    $canvas move $($this,startBottomArc) 0 $height
185    $canvas coords $($this,startLeftLine) 0 0 0 0
186    $canvas coords $($this,startRightLine) 0 0 0 0
187    $canvas itemconfigure $($this,endBottomArcFill) -extent 0
188    $canvas coords $($this,endBottomArcFill)\
189        -$xRadius -$yRadius $xRadius $yRadius
190    $canvas move $($this,endBottomArcFill) 0 $height
191    $canvas itemconfigure $($this,endBottomArc) -extent 0
192    $canvas coords $($this,endBottomArc) -$xRadius -$yRadius $xRadius $yRadius
193    $canvas move $($this,endBottomArc) 0 $height
194    $canvas coords $($this,endLeftLine) 0 0 0 0
195    $canvas coords $($this,endRightLine) 0 0 0 0
196    $canvas coords $($this,startPolygon) 0 0 0 0 0 0 0 0
197    $canvas coords $($this,endPolygon) 0 0 0 0 0 0 0 0
198
199    set startX [expr {$xRadius * cos($start * $PI / 180)}]
200    set startY [expr {-$yRadius * sin($start * $PI / 180)}]
201    set end [normalizedAngle [expr {$start + $extent}]]
202    set endX [expr {$xRadius * cos($end * $PI / 180)}]
203    set endY [expr {-$yRadius * sin($end * $PI / 180)}]
204
205    set startBottom [expr {$startY + $height}]
206    set endBottom [expr {$endY + $height}]
207
208    if {(($start >= 0) && ($end >= 0)) || (($start < 0) && ($end < 0))} {
209        # start and end angles are on the same side of the 0 abscissa
210        if {$extent <= 180} {                ;# slice size is less than half pie
211            if {$start < 0} {    ;# slice is facing viewer, so bottom is visible
212                $canvas itemconfigure $($this,startBottomArcFill)\
213                    -start $start -extent $extent
214                $canvas itemconfigure $($this,startBottomArc)\
215                    -start $start -extent $extent
216                # only one polygon is needed
217                $canvas coords $($this,startPolygon)\
218                    $startX $startY $endX $endY\
219                    $endX $endBottom $startX $startBottom
220                $canvas coords $($this,startLeftLine)\
221                    $startX $startY $startX $startBottom
222                $canvas coords $($this,startRightLine)\
223                    $endX $endY $endX $endBottom
224            }                                        ;# else only top is visible
225        } else {                             ;# slice size is more than half pie
226            if {$start < 0} {
227                # slice opening is facing viewer, so bottom is in 2 parts
228                $canvas itemconfigure $($this,startBottomArcFill)\
229                    -start 0 -extent $start
230                $canvas itemconfigure $($this,startBottomArc)\
231                    -start 0 -extent $start
232                $canvas coords $($this,startPolygon)\
233                    $startX $startY $xRadius 0\
234                    $xRadius $height $startX $startBottom
235                $canvas coords $($this,startLeftLine)\
236                    $startX $startY $startX $startBottom
237                $canvas coords $($this,startRightLine)\
238                    $xRadius 0 $xRadius $height
239
240                set bottomArcExtent [expr {$end + 180}]
241                $canvas itemconfigure $($this,endBottomArcFill)\
242                    -start -180 -extent $bottomArcExtent
243                $canvas itemconfigure $($this,endBottomArc)\
244                    -start -180 -extent $bottomArcExtent
245                $canvas coords $($this,endPolygon)\
246                    -$xRadius 0 $endX $endY $endX $endBottom -$xRadius $height
247                $canvas coords $($this,endLeftLine)\
248                    -$xRadius 0 -$xRadius $height
249                $canvas coords $($this,endRightLine)\
250                    $endX $endY $endX $endBottom
251            } else {
252                # slice back is facing viewer, so bottom occupies half the pie
253                $canvas itemconfigure $($this,startBottomArcFill)\
254                    -start 0 -extent -180
255                $canvas itemconfigure $($this,startBottomArc)\
256                    -start 0 -extent -180
257                # only one polygon is needed
258                $canvas coords $($this,startPolygon)\
259                    -$xRadius 0 $xRadius 0 $xRadius $height -$xRadius $height
260                $canvas coords $($this,startLeftLine)\
261                    -$xRadius 0 -$xRadius $height
262                $canvas coords $($this,startRightLine)\
263                    $xRadius 0 $xRadius $height
264            }
265        }
266    } else {     ;# start and end angles are on opposite sides of the 0 abscissa
267        if {$start < 0} {                        ;# slice start is facing viewer
268            $canvas itemconfigure $($this,startBottomArcFill)\
269                -start 0 -extent $start
270            $canvas itemconfigure $($this,startBottomArc)\
271                -start 0 -extent $start
272            # only one polygon is needed
273            $canvas coords $($this,startPolygon) $startX $startY $xRadius 0\
274                $xRadius $height $startX $startBottom
275            $canvas coords $($this,startLeftLine)\
276                $startX $startY $startX $startBottom
277            $canvas coords $($this,startRightLine) $xRadius 0 $xRadius $height
278        } else {                                   ;# slice end is facing viewer
279            set bottomArcExtent [expr {$end + 180}]
280            $canvas itemconfigure $($this,endBottomArcFill)\
281                -start -180 -extent $bottomArcExtent
282            $canvas itemconfigure $($this,endBottomArc)\
283                -start -180 -extent $bottomArcExtent
284            # only one polygon is needed
285            $canvas coords $($this,endPolygon)\
286                -$xRadius 0 $endX $endY $endX $endBottom -$xRadius $height
287            $canvas coords $($this,startLeftLine) -$xRadius 0 -$xRadius $height
288            $canvas coords $($this,startRightLine) $endX $endY $endX $endBottom
289        }
290    }
291}
292
293proc slice::rotate {this angle} {
294    if {$angle == 0} return
295    set ($this,start) [normalizedAngle [expr {$($this,start) + $angle}]]
296    update $this
297}
298
299# return actual sizes and positions after scaling
300proc slice::data {this arrayName} {
301    upvar 1 $arrayName data
302
303    set data(start) $($this,start)
304    set data(extent) $($this,extent)
305    foreach {x y} $switched::($this,-scale) {}
306    set data(xRadius) [expr {$x * $($this,xRadius)}]
307    set data(yRadius) [expr {$y * $($this,yRadius)}]
308    set data(height) [expr {$y * $switched::($this,-height)}]
309    foreach {x y} [$($this,canvas) coords $($this,origin)] {}
310    set data(xCenter) [expr {$x + $data(xRadius)}]
311    set data(yCenter) [expr {$y + $data(yRadius)}]
312}
313