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