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