1# plotbusiness.tcl -- 2# Facilities aimed at business type charts 3# 4# Note: 5# This source file contains the private functions for various 6# business type charts. 7# It is the companion of "plotchart.tcl" 8# 9 10# Config3DBar -- 11# Configuration options for the 3D barchart 12# Arguments: 13# w Name of the canvas 14# args List of arguments 15# Result: 16# None 17# Side effects: 18# Items that are already visible will be changed to the new look 19# 20proc ::Plotchart::Config3DBar { w args } { 21 variable settings 22 23 foreach {option value} $args { 24 set option [string range $option 1 end] 25 set settings($w,$option) $value 26 27 switch -- $option { 28 "usebackground" { 29 if { $value } { 30 $w itemconfigure background -fill grey65 -outline black 31 } else { 32 $w itemconfigure background -fill {} -outline {} 33 } 34 } 35 "useticklines" { 36 if { $value } { 37 $w itemconfigure ticklines -fill black 38 } else { 39 $w itemconfigure ticklines -fill {} 40 } 41 } 42 "showvalues" { 43 if { $value } { 44 $w itemconfigure values -fill $settings($w,valuecolour) 45 } else { 46 $w itemconfigure values -fill {} 47 } 48 } 49 "valuecolour" - "valuecolor" { 50 set settings($w,valuecolour) $value 51 set settings($w,valuecolor) $value 52 $w itemconfigure values -fill $settings($w,valuecolour) 53 } 54 "valuefont" { 55 set settings($w,valuefont) $value 56 $w itemconfigure labels -font $settings($w,valuefont) 57 } 58 "labelcolour" - "labelcolor" { 59 set settings($w,labelcolour) $value 60 set settings($w,labelcolor) $value 61 $w itemconfigure labels -fill $settings($w,labelcolour) 62 } 63 "labelfont" { 64 set settings($w,labelfont) $value 65 $w itemconfigure labels -font $settings($w,labelfont) 66 } 67 } 68 } 69} 70 71# Draw3DBarchart -- 72# Draw the basic elements of the 3D barchart 73# Arguments: 74# w Name of the canvas 75# yscale Minimum, maximum and step for the y-axis 76# nobars Number of bars 77# Result: 78# None 79# Side effects: 80# Default settings are introduced 81# 82proc ::Plotchart::Draw3DBarchart { w yscale nobars } { 83 variable settings 84 variable scaling 85 86 # 87 # Default settings 88 # 89 set settings($w,labelfont) "fixed" 90 set settings($w,valuefont) "fixed" 91 set settings($w,labelcolour) "black" 92 set settings($w,valuecolour) "black" 93 set settings($w,usebackground) 0 94 set settings($w,useticklines) 0 95 set settings($w,showvalues) 1 96 97 # 98 # Horizontal positioning parameters 99 # 100 set scaling($w,xbase) 0.0 101 set scaling($w,xshift) 0.2 102 set scaling($w,barwidth) 0.6 103 104 # 105 # Shift the vertical axis a bit 106 # 107 $w move yaxis -10 0 108 # 109 # Draw the platform and the walls 110 # 111 set x1 $scaling($w,pxmin) 112 set x2 $scaling($w,pxmax) 113 foreach {dummy y1} [coordsToPixel $w $scaling($w,xmin) 0.0] {break} 114 115 set x1 [expr {$x1-10}] 116 set x2 [expr {$x2+10}] 117 set y1 [expr {$y1+10}] 118 119 set y2 [expr {$y1-30}] 120 set x3 [expr {$x1+30}] 121 set y3 [expr {$y1-30}] 122 set x4 [expr {$x2-30}] 123 set y4 $y1 124 125 $w create polygon $x1 $y1 $x3 $y3 $x2 $y2 $x4 $y4 -fill gray65 -tag platform \ 126 -outline black 127 128 set xw1 $x1 129 foreach {dummy yw1} [coordsToPixel $w 0.0 $scaling($w,ymin)] {break} 130 set xw2 $x1 131 foreach {dummy yw2} [coordsToPixel $w 0.0 $scaling($w,ymax)] {break} 132 133 set xw3 $x3 134 set yw3 [expr {$yw2-30}] 135 set xw4 $x3 136 set yw4 [expr {$yw1-30}] 137 138 $w create polygon $xw1 $yw1 $xw2 $yw2 $xw3 $yw3 $xw4 $yw4 \ 139 -outline black -fill gray65 -tag background 140 141 set xw5 $x2 142 $w create polygon $xw3 $yw3 $xw5 $yw3 $xw5 $yw4 $xw3 $yw4 \ 143 -outline black -fill gray65 -tag background 144 145 # 146 # Draw the ticlines (NOTE: Something is wrong here!) 147 # 148 # foreach {ymin ymax ystep} $yscale {break} 149 # if { $ymin > $ymax } { 150 # foreach {ymax ymin ystep} $yscale {break} 151 # set ystep [expr {abs($ystep)}] 152 # } 153 # set yv $ymin 154 # while { $yv < ($ymax-0.5*$ystep) } { 155 # foreach {dummy pyv} [coordsToPixel $w $scaling($w,xmin) $yv] {break} 156 # set pyv1 [expr {$pyv-5}] 157 # set pyv2 [expr {$pyv-35}] 158 # $w create line $xw1 $pyv1 $xw3 $pyv2 $xw5 $pyv2 -fill black -tag ticklines 159 # set yv [expr {$yv+$ystep}] 160 # } 161 162 Config3DBar $w -usebackground 0 -useticklines 0 163} 164 165# Draw3DBar -- 166# Draw a 3D bar in a barchart 167# Arguments: 168# w Name of the canvas 169# label Label for the bar 170# yvalue The height of the bar 171# fill The colour of the bar 172# Result: 173# None 174# Side effects: 175# The bar is drawn, the display order is adjusted 176# 177proc ::Plotchart::Draw3DBar { w label yvalue fill } { 178 variable settings 179 variable scaling 180 181 set xv1 [expr {$scaling($w,xbase)+$scaling($w,xshift)}] 182 set xv2 [expr {$xv1+$scaling($w,barwidth)}] 183 184 foreach {x0 y0} [coordsToPixel $w $xv1 0.0] {break} 185 foreach {x1 y1} [coordsToPixel $w $xv2 $yvalue] {break} 186 187 if { $yvalue < 0.0 } { 188 foreach {y0 y1} [list $y1 $y0] {break} 189 set tag d 190 } else { 191 set tag u 192 } 193 194 set d [expr {($x1-$x0)/3}] 195 set x2 [expr {$x0+$d+1}] 196 set x3 [expr {$x1+$d}] 197 set y2 [expr {$y0-$d+1}] 198 set y3 [expr {$y1-$d-1}] 199 set y4 [expr {$y1-$d-1}] 200 $w create rect $x0 $y0 $x1 $y1 -fill $fill -tag $tag 201 $w create poly $x0 $y1 $x2 $y4 $x3 $y4 $x1 $y1 -fill [DimColour $fill 0.8] -outline black -tag u 202 $w create poly $x1 $y1 $x3 $y3 $x3 $y2 $x1 $y0 -fill [DimColour $fill 0.6] -outline black -tag $tag 203 204 # 205 # Add the text 206 # 207 if { $settings($w,showvalues) } { 208 $w create text [expr {($x0+$x3)/2}] [expr {$y3-5}] -text $yvalue \ 209 -font $settings($w,valuefont) -fill $settings($w,valuecolour) \ 210 -anchor s 211 } 212 $w create text [expr {($x0+$x3)/2}] [expr {$y0+8}] -text $label \ 213 -font $settings($w,labelfont) -fill $settings($w,labelcolour) \ 214 -anchor n 215 216 # 217 # Reorder the various bits 218 # 219 $w lower u 220 $w lower platform 221 $w lower d 222 $w lower ticklines 223 $w lower background 224 225 # 226 # Move to the next bar 227 # 228 set scaling($w,xbase) [expr {$scaling($w,xbase)+1.0}] 229} 230 231# DimColour -- 232# Compute a dimmer colour 233# Arguments: 234# color Original colour 235# factor Factor by which to reduce the colour 236# Result: 237# New colour 238# Note: 239# Shamelessly copied from R. Suchenwirths Wiki page on 3D bars 240# 241proc ::Plotchart::DimColour {color factor} { 242 foreach i {r g b} n [winfo rgb . $color] d [winfo rgb . white] { 243 #checker exclude warnVarRef 244 set $i [expr {int(255.*$n/$d*$factor)}] 245 } 246 #checker exclude warnUndefinedVar 247 format #%02x%02x%02x $r $g $b 248} 249 250# GreyColour -- 251# Compute a greyer colour 252# Arguments: 253# color Original colour 254# factor Factor by which to mix in grey 255# Result: 256# New colour 257# Note: 258# Shamelessly adapted from R. Suchenwirths Wiki page on 3D bars 259# 260proc ::Plotchart::GreyColour {color factor} { 261 foreach i {r g b} n [winfo rgb . $color] d [winfo rgb . white] e [winfo rgb . lightgrey] { 262 #checker exclude warnVarRef 263 set $i [expr {int(255.*($n*$factor+$e*(1.0-$factor))/$d)}] 264 } 265 #checker exclude warnUndefinedVar 266 format #%02x%02x%02x $r $g $b 267} 268 269# Draw3DLine -- 270# Plot a ribbon of z-data as a function of y 271# Arguments: 272# w Name of the canvas 273# data List of coordinate pairs y, z 274# colour Colour to use 275# Result: 276# None 277# Side effect: 278# The plot of the data 279# 280proc ::Plotchart::Draw3DLine { w data colour } { 281 variable data_series 282 variable scaling 283 284 set bright $colour 285 set dim [DimColour $colour 0.6] 286 287 # 288 # Draw the ribbon as a series of quadrangles 289 # 290 set xe $data_series($w,xbase) 291 set xb [expr {$xe-$data_series($w,xwidth)}] 292 293 set data_series($w,xbase) [expr {$xe-$data_series($w,xstep)}] 294 295 foreach {yb zb} [lrange $data 0 end-2] {ye ze} [lrange $data 2 end] { 296 297 foreach {px11 py11} [coords3DToPixel $w $xb $yb $zb] {break} 298 foreach {px12 py12} [coords3DToPixel $w $xe $yb $zb] {break} 299 foreach {px21 py21} [coords3DToPixel $w $xb $ye $ze] {break} 300 foreach {px22 py22} [coords3DToPixel $w $xe $ye $ze] {break} 301 302 # 303 # Use the angle of the line to determine if the top or the 304 # bottom side is visible 305 # 306 if { $px21 == $px11 || 307 ($py21-$py11)/($px21-$px11) < ($py12-$py11)/($px12-$px11) } { 308 set colour $dim 309 } else { 310 set colour $bright 311 } 312 313 $w create polygon $px11 $py11 $px21 $py21 $px22 $py22 \ 314 $px12 $py12 $px11 $py11 \ 315 -fill $colour -outline black 316 } 317} 318 319# Draw3DArea -- 320# Plot a ribbon of z-data as a function of y with a "facade" 321# Arguments: 322# w Name of the canvas 323# data List of coordinate pairs y, z 324# colour Colour to use 325# Result: 326# None 327# Side effect: 328# The plot of the data 329# 330proc ::Plotchart::Draw3DArea { w data colour } { 331 variable data_series 332 variable scaling 333 334 set bright $colour 335 set dimmer [DimColour $colour 0.8] 336 set dim [DimColour $colour 0.6] 337 338 # 339 # Draw the ribbon as a series of quadrangles 340 # 341 set xe $data_series($w,xbase) 342 set xb [expr {$xe-$data_series($w,xwidth)}] 343 344 set data_series($w,xbase) [expr {$xe-$data_series($w,xstep)}] 345 346 set facade {} 347 348 foreach {yb zb} [lrange $data 0 end-2] {ye ze} [lrange $data 2 end] { 349 350 foreach {px11 py11} [coords3DToPixel $w $xb $yb $zb] {break} 351 foreach {px12 py12} [coords3DToPixel $w $xe $yb $zb] {break} 352 foreach {px21 py21} [coords3DToPixel $w $xb $ye $ze] {break} 353 foreach {px22 py22} [coords3DToPixel $w $xe $ye $ze] {break} 354 355 $w create polygon $px11 $py11 $px21 $py21 $px22 $py22 \ 356 $px12 $py12 $px11 $py11 \ 357 -fill $dimmer -outline black 358 359 lappend facade $px11 $py11 360 } 361 362 # 363 # Add the last point 364 # 365 lappend facade $px21 $py21 366 367 # 368 # Add the polygon at the right 369 # 370 set zmin $scaling($w,zmin) 371 foreach {px2z py2z} [coords3DToPixel $w $xe $ye $zmin] {break} 372 foreach {px1z py1z} [coords3DToPixel $w $xb $ye $zmin] {break} 373 374 $w create polygon $px21 $py21 $px22 $py22 \ 375 $px2z $py2z $px1z $py1z \ 376 -fill $dim -outline black 377 378 foreach {pxb pyb} [coords3DToPixel $w $xb $ye $zmin] {break} 379 380 set yb [lindex $data 0] 381 foreach {pxe pye} [coords3DToPixel $w $xb $yb $zmin] {break} 382 383 lappend facade $px21 $py21 $pxb $pyb $pxe $pye 384 385 $w create polygon $facade -fill $colour -outline black 386} 387