1# plotpriv.tcl --
2#    Facilities to draw simple plots in a dedicated canvas
3#
4# Note:
5#    This source file contains the private functions.
6#    It is the companion of "plotchart.tcl"
7#
8
9# WidthCanvas --
10#    Return the width of the canvas
11# Arguments:
12#    w           Name of the canvas
13# Result:
14#    Width in pixels
15#
16proc ::Plotchart::WidthCanvas {w} {
17    set width [winfo width $w]
18
19    if { $width < 10 } {
20        set width [$w cget -width]
21    }
22    return $width
23}
24
25# HeightCanvas --
26#    Return the height of the canvas
27# Arguments:
28#    w           Name of the canvas
29# Result:
30#    Height in pixels
31#
32proc ::Plotchart::HeightCanvas {w} {
33    set height [winfo height $w]
34
35    if { $height < 10 } {
36        set height [$w cget -height]
37    }
38    return $height
39}
40
41# SavePlot --
42#    Save the plot/chart to a PostScript file (using default options)
43# Arguments:
44#    w           Name of the canvas
45#    filename    Name of the file to write
46#    args        Optional format (-format name)
47# Result:
48#    None
49# Side effect:
50#    A (new) PostScript file
51#
52proc ::Plotchart::SavePlot { w filename args } {
53
54   if { [llength $args] == 0 } {
55       #
56       # Wait for the canvas to become visible - just in case.
57       # Then write the file
58       #
59       update idletasks
60       $w postscript -file $filename
61   } else {
62       if { [llength $args] == 2 && [lindex $args 0] == "-format" } {
63           package require Img
64           set format [lindex $args 1]
65
66           #
67           # This is a kludge:
68           # Somehow tkwait does not always work (on Windows XP, that is)
69           #
70           raise [winfo toplevel $w]
71          # tkwait visibility [winfo toplevel $w]
72           after 2000 {set ::Plotchart::waited 0}
73           vwait ::Plotchart::waited
74           set img [image create photo -data $w -format window]
75           $img write $filename -format $format
76       } else {
77           return -code error "Unknown option: $args - must be: -format img-format"
78       }
79   }
80}
81
82# MarginsRectangle --
83#    Determine the margins for a rectangular plot/chart
84# Arguments:
85#    w           Name of the canvas
86#    notext      Number of lines of text to make room for at the top
87#                (default: 2.0)
88#    text_width  Number of characters to be displayed at most on left
89#                (default: 8)
90# Result:
91#    List of four values
92#
93proc ::Plotchart::MarginsRectangle { w {notext 2.0} {text_width 8}} {
94   variable config
95
96   set char_width  $config(font,char_width)
97   set char_height $config(font,char_height)
98   set config($w,font,char_width)  $char_width
99   set config($w,font,char_height) $char_height
100
101   foreach {char_width char_height} [FontMetrics $w] {break}
102   set margin_right [expr {$char_width * 4}]
103   if { $margin_right < $config($w,margin,right) } {
104      set margin_right $config($w,margin,right)
105   }
106   set margin_bottom [expr {$char_height * 2 + 2}]
107   if { $margin_bottom < $config($w,margin,bottom) } {
108      set margin_bottom $config($w,margin,bottom)
109   }
110
111   set pxmin [expr {$char_width*$text_width}]
112   if { $pxmin < $config($w,margin,left) } {
113       set pxmin $config($w,margin,left)
114   }
115   set pymin [expr {int($char_height*$notext)}]
116   if { $pymin < $config($w,margin,top) } {
117       set pymin $config($w,margin,top)
118   }
119   set pxmax [expr {[WidthCanvas $w]  - $margin_right}]
120   set pymax [expr {[HeightCanvas $w] - $margin_bottom}]
121
122   return [list $pxmin $pymin $pxmax $pymax]
123}
124
125# MarginsSquare --
126#    Determine the margins for a square plot/chart
127# Arguments:
128#    w           Name of the canvas
129#    notext      Number of lines of text to make room for at the top
130#                (default: 2.0)
131#    text_width  Number of characters to be displayed at most on left
132#                (default: 8)
133# Result:
134#    List of four values
135#
136proc ::Plotchart::MarginsSquare { w {notext 2.0} {text_width 8}} {
137    variable config
138
139    set char_width  $config(font,char_width)
140    set char_height $config(font,char_height)
141    set config($w,font,char_width)  $char_width
142    set config($w,font,char_height) $char_height
143
144    foreach {char_width char_height} [FontMetrics $w] {break}
145    set margin_right [expr {$char_width * 4}]
146    if { $margin_right < $config($w,margin,right) } {
147        set margin_right $config($w,margin,right)
148    }
149    set margin_bottom [expr {$char_height * 2 + 2}]
150    if { $margin_bottom < $config($w,margin,bottom) } {
151        set margin_bottom $config($w,margin,bottom)
152    }
153
154    set pxmin [expr {$char_width*$text_width}]
155    if { $pxmin < $config($w,margin,left) } {
156        set pxmin $config($w,margin,left)
157    }
158    set pymin [expr {int($char_height*$notext)}]
159    if { $pymin < $config($w,margin,top) } {
160        set pymin $config($w,margin,top)
161    }
162    set pxmax [expr {[WidthCanvas $w]  - $margin_right}]
163    set pymax [expr {[HeightCanvas $w] - $margin_bottom}]
164
165    if { $pxmax-$pxmin > $pymax-$pymin } {
166        set pxmax [expr {$pxmin + ($pymax - $pymin)}]
167    } else {
168        set pymax [expr {$pymin + ($pxmax - $pxmin)}]
169    }
170
171    return [list $pxmin $pymin $pxmax $pymax]
172}
173
174# MarginsCircle --
175#    Determine the margins for a circular plot/chart
176# Arguments:
177#    w           Name of the canvas
178# Result:
179#    List of four values
180#
181proc ::Plotchart::MarginsCircle { w } {
182   set pxmin 80
183   set pymin 30
184   set pxmax [expr {[WidthCanvas $w]  - 80}]
185   set pymax [expr {[HeightCanvas $w] - 30}]
186   #set pxmax [expr {[$w cget -width]  - 80}]
187   #set pymax [expr {[$w cget -height] - 30}]
188
189   set dx [expr {$pxmax-$pxmin+1}]
190   set dy [expr {$pymax-$pymin+1}]
191
192   if { $dx < $dy } {
193      set pyminn [expr {($pymin+$pymax-$dx)/2}]
194      set pymaxn [expr {($pymin+$pymax+$dx)/2}]
195      set pymin  $pyminn
196      set pymax  $pymaxn
197   } else {
198      set pxminn [expr {($pxmin+$pxmax-$dy)/2}]
199      set pxmaxn [expr {($pxmin+$pxmax+$dy)/2}]
200      set pxmin  $pxminn
201      set pxmax  $pxmaxn
202   }
203
204   return [list $pxmin $pymin $pxmax $pymax]
205}
206
207# Margins3DPlot --
208#    Determine the margins for a 3D plot
209# Arguments:
210#    w           Name of the canvas
211# Result:
212#    List of four values
213#
214proc ::Plotchart::Margins3DPlot { w } {
215   variable scaling
216
217   set yfract 0.33
218   set zfract 0.50
219   if { [info exists scaling($w,yfract)] } {
220      set yfract $scaling($w,yfract)
221   } else {
222      set scaling($w,yfract) $yfract
223   }
224   if { [info exists scaling($w,zfract)] } {
225      set zfract $scaling($w,zfract)
226   } else {
227      set scaling($w,zfract) $zfract
228   }
229
230   set yzwidth  [expr {(-120+[WidthCanvas $w])/(1.0+$yfract)}]
231   set yzheight [expr {(-60+[HeightCanvas $w])/(1.0+$zfract)}]
232   #set yzwidth  [expr {(-120+[$w cget -width])/(1.0+$yfract)}]
233   #set yzheight [expr {(-60+[$w cget -height])/(1.0+$zfract)}]
234
235   set pxmin    [expr {60+$yfract*$yzwidth}]
236   set pxmax    [expr {[WidthCanvas $w] - 60}]
237   #set pxmax    [expr {[$w cget -width] - 60}]
238   set pymin    30
239   set pymax    [expr {30+$yzheight}]
240
241   return [list $pxmin $pymin $pxmax $pymax]
242}
243
244# SetColours --
245#    Set the colours for those plots that treat them as a global resource
246# Arguments:
247#    w           Name of the canvas
248#    args        List of colours to be used
249# Result:
250#    None
251#
252proc ::Plotchart::SetColours { w args } {
253   variable scaling
254
255   set scaling($w,colours) $args
256}
257
258# CycleColours --
259#    create cycling colours for those plots that treat them as a global resource
260# Arguments:
261#    colours     List of colours to be used. An empty list will activate to default colours
262#    nr_data     Number of data records
263# Result:
264#    List of 'nr_data' colours to be used
265#
266proc ::Plotchart::CycleColours { colours nr_data } {
267   if {![llength ${colours}]} {
268       # force to most usable default colour list
269       set colours {green blue red cyan yellow magenta}
270   }
271
272   if {[llength ${colours}] < ${nr_data}} {
273	# cycle through colours
274	set init_colours ${colours}
275        set colours {}
276        set pos 0
277        for {set nr 0} {${nr} < ${nr_data}} {incr nr} {
278            lappend colours [lindex ${init_colours} ${pos}]
279            incr pos
280            if {[llength ${init_colours}] <= ${pos}} {
281                set pos 0
282            }
283	}
284        if {[string equal [lindex ${colours} 0] [lindex ${colours} end]]} {
285            # keep first and last colour different from selected colours
286	    #    this will /sometimes fail in cases with only one/two colours in list
287	    set colours [lreplace ${colours} end end [lindex ${colours} 1]]
288        }
289   }
290   return ${colours}
291}
292
293# DataConfig --
294#    Configure the data series
295# Arguments:
296#    w           Name of the canvas
297#    series      Name of the series in question
298#    args        Option and value pairs
299# Result:
300#    None
301#
302proc ::Plotchart::DataConfig { w series args } {
303   variable data_series
304   variable options
305   variable option_keys
306   variable option_values
307
308   foreach {option value} $args {
309      set idx [lsearch $options $option]
310      if { $idx < 0 } {
311         return -code error "Unknown or invalid option: $option (value: $value)"
312      } else {
313         set key [lindex $option_keys    $idx]
314         set idx [lsearch $option_values $key]
315         set values  [lindex $option_values [incr idx]]
316         if { $values != "..." } {
317            if { [lsearch $values $value] < 0 } {
318               return -code error "Unknown or invalid value: $value for option $option - $values"
319            }
320         }
321         set data_series($w,$series,$key) $value
322      }
323   }
324}
325
326# ScaleIsometric --
327#    Determine the scaling for an isometric plot
328# Arguments:
329#    w           Name of the canvas
330#    xmin        Minimum x coordinate
331#    ymin        Minimum y coordinate
332#    xmax        Maximum x coordinate
333#    ymax        Maximum y coordinate
334#                (default: 1.5)
335# Result:
336#    None
337# Side effect:
338#    Array with scaling parameters set
339#
340proc ::Plotchart::ScaleIsometric { w xmin ymin xmax ymax } {
341   variable scaling
342
343   set pxmin $scaling($w,pxmin)
344   set pymin $scaling($w,pymin)
345   set pxmax $scaling($w,pxmax)
346   set pymax $scaling($w,pymax)
347
348   set dx [expr {double($xmax-$xmin)/($pxmax-$pxmin)}]
349   set dy [expr {double($ymax-$ymin)/($pymax-$pymin)}]
350
351   #
352   # Which coordinate is dominant?
353   #
354   if { $dy < $dx } {
355      set yminn [expr {0.5*($ymax+$ymin) - 0.5 * $dx * ($pymax-$pymin)}]
356      set ymaxn [expr {0.5*($ymax+$ymin) + 0.5 * $dx * ($pymax-$pymin)}]
357      set ymin  $yminn
358      set ymax  $ymaxn
359   } else {
360      set xminn [expr {0.5*($xmax+$xmin) - 0.5 * $dy * ($pxmax-$pxmin)}]
361      set xmaxn [expr {0.5*($xmax+$xmin) + 0.5 * $dy * ($pxmax-$pxmin)}]
362      set xmin  $xminn
363      set xmax  $xmaxn
364   }
365
366   worldCoordinates $w $xmin $ymin $xmax $ymax
367}
368
369# PlotHandler --
370#    Handle the subcommands for an XY plot or chart
371# Arguments:
372#    type        Type of plot/chart
373#    w           Name of the canvas
374#    command     Subcommand or method to run
375#    args        Data for the command
376# Result:
377#    Whatever returned by the subcommand
378#
379proc ::Plotchart::PlotHandler { type w command args } {
380    variable methodProc
381
382    if { [info exists methodProc($type,$command)] } {
383        if { [llength $methodProc($type,$command)] == 1 } {
384            eval $methodProc($type,$command) $w $args
385        } else {
386            eval $methodProc($type,$command)_$w $w $args
387        }
388    } else {
389        return -code error "No such method - $command"
390    }
391}
392
393# DrawMask --
394#    Draw the stuff that masks the data lines outside the graph
395# Arguments:
396#    w           Name of the canvas
397# Result:
398#    None
399# Side effects:
400#    Several polygons drawn in the background colour
401#
402proc ::Plotchart::DrawMask { w } {
403   variable scaling
404   variable config
405
406   set width  [expr {[WidthCanvas $w]  + 1}]
407   set height [expr {[HeightCanvas $w] + 1}]
408   set colour $config($w,background,outercolor)
409   set pxmin  [expr {$scaling($w,pxmin)-1}]
410   set pxmax  $scaling($w,pxmax)
411   set pymin  [expr {$scaling($w,pymin)-1}]
412   set pymax  $scaling($w,pymax)
413   $w create rectangle 0      0      $pxmin $height -fill $colour -outline $colour -tag mask
414   $w create rectangle 0      0      $width $pymin  -fill $colour -outline $colour -tag mask
415   $w create rectangle 0      $pymax $width $height -fill $colour -outline $colour -tag mask
416   $w create rectangle $pxmax 0      $width $height -fill $colour -outline $colour -tag mask
417
418   $w lower mask
419}
420
421# DrawScrollMask --
422#    Draw the masking rectangles for a time or Gantt chart
423# Arguments:
424#    w           Name of the canvas
425# Result:
426#    None
427# Side effects:
428#    Several polygons drawn in the background colour, with appropriate
429#    tags
430#
431proc ::Plotchart::DrawScrollMask { w } {
432   variable scaling
433   variable config
434
435   set width  [expr {[WidthCanvas $w]  + 1}]
436   set height [expr {[HeightCanvas $w] + 1}]
437   set colour $config($w,background,outercolor)
438   set pxmin  [expr {$scaling($w,pxmin)-1}]
439   set pxmax  $scaling($w,pxmax)
440   set pymin  [expr {$scaling($w,pymin)-1}]
441   set pymax  $scaling($w,pymax)
442   $w create rectangle 0      0      $pxmin $height -fill $colour -outline $colour -tag vertmask
443   $w create rectangle 0      0      $width $pymin  -fill $colour -outline $colour -tag horizmask
444   $w create rectangle 0      $pymax $width $height -fill $colour -outline $colour -tag horizmask
445   $w create rectangle $pxmax 0      $width $height -fill $colour -outline $colour -tag vertmask
446
447   $w create rectangle 0      0      $pxmin $pymin  -fill $colour -outline $colour -tag {topmask top}
448   $w create rectangle $pxmax 0      $width $pymin  -fill $colour -outline $colour -tag {topmask top}
449
450   $w lower topmask
451   $w lower horizmask
452   $w lower vertmask
453}
454
455# DrawTitle --
456#    Draw the title
457# Arguments:
458#    w           Name of the canvas
459#    title       Title to appear above the graph
460# Result:
461#    None
462# Side effects:
463#    Text string drawn
464#
465proc ::Plotchart::DrawTitle { w title } {
466   variable scaling
467   variable config
468
469   set width  [WidthCanvas $w]
470   #set width  [$w cget -width]
471   set pymin  $scaling($w,pymin)
472
473   $w create text [expr {$width/2}] 3 -text $title \
474       -tags title -font $config($w,title,font) \
475       -fill $config($w,title,textcolor) -anchor $config($w,title,anchor)
476}
477
478# DrawData --
479#    Draw the data in an XY-plot
480# Arguments:
481#    w           Name of the canvas
482#    series      Data series
483#    xcrd        Next x coordinate
484#    ycrd        Next y coordinate
485# Result:
486#    None
487# Side effects:
488#    New data drawn in canvas
489#
490proc ::Plotchart::DrawData { w series xcrd ycrd } {
491   variable data_series
492   variable scaling
493
494   #
495   # Check for missing values
496   #
497   if { $xcrd == "" || $ycrd == "" } {
498       unset data_series($w,$series,x)
499       return
500   }
501
502   #
503   # Draw the line piece
504   #
505   set colour "black"
506   if { [info exists data_series($w,$series,-colour)] } {
507      set colour $data_series($w,$series,-colour)
508   }
509
510   set type "line"
511   if { [info exists data_series($w,$series,-type)] } {
512      set type $data_series($w,$series,-type)
513   }
514   set filled "no"
515   if { [info exists data_series($w,$series,-filled)] } {
516      set filled $data_series($w,$series,-filled)
517   }
518   set fillcolour white
519   if { [info exists data_series($w,$series,-fillcolour)] } {
520      set fillcolour $data_series($w,$series,-fillcolour)
521   }
522   set width 1
523   if { [info exists data_series($w,$series,-width)] } {
524      set width $data_series($w,$series,-width)
525   }
526
527   foreach {pxcrd pycrd} [coordsToPixel $w $xcrd $ycrd] {break}
528
529   if { [info exists data_series($w,$series,x)] } {
530       set xold $data_series($w,$series,x)
531       set yold $data_series($w,$series,y)
532       foreach {pxold pyold} [coordsToPixel $w $xold $yold] {break}
533
534       if { $filled ne "no" } {
535           if { $filled eq "down" } {
536               set pym $scaling($w,pymax)
537           } else {
538               set pym $scaling($w,pymin)
539           }
540           $w create polygon $pxold $pym $pxold $pyold $pxcrd $pycrd $pxcrd $pym \
541               -fill $fillcolour -outline {} -width $width -tag [list data data_$series]
542       }
543
544       if { $type == "line" || $type == "both" } {
545          $w create line $pxold $pyold $pxcrd $pycrd \
546                         -fill $colour -width $width -tag [list data data_$series]
547       }
548   }
549
550   if { $type == "symbol" || $type == "both" } {
551      set symbol "dot"
552      if { [info exists data_series($w,$series,-symbol)] } {
553         set symbol $data_series($w,$series,-symbol)
554      }
555      DrawSymbolPixel $w $series $pxcrd $pycrd $symbol $colour [list "data" data_$series]
556   }
557
558   $w lower data
559
560   set data_series($w,$series,x) $xcrd
561   set data_series($w,$series,y) $ycrd
562}
563
564# DrawStripData --
565#    Draw the data in a stripchart
566# Arguments:
567#    w           Name of the canvas
568#    series      Data series
569#    xcrd        Next x coordinate
570#    ycrd        Next y coordinate
571# Result:
572#    None
573# Side effects:
574#    New data drawn in canvas
575#
576proc ::Plotchart::DrawStripData { w series xcrd ycrd } {
577   variable data_series
578   variable scaling
579
580   #
581   # Check for missing values
582   #
583   if { $xcrd == "" || $ycrd == "" } {
584       unset data_series($w,$series,x)
585       return
586   }
587
588   if { $xcrd > $scaling($w,xmax) } {
589      set xdelt $scaling($w,xdelt)
590      set xmin  $scaling($w,xmin)
591      set xmax  $scaling($w,xmax)
592
593      set xminorg $xmin
594      while { $xmax < $xcrd } {
595         set xmin [expr {$xmin+$xdelt}]
596         set xmax [expr {$xmax+$xdelt}]
597      }
598      set ymin  $scaling($w,ymin)
599      set ymax  $scaling($w,ymax)
600
601      worldCoordinates $w $xmin $ymin $xmax $ymax
602      DrawXaxis $w $xmin $xmax $xdelt
603
604      foreach {pxminorg pyminorg} [coordsToPixel $w $xminorg $ymin] {break}
605      foreach {pxmin pymin}       [coordsToPixel $w $xmin    $ymin] {break}
606      $w move data [expr {$pxminorg-$pxmin+1}] 0
607   }
608
609   DrawData $w $series $xcrd $ycrd
610}
611
612# DrawLogYData --
613#    Draw the data in an X-logY-plot
614# Arguments:
615#    w           Name of the canvas
616#    series      Data series
617#    xcrd        Next x coordinate
618#    ycrd        Next y coordinate
619# Result:
620#    None
621# Side effects:
622#    New data drawn in canvas
623#
624proc ::Plotchart::DrawLogYData { w series xcrd ycrd } {
625
626    DrawData $w $series $xcrd [expr {log10($ycrd)}]
627}
628
629# DrawLogXData --
630#    Draw the data in an logX-Y-plot
631# Arguments:
632#    w           Name of the canvas
633#    series      Data series
634#    xcrd        Next x coordinate
635#    ycrd        Next y coordinate
636# Result:
637#    None
638# Side effects:
639#    New data drawn in canvas
640#
641proc ::Plotchart::DrawLogXData { w series xcrd ycrd } {
642
643    DrawData $w $series [expr {log10($xcrd)}] $ycrd
644}
645
646# DrawLogXLogYData --
647#    Draw the data in an logX-logY-plot
648# Arguments:
649#    w           Name of the canvas
650#    series      Data series
651#    xcrd        Next x coordinate
652#    ycrd        Next y coordinate
653# Result:
654#    None
655# Side effects:
656#    New data drawn in canvas
657#
658proc ::Plotchart::DrawLogXLogYData { w series xcrd ycrd } {
659
660    DrawData $w $series [expr {log10($xcrd)}] [expr {log10($ycrd)}]
661}
662
663# DrawInterval --
664#    Draw the data as an error interval in an XY-plot
665# Arguments:
666#    w           Name of the canvas
667#    series      Data series
668#    xcrd        X coordinate
669#    ymin        Minimum y coordinate
670#    ymax        Maximum y coordinate
671#    ycentr      Central y coordinate (optional)
672# Result:
673#    None
674# Side effects:
675#    New interval drawn in canvas
676#
677proc ::Plotchart::DrawInterval { w series xcrd ymin ymax {ycentr {}} } {
678   variable data_series
679   variable scaling
680
681   #
682   # Check for missing values
683   #
684   if { $xcrd == "" || $ymin == "" || $ymax == "" } {
685       return
686   }
687
688   #
689   # Draw the line piece
690   #
691   set colour "black"
692   if { [info exists data_series($w,$series,-colour)] } {
693      set colour $data_series($w,$series,-colour)
694   }
695
696   foreach {pxcrd pymin} [coordsToPixel $w $xcrd $ymin] {break}
697   foreach {pxcrd pymax} [coordsToPixel $w $xcrd $ymax] {break}
698   if { $ycentr != "" } {
699       foreach {pxcrd pycentr} [coordsToPixel $w $xcrd $ycentr] {break}
700   }
701
702   #
703   # Draw the I-shape (note the asymmetry!)
704   #
705   $w create line $pxcrd $pymin $pxcrd $pymax \
706                        -fill $colour -tag [list data data_$series]
707   $w create line [expr {$pxcrd-3}] $pymin [expr {$pxcrd+4}] $pymin \
708                        -fill $colour -tag [list data data_$series]
709   $w create line [expr {$pxcrd-3}] $pymax [expr {$pxcrd+4}] $pymax \
710                        -fill $colour -tag [list data data_$series]
711
712   if { $ycentr != "" } {
713      set symbol "dot"
714      if { [info exists data_series($w,$series,-symbol)] } {
715         set symbol $data_series($w,$series,-symbol)
716      }
717      DrawSymbolPixel $w $series $pxcrd $pycentr $symbol $colour [list data data_$series]
718   }
719
720   $w lower data
721}
722
723# DrawSymbolPixel --
724#    Draw a symbol in an xy-plot, polar plot or stripchart
725# Arguments:
726#    w           Name of the canvas
727#    series      Data series
728#    pxcrd       Next x (pixel) coordinate
729#    pycrd       Next y (pixel) coordinate
730#    symbol      What symbol to draw
731#    colour      What colour to use
732#    tag         What tag to use
733# Result:
734#    None
735# Side effects:
736#    New symbol drawn in canvas
737#
738proc ::Plotchart::DrawSymbolPixel { w series pxcrd pycrd symbol colour tag } {
739   variable data_series
740   variable scaling
741
742   set pxmin  [expr {$pxcrd-4}]
743   set pxmax  [expr {$pxcrd+4}]
744   set pymin  [expr {$pycrd-4}]
745   set pymax  [expr {$pycrd+4}]
746
747   switch -- $symbol {
748   "plus"     { $w create line $pxmin $pycrd $pxmax $pycrd \
749                               $pxcrd $pycrd $pxcrd $pymin \
750                               $pxcrd $pymax \
751                               -fill $colour -tag $tag \
752                               -capstyle projecting
753              }
754   "cross"    { $w create line $pxmin $pymin $pxmax $pymax \
755                               $pxcrd $pycrd $pxmax $pymin \
756                               $pxmin $pymax \
757                               -fill $colour -tag $tag \
758                               -capstyle projecting
759              }
760   "circle"   { $w create oval $pxmin $pymin $pxmax $pymax \
761                               -outline $colour -tag $tag
762              }
763   "dot"      { $w create oval $pxmin $pymin $pxmax $pymax \
764                               -outline $colour -fill $colour -tag $tag
765              }
766   "up"       { $w create polygon $pxmin $pymax $pxmax $pymax \
767                               $pxcrd $pymin \
768                               -outline $colour -fill {} -tag $tag
769              }
770   "upfilled" { $w create polygon $pxmin $pymax $pxmax $pymax \
771                              $pxcrd $pymin \
772                              -outline $colour -fill $colour -tag $tag
773              }
774   "down"     { $w create polygon $pxmin $pymin $pxmax $pymin \
775                              $pxcrd $pymax \
776                              -outline $colour -fill {} -tag $tag
777              }
778   "downfilled" { $w create polygon $pxmin $pymin $pxmax $pymin \
779                              $pxcrd $pymax \
780                              -outline $colour -fill $colour -tag $tag
781              }
782   }
783}
784
785# DrawTimeData --
786#    Draw the data in an TX-plot
787# Arguments:
788#    w           Name of the canvas
789#    series      Data series
790#    time        Next date/time value
791#    xcrd        Next x coordinate (vertical axis)
792# Result:
793#    None
794# Side effects:
795#    New data drawn in canvas
796#
797proc ::Plotchart::DrawTimeData { w series time xcrd } {
798    DrawData $w $series [clock scan $time] $xcrd
799}
800
801# DetermineMedian --
802#    Determine the median of a sorted list of values
803# Arguments:
804#    values      Sorted values
805# Result:
806#    Median value
807#
808proc ::Plotchart::DetermineMedian { values } {
809    set length [llength $values]
810
811    if { $length == 1 } {
812        set median [lindex $values 0]
813    } elseif { $length % 2 == 1 } {
814        set median [lindex $values [expr {$length/2}]]
815    } else {
816        set median1 [lindex $values [expr {$length/2-1}]]
817        set median2 [lindex $values [expr {$length/2}]]
818        set median  [expr {($median1 + $median2)/2.0}]
819    }
820    return $median
821}
822
823# DrawBoxWhiskers --
824#    Draw the data in an XY-plot as box-and-whiskers
825# Arguments:
826#    w           Name of the canvas
827#    series      Data series
828#    xcrd        Next x coordinate or a list of coordinates
829#    ycrd        Next y coordinate or a list of coordinates
830# Result:
831#    None
832# Side effects:
833#    New data drawn in canvas
834# Note:
835#    We can do either a horizontal box (one y value) or
836#    a vertical box (one x value). Not both
837#
838proc ::Plotchart::DrawBoxWhiskers { w series xcrd ycrd } {
839    variable data_series
840    variable scaling
841
842    #
843    # Check orientation
844    #
845    set type "?"
846    if { [llength $xcrd] > 1 && [llength $ycrd] == 1 } {
847        set type h
848    }
849    if { [llength $xcrd] == 1 && [llength $ycrd] > 1 } {
850        set type v
851    }
852    if { $type == "?" } {
853        return -code error "Use either a list of x values or a list of y values - not both"
854    }
855
856    #
857    # Determine the quartiles
858    #
859    if { $type == "h" } {
860        set data [lsort -real -increasing $xcrd]
861    } else {
862        set data [lsort -real -increasing $ycrd]
863    }
864    set length    [llength $data]
865    if { $length % 2 == 0 } {
866        set lowerhalf [expr {($length-1)/2}]
867        set upperhalf [expr {($length+1)/2}]
868    } else {
869        set lowerhalf [expr {$length/2-1}]
870        set upperhalf [expr {$length/2+1}]
871    }
872
873    set quartile2 [DetermineMedian $data]
874    set quartile1 [DetermineMedian [lrange $data 0 $lowerhalf]]
875    set quartile3 [DetermineMedian [lrange $data $upperhalf end]]
876
877    set hspread   [expr {$quartile3-$quartile1}]
878
879    set lower     [expr {$quartile1-1.5*$hspread}]
880    set upper     [expr {$quartile3+1.5*$hspread}]
881    set outlower  [expr {$quartile1-3.0*$hspread}]
882    set outupper  [expr {$quartile3+3.0*$hspread}]
883
884    set minimum {}
885    set maximum {}
886    foreach value $data {
887        if { $value >= $lower } {
888            if { $minimum == {} || $minimum > $value } {
889                set minimum $value
890            }
891        }
892        if { $value <= $upper } {
893            if { $maximum == {} || $maximum < $value } {
894                set maximum $value
895            }
896        }
897    }
898
899    #
900    # Draw the box and whiskers
901    #
902    set colour "black"
903    if { [info exists data_series($w,$series,-colour)] } {
904       set colour $data_series($w,$series,-colour)
905    }
906    set filled "no"
907    if { [info exists data_series($w,$series,-filled)] } {
908       set filled $data_series($w,$series,-filled)
909    }
910    set fillcolour white
911    if { [info exists data_series($w,$series,-fillcolour)] } {
912       set fillcolour $data_series($w,$series,-fillcolour)
913    }
914    set boxwidth 10
915    if { [info exists data_series($w,$series,-boxwidth)] } {
916       set boxwidth $data_series($w,$series,-boxwidth)
917    }
918
919    if { $type == "h" } {
920        foreach {pxcrdm pycrd1} [coordsToPixel $w $minimum   $ycrd] {break}
921        foreach {pxcrd1 pycrd2} [coordsToPixel $w $quartile1 $ycrd] {break}
922        foreach {pxcrd2 pycrd2} [coordsToPixel $w $quartile2 $ycrd] {break}
923        foreach {pxcrd3 pycrd2} [coordsToPixel $w $quartile3 $ycrd] {break}
924        foreach {pxcrdM pycrd2} [coordsToPixel $w $maximum   $ycrd] {break}
925
926        set pycrd0  [expr {$pycrd1-$boxwidth/2}]
927        set pycrd2  [expr {$pycrd1+$boxwidth/2}]
928        set pycrd0h [expr {$pycrd1-$boxwidth/4}]
929        set pycrd2h [expr {$pycrd1+$boxwidth/4}]
930
931        $w create line      $pxcrdm $pycrd1 $pxcrd1 $pycrd1 \
932                             -fill $colour -tag [list data data_$series]
933        $w create line      $pxcrdm $pycrd0h $pxcrdm $pycrd2h \
934                             -fill $colour -tag [list data data_$series]
935        $w create line      $pxcrd3 $pycrd1 $pxcrdM $pycrd1 \
936                             -fill $colour -tag [list data data_$series]
937        $w create line      $pxcrdM $pycrd0h $pxcrdM $pycrd2h \
938                             -fill $colour -tag [list data data_$series]
939        $w create rectangle $pxcrd1 $pycrd0 $pxcrd3 $pycrd2 \
940            -outline $colour -fill $fillcolour -tag [list data data_$series]
941        $w create line      $pxcrd2 $pycrd0 $pxcrd2 $pycrd2 -width 2 \
942                             -fill $colour -tag [list data data_$series]
943
944        foreach value $data {
945            if { $value < $outlower || $value > $outupper } {
946                foreach {px py} [coordsToPixel $w $value $ycrd] {break}
947                $w create text $px $py -text "*" -anchor c \
948                             -fill $colour -tag [list data data_$series]
949                continue
950            }
951            if { $value < $lower || $value > $upper } {
952                foreach {px py} [coordsToPixel $w $value $ycrd] {break}
953                $w create oval [expr {$px-2}] [expr {$py-2}] \
954                               [expr {$px+2}] [expr {$py+2}] \
955                             -fill $colour -tag [list data data_$series]
956                continue
957            }
958        }
959
960    } else {
961        foreach {pxcrd1 pycrdm} [coordsToPixel $w $xcrd $minimum  ] {break}
962        foreach {pxcrd2 pycrd1} [coordsToPixel $w $xcrd $quartile1] {break}
963        foreach {pxcrd2 pycrd2} [coordsToPixel $w $xcrd $quartile2] {break}
964        foreach {pxcrd2 pycrd3} [coordsToPixel $w $xcrd $quartile3] {break}
965        foreach {pxcrd2 pycrdM} [coordsToPixel $w $xcrd $maximum  ] {break}
966
967        set pxcrd0  [expr {$pxcrd1-$boxwidth/2}]
968        set pxcrd2  [expr {$pxcrd1+$boxwidth/2}]
969        set pxcrd0h [expr {$pxcrd1-$boxwidth/4}]
970        set pxcrd2h [expr {$pxcrd1+$boxwidth/4}]
971
972        $w create line      $pxcrd1 $pycrdm $pxcrd1 $pycrd1 \
973                             -fill $colour -tag [list data data_$series]
974        $w create line      $pxcrd0h $pycrdm $pxcrd2h $pycrdm \
975                             -fill $colour -tag [list data data_$series]
976        $w create line      $pxcrd1 $pycrd3 $pxcrd1 $pycrdM \
977                             -fill $colour -tag [list data data_$series]
978        $w create line      $pxcrd0h $pycrdM $pxcrd2h $pycrdM \
979                             -fill $colour -tag [list data data_$series]
980        $w create rectangle $pxcrd0 $pycrd1 $pxcrd2 $pycrd3 \
981            -outline $colour -fill $fillcolour -tag [list data data_$series]
982        $w create line      $pxcrd0 $pycrd2 $pxcrd2 $pycrd2 -width 2 \
983                             -fill $colour -tag [list data data_$series]
984
985        foreach value $data {
986            if { $value < $outlower || $value > $outupper } {
987                foreach {px py} [coordsToPixel $w $xcrd $value] {break}
988                $w create text $px $py -text "*" \
989                             -fill $colour -tag [list data data_$series]
990                continue
991            }
992            if { $value < $lower || $value > $upper } {
993                foreach {px py} [coordsToPixel $w $xcrd $value] {break}
994                $w create oval [expr {$px-3}] [expr {$py-3}] \
995                               [expr {$px+3}] [expr {$py+3}] \
996                             -fill $colour -tag [list data data_$series]
997                continue
998            }
999        }
1000    }
1001
1002    $w lower data
1003}
1004
1005# DrawBoxData --
1006#    Draw the data in a boxplot (y-axis consists of labels)
1007# Arguments:
1008#    w           Name of the canvas
1009#    label       Label on the y-axis to put the box on
1010#    xcrd        Next x coordinate or a list of coordinates
1011# Result:
1012#    None
1013# Side effects:
1014#    New data drawn in canvas
1015#
1016proc ::Plotchart::DrawBoxData { w label xcrd } {
1017   variable config
1018   variable scaling
1019
1020   set index [lsearch $config($w,axisnames) $label]
1021   if { $index == -1 } {
1022       return "Label $label not found on y-axis"
1023   }
1024
1025   set ycrd [expr {$index+0.5}]
1026
1027   DrawBoxWhiskers $w box $xcrd $ycrd
1028}
1029
1030# DrawPie --
1031#    Draw the pie
1032# Arguments:
1033#    w           Name of the canvas
1034#    data        Data series (pairs of label-value)
1035# Result:
1036#    None
1037# Side effects:
1038#    Pie filled
1039#
1040proc ::Plotchart::DrawPie { w data } {
1041   variable data_series
1042   variable scaling
1043
1044   set pxmin $scaling($w,pxmin)
1045   set pymin $scaling($w,pymin)
1046   set pxmax $scaling($w,pxmax)
1047   set pymax $scaling($w,pymax)
1048
1049   set colours $scaling(${w},colours)
1050
1051   if {[llength ${data}] == 2} {
1052       # use canvas create oval as arc does not fill with colour for a full circle
1053       set colour [lindex ${colours} 0]
1054       ${w} create oval ${pxmin} ${pymin} ${pxmax} ${pymax} -fill ${colour}
1055       # text looks nicer at 45 degree
1056       set rad [expr {45.0 * 3.1415926 / 180.0}]
1057       set xtext [expr {(${pxmin}+${pxmax}+cos(${rad})*(${pxmax}-${pxmin}+20))/2}]
1058       set ytext [expr {(${pymin}+${pymax}-sin(${rad})*(${pymax}-${pymin}+20))/2}]
1059       foreach {label value} ${data} {
1060           break
1061       }
1062       ${w} create text ${xtext} ${ytext} -text ${label} -anchor w
1063       set scaling($w,angles) {0 360}
1064   } else {
1065       #
1066       # Determine the scale for the values
1067       # (so we can draw the correct angles)
1068       #
1069
1070       set sum 0.0
1071       foreach {label value} $data {
1072          set sum [expr {$sum + $value}]
1073       }
1074       set factor [expr {360.0/$sum}]
1075
1076       #
1077       # Draw the line piece
1078       #
1079       set angle_bgn 0.0
1080       set angle_ext 0.0
1081       set sum       0.0
1082
1083       set idx     0
1084       set segment 0
1085
1086       array unset scaling ${w},angles
1087       array unset scaling ${w},extent
1088       set colours [CycleColours ${colours} [expr {[llength ${data}] / 2}]]
1089
1090       foreach {label value} $data {
1091          set colour [lindex $colours $idx]
1092          incr idx
1093
1094          if { $value == "" } {
1095              break
1096          }
1097
1098          set angle_bgn [expr {$sum   * $factor}]
1099          set angle_ext [expr {$value * $factor}]
1100          lappend scaling(${w},angles) [expr {int(${angle_bgn})}]
1101          lappend scaling(${w},extent) [expr {int(${angle_ext})}]
1102
1103          $w create arc  $pxmin $pymin $pxmax $pymax \
1104                         -start $angle_bgn -extent $angle_ext \
1105                         -fill $colour -style pieslice -tag segment_$segment
1106
1107          set rad   [expr {($angle_bgn+0.5*$angle_ext)*3.1415926/180.0}]
1108          set xtext [expr {($pxmin+$pxmax+cos($rad)*($pxmax-$pxmin+20))/2}]
1109          set ytext [expr {($pymin+$pymax-sin($rad)*($pymax-$pymin+20))/2}]
1110          if { $xtext > ($pxmin+$pymax)/2 } {
1111             set dir w
1112          } else {
1113             set dir e
1114          }
1115
1116          $w create text $xtext $ytext -text $label -anchor $dir -tag segment_$segment
1117
1118          $w bind segment_$segment <ButtonPress-1> [list ::Plotchart::PieExplodeSegment $w $segment 1]
1119
1120          set sum [expr {$sum + $value}]
1121          incr segment
1122       }
1123   }
1124}
1125
1126# DrawPolarData --
1127#    Draw data given in polar coordinates
1128# Arguments:
1129#    w           Name of the canvas
1130#    series      Data series
1131#    rad         Next radius
1132#    phi         Next angle (in degrees)
1133# Result:
1134#    None
1135# Side effects:
1136#    Data drawn in canvas
1137#
1138proc ::Plotchart::DrawPolarData { w series rad phi } {
1139   variable torad
1140   set xcrd [expr {$rad*cos($phi*$torad)}]
1141   set ycrd [expr {$rad*sin($phi*$torad)}]
1142
1143   DrawData $w $series $xcrd $ycrd
1144}
1145
1146# DrawVertBarData --
1147#    Draw the vertical bars
1148# Arguments:
1149#    w           Name of the canvas
1150#    series      Data series
1151#    ydata       Series of y data
1152#    colour      The colour to use (optional)
1153#    dir         Direction if graded colours are used (see DrawGradientBackground)
1154#    brightness  Brighten (bright) or darken (dark) the colours
1155# Result:
1156#    None
1157# Side effects:
1158#    Data bars drawn in canvas
1159#
1160proc ::Plotchart::DrawVertBarData { w series ydata {colour black} {dir {}} {brightness bright}} {
1161   variable data_series
1162   variable scaling
1163   variable legend
1164   variable settings
1165
1166   #
1167   # Draw the bars
1168   #
1169   set x $scaling($w,xbase)
1170
1171   #
1172   # set the colours
1173   #
1174   if {[llength ${colour}]} {
1175       set colours ${colour}
1176   } elseif {[info exists scaling(${w},colours)]} {
1177       set colours $scaling(${w},colours)
1178   } else {
1179       set colours {}
1180   }
1181   set colours [CycleColours ${colours} [llength ${ydata}]]
1182
1183   #
1184   # Legend information
1185   #
1186   set legendcol [lindex $colours 0]
1187   set data_series($w,$series,-colour) $legendcol
1188   set data_series($w,$series,-type)   rectangle
1189   if { [info exists legend($w,canvas)] } {
1190       set legendw $legend($w,canvas)
1191       $legendw itemconfigure $series -fill $legendcol
1192   }
1193
1194   set newbase {}
1195
1196   set idx 0
1197   foreach yvalue $ydata ybase $scaling($w,ybase) {
1198      set colour [lindex ${colours} ${idx}]
1199      incr idx
1200
1201      if { $yvalue == "" } {
1202          set yvalue 0.0
1203      }
1204
1205      set xnext [expr {$x+$scaling($w,barwidth)}]
1206      set y     [expr {$yvalue+$ybase}]
1207      foreach {px1 py1} [coordsToPixel $w $x     $ybase] {break}
1208      foreach {px2 py2} [coordsToPixel $w $xnext $y    ] {break}
1209
1210      if { $dir == {} } {
1211          $w create rectangle $px1 $py1 $px2 $py2 \
1212                         -fill $colour -tag [list data data_$series]
1213      } else {
1214          if { $brightness == "dark" } {
1215              set intensity black
1216          } else {
1217              set intensity white
1218          }
1219          DrawGradientBackground $w $colour $dir $intensity [list $px1 $py1 $px2 $py2]
1220      }
1221
1222      if { $settings($w,showvalues) } {
1223          set pxtext [expr {($px1+$px2)/2.0}]
1224          set pytext [expr {$py2-5}]
1225          set text   [format $settings($w,valueformat) $yvalue]
1226          if { $settings($w,valuefont) == "" } {
1227              $w create text $pxtext $pytext -text $text -anchor s \
1228                         -fill $settings($w,valuecolour) -tag [list data data_$series]
1229          } else {
1230              $w create text $pxtext $pytext -text $text -anchor s \
1231                         -fill $settings($w,valuecolour) -tag [list data data_$series] \
1232                         -font $settings($w,valuefont)
1233          }
1234      }
1235
1236      $w lower data
1237
1238      set x [expr {$x+1.0}]
1239
1240      lappend newbase $y
1241   }
1242
1243   #
1244   # Prepare for the next series
1245   #
1246   if { $scaling($w,stacked) } {
1247      set scaling($w,ybase) $newbase
1248   }
1249
1250   set scaling($w,xbase) [expr {$scaling($w,xbase)+$scaling($w,xshift)}]
1251}
1252
1253# DrawHorizBarData --
1254#    Draw the horizontal bars
1255# Arguments:
1256#    w           Name of the canvas
1257#    series      Data series
1258#    xdata       Series of x data
1259#    colour      The colour to use (optional)
1260#    dir         Direction if graded colours are used (see DrawGradientBackground)
1261#    brightness  Brighten (bright) or darken (dark) the colours
1262# Result:
1263#    None
1264# Side effects:
1265#    Data bars drawn in canvas
1266#
1267proc ::Plotchart::DrawHorizBarData { w series xdata {colour black} {dir {}} {brightness bright}} {
1268   variable data_series
1269   variable scaling
1270   variable legend
1271   variable settings
1272
1273   #
1274   # Draw the bars
1275   #
1276   set y $scaling($w,ybase)
1277
1278   #
1279   # set the colours
1280   #
1281   if {[llength ${colour}]} {
1282       set colours ${colour}
1283   } elseif {[info exists scaling(${w},colours)]} {
1284       set colours $scaling(${w},colours)
1285   } else {
1286       set colours {}
1287   }
1288   set colours [CycleColours ${colours} [llength ${xdata}]]
1289
1290   #
1291   # Legend information
1292   #
1293   set legendcol [lindex $colours 0]
1294   set data_series($w,$series,-colour) $legendcol
1295   if { [info exists legend($w,canvas)] } {
1296       set legendw $legend($w,canvas)
1297       $legendw itemconfigure $series -fill $legendcol
1298   }
1299
1300   set newbase {}
1301
1302   set idx 0
1303   foreach xvalue $xdata xbase $scaling($w,xbase) {
1304      set colour [lindex ${colours} ${idx}]
1305      incr idx
1306
1307      if { $xvalue == "" } {
1308          set xvalue 0.0
1309      }
1310
1311      set ynext [expr {$y+$scaling($w,barwidth)}]
1312      set x     [expr {$xvalue+$xbase}]
1313      foreach {px1 py1} [coordsToPixel $w $xbase $y    ] {break}
1314      foreach {px2 py2} [coordsToPixel $w $x     $ynext] {break}
1315
1316      if { $dir == {} } {
1317          $w create rectangle $px1 $py1 $px2 $py2 \
1318                         -fill $colour -tag data
1319      } else {
1320          if { $brightness == "dark" } {
1321              set intensity black
1322          } else {
1323              set intensity white
1324          }
1325          DrawGradientBackground $w $colour $dir $intensity [list $px1 $py1 $px2 $py2]
1326      }
1327
1328      if { $settings($w,showvalues) } {
1329          set pytext [expr {($py1+$py2)/2.0}]
1330          set pxtext [expr {$px2+5}]
1331          set text   [format $settings($w,valueformat) $xvalue]
1332          if { $settings($w,valuefont) == "" } {
1333              $w create text $pxtext $pytext -text $text -anchor w \
1334                         -fill $settings($w,valuecolour) -tag [list data data_$series]
1335          } else {
1336              $w create text $pxtext $pytext -text $text -anchor w \
1337                         -fill $settings($w,valuecolour) -tag [list data data_$series] \
1338                         -font $settings($w,valuefont)
1339          }
1340      }
1341
1342      $w lower data
1343
1344      set y [expr {$y+1.0}]
1345
1346      lappend newbase $x
1347   }
1348
1349   #
1350   # Prepare for the next series
1351   #
1352   if { $scaling($w,stacked) } {
1353      set scaling($w,xbase) $newbase
1354   }
1355
1356   set scaling($w,ybase) [expr {$scaling($w,ybase)+$scaling($w,yshift)}]
1357}
1358
1359# DrawHistogramData --
1360#    Draw the vertical bars for a histogram
1361# Arguments:
1362#    w           Name of the canvas
1363#    series      Data series
1364#    xcrd        X coordinate (for the righthand side of the bar)
1365#    ycrd        Y coordinate
1366# Result:
1367#    None
1368# Side effects:
1369#    Data bars drawn in canvas
1370#
1371proc ::Plotchart::DrawHistogramData { w series xcrd ycrd } {
1372   variable data_series
1373   variable scaling
1374
1375   #
1376   # Check for missing values (only y-value can be missing!)
1377   #
1378   if { $ycrd == "" } {
1379       set data_series($w,$series,x) $xcrd
1380       return
1381   }
1382
1383   #
1384   # Draw the bar
1385   #
1386   set colour "black"
1387   if { [info exists data_series($w,$series,-colour)] } {
1388      set colour $data_series($w,$series,-colour)
1389   }
1390
1391   foreach {pxcrd pycrd} [coordsToPixel $w $xcrd $ycrd] {break}
1392
1393   if { [info exists data_series($w,$series,x)] } {
1394      set xold $data_series($w,$series,x)
1395   } else {
1396      set xold $scaling($w,xmin)
1397   }
1398   set yold $scaling($w,ymin)
1399   foreach {pxold pyold} [coordsToPixel $w $xold $yold] {break}
1400
1401   $w create rectangle $pxold $pyold $pxcrd $pycrd \
1402                         -fill $colour -outline $colour -tag data
1403   $w lower data
1404
1405   set data_series($w,$series,x) $xcrd
1406}
1407
1408# DrawTimePeriod --
1409#    Draw a period
1410# Arguments:
1411#    w           Name of the canvas
1412#    text        Text to identify the "period" item
1413#    time_begin  Start time
1414#    time_end    Stop time
1415#    colour      The colour to use (optional)
1416# Result:
1417#    None
1418# Side effects:
1419#    Data bars drawn in canvas
1420#
1421proc ::Plotchart::DrawTimePeriod { w text time_begin time_end {colour black}} {
1422   variable data_series
1423   variable scaling
1424
1425   #
1426   # Draw the text first
1427   #
1428   set ytext [expr {$scaling($w,current)+0.5*$scaling($w,dy)}]
1429   foreach {x y} [coordsToPixel $w $scaling($w,xmin) $ytext] {break}
1430
1431   $w create text 5 $y -text $text -anchor w \
1432       -tags [list vertscroll above item_[expr {int($scaling($w,current))}]]
1433
1434   #
1435   # Draw the bar to indicate the period
1436   #
1437   set xmin  [clock scan $time_begin]
1438   set xmax  [clock scan $time_end]
1439   set ybott [expr {$scaling($w,current)+$scaling($w,dy)}]
1440
1441   foreach {x1 y1} [coordsToPixel $w $xmin $scaling($w,current)] {break}
1442   foreach {x2 y2} [coordsToPixel $w $xmax $ybott              ] {break}
1443
1444   $w create rectangle $x1 $y1 $x2 $y2 -fill $colour \
1445       -tags [list vertscroll horizscroll below item_[expr {int($scaling($w,current))}]]
1446
1447   ReorderChartItems $w
1448
1449   set scaling($w,current) [expr {$scaling($w,current)-1.0}]
1450
1451   RescaleChart $w
1452}
1453
1454# DrawTimeVertLine --
1455#    Draw a vertical line with a label
1456# Arguments:
1457#    w           Name of the canvas
1458#    text        Text to identify the line
1459#    time        Time for which the line is drawn
1460# Result:
1461#    None
1462# Side effects:
1463#    Line drawn in canvas
1464#
1465proc ::Plotchart::DrawTimeVertLine { w text time {colour black}} {
1466   variable data_series
1467   variable scaling
1468
1469   #
1470   # Draw the text first
1471   #
1472   set xtime [clock scan $time]
1473   #set ytext [expr {$scaling($w,ymax)-0.5*$scaling($w,dy)}]
1474   set ytext $scaling($w,ymax)
1475   foreach {x y} [coordsToPixel $w $xtime $ytext] {break}
1476   set y [expr {$y-5}]
1477
1478   $w create text $x $y -text $text -anchor sw -tags {horizscroll timeline}
1479
1480   #
1481   # Draw the line
1482   #
1483   foreach {x1 y1} [coordsToPixel $w $xtime $scaling($w,ymin)] {break}
1484   foreach {x2 y2} [coordsToPixel $w $xtime $scaling($w,ymax)] {break}
1485
1486   $w create line $x1 $y1 $x2 $y2 -fill black -tags {horizscroll timeline tline}
1487
1488   $w raise topmask
1489}
1490
1491# DrawTimeMilestone --
1492#    Draw a "milestone"
1493# Arguments:
1494#    w           Name of the canvas
1495#    text        Text to identify the line
1496#    time        Time for which the milestone is drawn
1497#    colour      Optionally the colour
1498# Result:
1499#    None
1500# Side effects:
1501#    Line drawn in canvas
1502#
1503proc ::Plotchart::DrawTimeMilestone { w text time {colour black}} {
1504   variable data_series
1505   variable scaling
1506
1507   #
1508   # Draw the text first
1509   #
1510   set ytext [expr {$scaling($w,current)+0.5*$scaling($w,dy)}]
1511   foreach {x y} [coordsToPixel $w $scaling($w,xmin) $ytext] {break}
1512
1513   $w create text 5 $y -text $text -anchor w \
1514       -tags [list vertscroll above item_[expr {int($scaling($w,current))}]]
1515
1516   #
1517   # Draw an upside-down triangle to indicate the time
1518   #
1519   set xcentre [clock scan $time]
1520   set ytop    $scaling($w,current)
1521   set ybott   [expr {$scaling($w,current)+0.8*$scaling($w,dy)}]
1522
1523   foreach {x1 y1} [coordsToPixel $w $xcentre $ybott] {break}
1524   foreach {x2 y2} [coordsToPixel $w $xcentre $ytop]  {break}
1525
1526   set x2 [expr {$x1-0.4*($y1-$y2)}]
1527   set x3 [expr {$x1+0.4*($y1-$y2)}]
1528   set y3 $y2
1529
1530   $w create polygon $x1 $y1 $x2 $y2 $x3 $y3 -fill $colour \
1531       -tags [list vertscroll horizscroll below item_[expr {int($scaling($w,current))}]]
1532
1533   ReorderChartItems $w
1534
1535   set scaling($w,current) [expr {$scaling($w,current)-1.0}]
1536
1537   RescaleChart $w
1538}
1539
1540# ScaleItems --
1541#    Scale all items by a given factor
1542# Arguments:
1543#    w           Name of the canvas
1544#    xcentre     X-coordinate of centre
1545#    ycentre     Y-coordinate of centre
1546#    factor      The factor to scale them by
1547# Result:
1548#    None
1549# Side effects:
1550#    All items are scaled by the given factor and the
1551#    world coordinates are adjusted.
1552#
1553proc ::Plotchart::ScaleItems { w xcentre ycentre factor } {
1554   variable scaling
1555
1556   $w scale all $xcentre $ycentre $factor $factor
1557
1558   foreach {xc yc} [pixelToCoords $w $xcentre $ycentre] {break}
1559
1560   set rfact               [expr {1.0/$factor}]
1561   set scaling($w,xfactor) [expr {$scaling($w,xfactor)*$factor}]
1562   set scaling($w,yfactor) [expr {$scaling($w,yfactor)*$factor}]
1563   set scaling($w,xmin)    [expr {(1.0-$rfact)*$xc+$rfact*$scaling($w,xmin)}]
1564   set scaling($w,xmax)    [expr {(1.0-$rfact)*$xc+$rfact*$scaling($w,xmax)}]
1565   set scaling($w,ymin)    [expr {(1.0-$rfact)*$yc+$rfact*$scaling($w,ymin)}]
1566   set scaling($w,ymax)    [expr {(1.0-$rfact)*$yc+$rfact*$scaling($w,ymax)}]
1567}
1568
1569# MoveItems --
1570#    Move all items by a given vector
1571# Arguments:
1572#    w           Name of the canvas
1573#    xmove       X-coordinate of move vector
1574#    ymove       Y-coordinate of move vector
1575# Result:
1576#    None
1577# Side effects:
1578#    All items are moved by the given vector and the
1579#    world coordinates are adjusted.
1580#
1581proc ::Plotchart::MoveItems { w xmove ymove } {
1582   variable scaling
1583
1584   $w move all $xmove $ymove
1585
1586   set dx                  [expr {$scaling($w,xfactor)*$xmove}]
1587   set dy                  [expr {$scaling($w,yfactor)*$ymove}]
1588   set scaling($w,xmin)    [expr {$scaling($w,xmin)+$dx}]
1589   set scaling($w,xmax)    [expr {$scaling($w,xmax)+$dx}]
1590   set scaling($w,ymin)    [expr {$scaling($w,ymin)+$dy}]
1591   set scaling($w,ymax)    [expr {$scaling($w,ymax)+$dy}]
1592}
1593
1594# DrawIsometricData --
1595#    Draw the data in an isometric plot
1596# Arguments:
1597#    w           Name of the canvas
1598#    type        Type of data
1599#    args        Coordinates and so on
1600# Result:
1601#    None
1602# Side effects:
1603#    New data drawn in canvas
1604#
1605proc ::Plotchart::DrawIsometricData { w type args } {
1606   variable data_series
1607
1608   #
1609   # What type of data?
1610   #
1611   if { $type == "rectangle" } {
1612      foreach {x1 y1 x2 y2 colour} [concat $args "black"] {break}
1613      foreach {px1 py1} [coordsToPixel $w $x1 $y1] {break}
1614      foreach {px2 py2} [coordsToPixel $w $x2 $y2] {break}
1615      $w create rectangle $px1 $py1 $px2 $py2 \
1616                     -outline $colour -tag data
1617      $w lower data
1618   }
1619
1620   if { $type == "filled-rectangle" } {
1621      foreach {x1 y1 x2 y2 colour} [concat $args "black"] {break}
1622      foreach {px1 py1} [coordsToPixel $w $x1 $y1] {break}
1623      foreach {px2 py2} [coordsToPixel $w $x2 $y2] {break}
1624      $w create rectangle $px1 $py1 $px2 $py2 \
1625                     -outline $colour -fill $colour -tag data
1626      $w lower data
1627   }
1628
1629   if { $type == "filled-circle" } {
1630      foreach {x1 y1 rad colour} [concat $args "black"] {break}
1631      set x2 [expr {$x1+$rad}]
1632      set y2 [expr {$y1+$rad}]
1633      set x1 [expr {$x1-$rad}]
1634      set y1 [expr {$y1-$rad}]
1635      foreach {px1 py1} [coordsToPixel $w $x1 $y1] {break}
1636      foreach {px2 py2} [coordsToPixel $w $x2 $y2] {break}
1637      $w create oval $px1 $py1 $px2 $py2 \
1638                     -outline $colour -fill $colour -tag data
1639      $w lower data
1640   }
1641
1642   if { $type == "circle" } {
1643      foreach {x1 y1 rad colour} [concat $args "black"] {break}
1644      set x2 [expr {$x1+$rad}]
1645      set y2 [expr {$y1+$rad}]
1646      set x1 [expr {$x1-$rad}]
1647      set y1 [expr {$y1-$rad}]
1648      foreach {px1 py1} [coordsToPixel $w $x1 $y1] {break}
1649      foreach {px2 py2} [coordsToPixel $w $x2 $y2] {break}
1650      $w create oval $px1 $py1 $px2 $py2 \
1651                     -outline $colour -tag data
1652      $w lower data
1653   }
1654
1655}
1656
1657# BackgroundColour --
1658#    Set the background colour or other aspects of the background
1659# Arguments:
1660#    w           Name of the canvas
1661#    part        Which part: axes or plot
1662#    colour      Colour to use (or if part is "image", name of the image)
1663#    dir         Direction of increasing whiteness (optional, for "gradient"
1664#    brightness  Brighten (bright) or darken (dark) the colours
1665#
1666# Result:
1667#    None
1668# Side effect:
1669#    Colour of the relevant part is changed
1670#
1671proc ::Plotchart::BackgroundColour { w part colour {dir {}} {brighten bright}} {
1672    if { $part == "axes" } {
1673        $w configure -highlightthickness 0
1674        $w itemconfigure mask -fill $colour -outline $colour
1675    }
1676    if { $part == "plot" } {
1677        $w configure -highlightthickness 0
1678        $w configure -background $colour
1679    }
1680    if { $part == "gradient" } {
1681          if { $brighten == "dark" } {
1682              set intensity black
1683          } else {
1684              set intensity white
1685          }
1686        DrawGradientBackground $w $colour $dir $intensity
1687    }
1688    if { $part == "image" } {
1689        DrawImageBackground $w $colour
1690    }
1691}
1692
1693# DrawRadialSpokes --
1694#    Draw the spokes of the radial chart
1695# Arguments:
1696#    w           Name of the canvas
1697#    names       Names of the spokes
1698# Result:
1699#    None
1700# Side effects:
1701#    Radial chart filled in
1702#
1703proc ::Plotchart::DrawRadialSpokes { w names } {
1704   variable settings
1705   variable scaling
1706
1707   set pxmin $scaling($w,pxmin)
1708   set pymin $scaling($w,pymin)
1709   set pxmax $scaling($w,pxmax)
1710   set pymax $scaling($w,pymax)
1711
1712   $w create oval $pxmin $pymin $pxmax $pymax -outline black
1713
1714   set dangle [expr {2.0 * 3.1415926 / [llength $names]}]
1715   set angle  0.0
1716   set xcentr [expr {($pxmin+$pxmax)/2.0}]
1717   set ycentr [expr {($pymin+$pymax)/2.0}]
1718
1719   foreach name $names {
1720       set xtext  [expr {$xcentr+cos($angle)*($pxmax-$pxmin+20)/2}]
1721       set ytext  [expr {$ycentr-sin($angle)*($pymax-$pymin+20)/2}]
1722       set xspoke [expr {$xcentr+cos($angle)*($pxmax-$pxmin)/2}]
1723       set yspoke [expr {$ycentr-sin($angle)*($pymax-$pymin)/2}]
1724
1725       if { cos($angle) >= 0.0 } {
1726           set anchor w
1727       } else {
1728           set anchor e
1729       }
1730
1731       if { abs($xspoke-$xcentr) < 2 } {
1732           set xspoke $xcentr
1733       }
1734       if { abs($yspoke-$ycentr) < 2 } {
1735           set yspoke $ycentr
1736       }
1737
1738       $w create text $xtext $ytext -text $name -anchor $anchor
1739       $w create line $xcentr $ycentr $xspoke $yspoke -fill black
1740
1741       set angle [expr {$angle+$dangle}]
1742   }
1743}
1744
1745# DrawRadial --
1746#    Draw the data for the radial chart
1747# Arguments:
1748#    w           Name of the canvas
1749#    values      Values for each spoke
1750#    colour      Colour of the line
1751#    thickness   Thickness of the line (optional)
1752# Result:
1753#    None
1754# Side effects:
1755#    New line drawn
1756#
1757proc ::Plotchart::DrawRadial { w values colour {thickness 1} } {
1758   variable data_series
1759   variable settings
1760   variable scaling
1761
1762   if { [llength $values] != $settings($w,number) } {
1763       return -code error "Incorrect number of data given - should be $settings($w,number)"
1764   }
1765
1766   set pxmin $scaling($w,pxmin)
1767   set pymin $scaling($w,pymin)
1768   set pxmax $scaling($w,pxmax)
1769   set pymax $scaling($w,pymax)
1770
1771   set dangle [expr {2.0 * 3.1415926 / [llength $values]}]
1772   set angle  0.0
1773   set xcentr [expr {($pxmin+$pxmax)/2.0}]
1774   set ycentr [expr {($pymin+$pymax)/2.0}]
1775
1776   set coords {}
1777
1778   if { ! [info exists data_series($w,base)] } {
1779       set data_series($w,base) {}
1780       foreach value $values {
1781           lappend data_series($w,base) 0.0
1782       }
1783   }
1784
1785   set newbase {}
1786   foreach value $values base $data_series($w,base) {
1787       if { $settings($w,style) != "lines" } {
1788           set value [expr {$value+$base}]
1789       }
1790       set factor [expr {$value/$settings($w,scale)}]
1791       set xspoke [expr {$xcentr+$factor*cos($angle)*($pxmax-$pxmin)/2}]
1792       set yspoke [expr {$ycentr-$factor*sin($angle)*($pymax-$pymin)/2}]
1793
1794       if { abs($xspoke-$xcentr) < 2 } {
1795           set xspoke $xcentr
1796       }
1797       if { abs($yspoke-$ycentr) < 2 } {
1798           set yspoke $ycentr
1799       }
1800
1801       lappend coords $xspoke $yspoke
1802       lappend newbase $value
1803       set angle [expr {$angle+$dangle}]
1804   }
1805
1806   set data_series($w,base) $newbase
1807
1808   if { $settings($w,style) == "filled" } {
1809       set fillcolour $colour
1810   } else {
1811       set fillcolour ""
1812   }
1813
1814   set id [$w create polygon $coords -outline $colour -width $thickness -fill $fillcolour -tags data]
1815   $w lower $id
1816}
1817
1818# DrawTrendLine --
1819#    Draw a trend line based on the given data in an XY-plot
1820# Arguments:
1821#    w           Name of the canvas
1822#    series      Data series
1823#    xcrd        Next x coordinate
1824#    ycrd        Next y coordinate
1825# Result:
1826#    None
1827# Side effects:
1828#    New/updated trend line drawn in canvas
1829#
1830proc ::Plotchart::DrawTrendLine { w series xcrd ycrd } {
1831    variable data_series
1832    variable scaling
1833
1834    #
1835    # Check for missing values
1836    #
1837    if { $xcrd == "" || $ycrd == "" } {
1838        return
1839    }
1840
1841    #
1842    # Compute the coefficients of the line
1843    #
1844    if { [info exists data_series($w,$series,xsum)] } {
1845        set nsum  [expr {$data_series($w,$series,nsum)  + 1.0}]
1846        set xsum  [expr {$data_series($w,$series,xsum)  + $xcrd}]
1847        set x2sum [expr {$data_series($w,$series,x2sum) + $xcrd*$xcrd}]
1848        set ysum  [expr {$data_series($w,$series,ysum)  + $ycrd}]
1849        set xysum [expr {$data_series($w,$series,xysum) + $ycrd*$xcrd}]
1850    } else {
1851        set nsum  [expr {1.0}]
1852        set xsum  [expr {$xcrd}]
1853        set x2sum [expr {$xcrd*$xcrd}]
1854        set ysum  [expr {$ycrd}]
1855        set xysum [expr {$ycrd*$xcrd}]
1856    }
1857
1858    if { $nsum*$x2sum != $xsum*$xsum } {
1859        set a [expr {($nsum*$xysum-$xsum*$ysum)/($nsum*$x2sum - $xsum*$xsum)}]
1860    } else {
1861        set a 0.0
1862    }
1863    set b [expr {($ysum-$a*$xsum)/$nsum}]
1864
1865    set xmin $scaling($w,xmin)
1866    set xmax $scaling($w,xmax)
1867
1868    foreach {pxmin pymin} [coordsToPixel $w $xmin [expr {$a*$xmin+$b}]] {break}
1869    foreach {pxmax pymax} [coordsToPixel $w $xmax [expr {$a*$xmax+$b}]] {break}
1870
1871    #
1872    # Draw the actual line
1873    #
1874    set colour "black"
1875    if { [info exists data_series($w,$series,-colour)] } {
1876        set colour $data_series($w,$series,-colour)
1877    }
1878
1879    if { [info exists data_series($w,$series,trend)] } {
1880        $w coords $data_series($w,$series,trend) $pxmin $pymin $pxmax $pymax
1881    } else {
1882        set data_series($w,$series,trend) \
1883            [$w create line $pxmin $pymin $pxmax $pymax -fill $colour -tag [list data data_$series]]
1884    }
1885
1886    $w lower data
1887
1888    set data_series($w,$series,nsum)  $nsum
1889    set data_series($w,$series,xsum)  $xsum
1890    set data_series($w,$series,x2sum) $x2sum
1891    set data_series($w,$series,ysum)  $ysum
1892    set data_series($w,$series,xysum) $xysum
1893}
1894
1895# VectorConfigure --
1896#    Set configuration options for vectors
1897# Arguments:
1898#    w           Name of the canvas
1899#    series      Data series (identifier for vectors)
1900#    args        Pairs of configuration options:
1901#                -scale|-colour|-centred|-type {cartesian|polar|nautical}
1902# Result:
1903#    None
1904# Side effects:
1905#    Configuration options are stored
1906#
1907proc ::Plotchart::VectorConfigure { w series args } {
1908    variable data_series
1909    variable scaling
1910
1911    foreach {option value} $args {
1912        switch -- $option {
1913            "-scale" {
1914                if { $value > 0.0 } {
1915                    set scaling($w,$series,vectorscale) $value
1916                } else {
1917                    return -code error "Scale factor must be positive"
1918                }
1919            }
1920            "-colour" - "-color" {
1921                set data_series($w,$series,vectorcolour) $value
1922            }
1923            "-centered" - "-centred" {
1924                set data_series($w,$series,vectorcentred) $value
1925            }
1926            "-type" {
1927                if { [lsearch {cartesian polar nautical} $value] >= 0 } {
1928                    set data_series($w,$series,vectortype) $value
1929                } else {
1930                    return -code error "Unknown vector components option: $value"
1931                }
1932            }
1933            default {
1934                return -code error "Unknown vector option: $option ($value)"
1935            }
1936        }
1937    }
1938}
1939
1940# DrawVector --
1941#    Draw a vector at the given coordinates with the given components
1942# Arguments:
1943#    w           Name of the canvas
1944#    series      Data series (identifier for the vectors)
1945#    xcrd        X coordinate of start or centre
1946#    ycrd        Y coordinate of start or centre
1947#    ucmp        X component or length
1948#    vcmp        Y component or angle
1949# Result:
1950#    None
1951# Side effects:
1952#    New arrow drawn in canvas
1953#
1954proc ::Plotchart::DrawVector { w series xcrd ycrd ucmp vcmp } {
1955    variable data_series
1956    variable scaling
1957
1958    #
1959    # Check for missing values
1960    #
1961    if { $xcrd == "" || $ycrd == "" } {
1962        return
1963    }
1964    #
1965    # Check for missing values
1966    #
1967    if { $ucmp == "" || $vcmp == "" } {
1968        return
1969    }
1970
1971    #
1972    # Get the options
1973    #
1974    set scalef  1.0
1975    set colour  black
1976    set centred 0
1977    set type    cartesian
1978    if { [info exists scaling($w,$series,vectorscale)] } {
1979        set scalef $scaling($w,$series,vectorscale)
1980    }
1981    if { [info exists data_series($w,$series,vectorcolour)] } {
1982        set colour $data_series($w,$series,vectorcolour)
1983    }
1984    if { [info exists data_series($w,$series,vectorcentred)] } {
1985        set centred $data_series($w,$series,vectorcentred)
1986    }
1987    if { [info exists data_series($w,$series,vectortype)] } {
1988        set type $data_series($w,$series,vectortype)
1989    }
1990
1991    #
1992    # Compute the coordinates of beginning and end of the arrow
1993    #
1994    switch -- $type {
1995        "polar" {
1996            set x1 [expr {$ucmp * cos( 3.1415926 * $vcmp / 180.0 ) }]
1997            set y1 [expr {$ucmp * sin( 3.1415926 * $vcmp / 180.0 ) }]
1998            set ucmp $x1
1999            set vcmp $y1
2000        }
2001        "nautical" {
2002            set x1 [expr {$ucmp * sin( 3.1415926 * $vcmp / 180.0 ) }]
2003            set y1 [expr {$ucmp * cos( 3.1415926 * $vcmp / 180.0 ) }]
2004            set ucmp $x1
2005            set vcmp $y1
2006        }
2007    }
2008
2009    set u1 [expr {$scalef * $ucmp}]
2010    set v1 [expr {$scalef * $vcmp}]
2011
2012    foreach {x1 y1} [coordsToPixel $w $xcrd $ycrd] {break}
2013
2014    if { $centred } {
2015        set x1 [expr {$x1 - 0.5 * $u1}]
2016        set y1 [expr {$y1 + 0.5 * $v1}]
2017    }
2018
2019    set x2 [expr {$x1 + $u1}]
2020    set y2 [expr {$y1 - $v1}]
2021
2022    #
2023    # Draw the arrow
2024    #
2025    $w create line $x1 $y1 $x2 $y2 -fill $colour -tag [list data data_$series] -arrow last
2026    $w lower data
2027}
2028
2029# DotConfigure --
2030#    Set configuration options for dots
2031# Arguments:
2032#    w           Name of the canvas
2033#    series      Data series (identifier for dots)
2034#    args        Pairs of configuration options:
2035#                -radius|-colour|-classes {value colour ...}|-outline|-scalebyvalue|
2036#                -scale
2037# Result:
2038#    None
2039# Side effects:
2040#    Configuration options are stored
2041#
2042proc ::Plotchart::DotConfigure { w series args } {
2043    variable data_series
2044    variable scaling
2045
2046    foreach {option value} $args {
2047        switch -- $option {
2048            "-scale" {
2049                if { $value > 0.0 } {
2050                    set scaling($w,$series,dotscale) $value
2051                } else {
2052                    return -code error "Scale factor must be positive"
2053                }
2054            }
2055            "-colour" - "-color" {
2056                set data_series($w,$series,dotcolour) $value
2057            }
2058            "-radius" {
2059                set data_series($w,$series,dotradius) $value
2060            }
2061            "-scalebyvalue" {
2062                set data_series($w,$series,dotscalebyvalue) $value
2063            }
2064            "-outline" {
2065                set data_series($w,$series,dotoutline) $value
2066            }
2067            "-classes" {
2068                set data_series($w,$series,dotclasses) $value
2069            }
2070            default {
2071                return -code error "Unknown dot option: $option ($value)"
2072            }
2073        }
2074    }
2075}
2076
2077# DrawDot --
2078#    Draw a dot at the given coordinates, size and colour based on the given value
2079# Arguments:
2080#    w           Name of the canvas
2081#    series      Data series (identifier for the vectors)
2082#    xcrd        X coordinate of start or centre
2083#    ycrd        Y coordinate of start or centre
2084#    value       Value to be used
2085# Result:
2086#    None
2087# Side effects:
2088#    New oval drawn in canvas
2089#
2090proc ::Plotchart::DrawDot { w series xcrd ycrd value } {
2091    variable data_series
2092    variable scaling
2093
2094    #
2095    # Check for missing values
2096    #
2097    if { $xcrd == "" || $ycrd == "" || $value == "" } {
2098        return
2099    }
2100
2101    #
2102    # Get the options
2103    #
2104    set scalef   1.0
2105    set colour   black
2106    set usevalue 1
2107    set outline  black
2108    set radius   3
2109    set classes  {}
2110    if { [info exists scaling($w,$series,dotscale)] } {
2111        set scalef $scaling($w,$series,dotscale)
2112    }
2113    if { [info exists data_series($w,$series,dotcolour)] } {
2114        set colour $data_series($w,$series,dotcolour)
2115    }
2116    if { [info exists data_series($w,$series,dotoutline)] } {
2117        set outline {}
2118        if { $data_series($w,$series,dotoutline) } {
2119            set outline black
2120        }
2121    }
2122    if { [info exists data_series($w,$series,dotradius)] } {
2123        set radius $data_series($w,$series,dotradius)
2124    }
2125    if { [info exists data_series($w,$series,dotclasses)] } {
2126        set classes $data_series($w,$series,dotclasses)
2127    }
2128    if { [info exists data_series($w,$series,dotscalebyvalue)] } {
2129        set usevalue $data_series($w,$series,dotscalebyvalue)
2130    }
2131
2132    #
2133    # Compute the radius and the colour
2134    #
2135    if { $usevalue } {
2136        set radius [expr {$scalef * $value}]
2137    }
2138    if { $classes != {} } {
2139        foreach {limit col} $classes {
2140            if { $value < $limit } {
2141                set colour $col
2142                break
2143            }
2144        }
2145    }
2146
2147    foreach {x y} [coordsToPixel $w $xcrd $ycrd] {break}
2148
2149    set x1 [expr {$x - $radius}]
2150    set y1 [expr {$y - $radius}]
2151    set x2 [expr {$x + $radius}]
2152    set y2 [expr {$y + $radius}]
2153
2154    #
2155    # Draw the oval
2156    #
2157    $w create oval $x1 $y1 $x2 $y2 -fill $colour -tag [list data data_$series] -outline $outline
2158    $w lower data
2159}
2160
2161# DrawRchart --
2162#    Draw data together with two horizontal lines representing the
2163#    expected range
2164# Arguments:
2165#    w           Name of the canvas
2166#    series      Data series
2167#    xcrd        X coordinate of the data point
2168#    ycrd        Y coordinate of the data point
2169# Result:
2170#    None
2171# Side effects:
2172#    New data point drawn, lines updated
2173#
2174proc ::Plotchart::DrawRchart { w series xcrd ycrd } {
2175    variable data_series
2176    variable scaling
2177
2178    #
2179    # Check for missing values
2180    #
2181    if { $xcrd == "" || $ycrd == "" } {
2182        return
2183    }
2184
2185    #
2186    # In any case, draw the data point
2187    #
2188    DrawData $w $series $xcrd $ycrd
2189
2190    #
2191    # Compute the expected range
2192    #
2193    if { ! [info exists data_series($w,$series,rchart)] } {
2194        set data_series($w,$series,rchart) $ycrd
2195    } else {
2196        lappend data_series($w,$series,rchart) $ycrd
2197
2198        if { [llength $data_series($w,$series,rchart)] < 2 } {
2199            return
2200        }
2201
2202        set filtered $data_series($w,$series,rchart)
2203        set outside  1
2204        while { $outside } {
2205            set data     $filtered
2206            foreach {ymin ymax} [RchartValues $data] {break}
2207            set filtered {}
2208            set outside  0
2209            foreach y $data {
2210                if { $y < $ymin || $y > $ymax } {
2211                    set outside 1
2212                } else {
2213                    lappend filtered $y
2214                }
2215            }
2216        }
2217
2218        #
2219        # Draw the limit lines
2220        #
2221        if { [info exists data_series($w,$series,rchartlimits)] } {
2222            eval $w delete $data_series($w,$series,rchartlimits)
2223        }
2224
2225        set colour "black"
2226        if { [info exists data_series($w,$series,-colour)] } {
2227            set colour $data_series($w,$series,-colour)
2228        }
2229
2230        set xmin $scaling($w,xmin)
2231        set xmax $scaling($w,xmax)
2232
2233        foreach {pxmin pymin} [coordsToPixel $w $xmin $ymin] {break}
2234        foreach {pxmax pymax} [coordsToPixel $w $xmax $ymax] {break}
2235
2236
2237        set data_series($w,$series,rchartlimits) [list \
2238            [$w create line $pxmin $pymin $pxmax $pymin -fill $colour -tag [list data data_$series]] \
2239            [$w create line $pxmin $pymax $pxmax $pymax -fill $colour -tag [list data data_$series]] \
2240        ]
2241    }
2242}
2243
2244# RchartValues --
2245#    Compute the expected range for a series of data
2246# Arguments:
2247#    data        Data to be examined
2248# Result:
2249#    Expected minimum and maximum
2250#
2251proc ::Plotchart::RchartValues { data } {
2252    set sum   0.0
2253    set sum2  0.0
2254    set ndata [llength $data]
2255
2256    if { $ndata <= 1 } {
2257        return [list $data $data]
2258    }
2259
2260    foreach v $data {
2261        set sum   [expr {$sum  + $v}]
2262        set sum2  [expr {$sum2 + $v*$v}]
2263    }
2264
2265    if { $ndata < 2 } {
2266       return [list $v $v]
2267    }
2268
2269    set variance [expr {($sum2 - $sum*$sum/double($ndata))/($ndata-1.0)}]
2270    if { $variance < 0.0 } {
2271        set variance 0.0
2272    }
2273
2274    set vmean [expr {$sum/$ndata}]
2275    set stdev [expr {sqrt($variance)}]
2276    set vmin  [expr {$vmean - 3.0 * $stdev}]
2277    set vmax  [expr {$vmean + 3.0 * $stdev}]
2278
2279    return [list $vmin $vmax]
2280}
2281
2282# ReorderChartItems --
2283#    Rearrange the drawing order of time and Gantt chart items
2284# Arguments:
2285#    w           Canvas widget containing them
2286# Result:
2287#    None
2288#
2289proc ::Plotchart::ReorderChartItems { w } {
2290
2291    $w lower above
2292    $w lower vertmask
2293    $w lower tline
2294    $w lower below
2295    $w lower lowest
2296
2297}
2298
2299# RescaleChart --
2300#    Reset the scaling of the scrollbar(s) for time and Gantt charts
2301# Arguments:
2302#    w           Canvas widget containing them
2303# Result:
2304#    None
2305# Note:
2306#    To be called after scaling($w,current) has been updated
2307#    or a new time line has been added
2308#
2309proc ::Plotchart::RescaleChart { w } {
2310    variable scaling
2311
2312    if { [info exists scaling($w,vscroll)] } {
2313        if { $scaling($w,current) >= 0.0 } {
2314            set scaling($w,theight) $scaling($w,ymax)
2315            $scaling($w,vscroll) set 0.0 1.0
2316        } else {
2317            set scaling($w,theight) [expr {$scaling($w,ymax)-$scaling($w,current)}]
2318            $scaling($w,vscroll) set $scaling($w,curpos) \
2319                [expr {$scaling($w,curpos) + $scaling($w,ymax)/$scaling($w,theight)}]
2320        }
2321    }
2322
2323    if { [info exists scaling($w,hscroll)] } {
2324        foreach {xmin dummy xmax} [$w bbox $w horizscroll] {break}
2325        set scaling($w,twidth) [expr {$xmax-$xmin}]
2326        if { $scaling($w,twidth) < $scaling($w,pxmax)-$scaling($w,pxmin) } {
2327            $scaling($w,hscroll) set 0.0 1.0
2328        } else {
2329            $scaling($w,hscroll) set $scaling($w,curhpos) \
2330                [expr {$scaling($w,curhpos) + \
2331                         ($scaling($w,pxmax)-$scaling($w,pxmin)) \
2332                         /double($scaling($w,twidth))}]
2333        }
2334    }
2335}
2336
2337# ConnectVertScrollbar --
2338#    Connect a vertical scroll bar to the chart
2339# Arguments:
2340#    w           Canvas widget containing them
2341#    scrollbar   Scroll bar in question
2342# Result:
2343#    None
2344#
2345proc ::Plotchart::ConnectVertScrollbar { w scrollbar } {
2346    variable scaling
2347
2348    $scrollbar configure -command [list ::Plotchart::VertScrollChart $w]
2349    bind $w <4> [list ::Plotchart::VertScrollChart $w scroll  -1 units]
2350    bind $w <5> [list ::Plotchart::VertScrollChart $w scroll   1 units]
2351    bind $w <MouseWheel> [list ::Plotchart::VertScrollChart $w scroll %D wheel]
2352    set scaling($w,vscroll) $scrollbar
2353
2354    RescaleChart $w
2355}
2356
2357# ConnectHorizScrollbar --
2358#    Connect a horizontal scroll bar to the chart
2359# Arguments:
2360#    w           Canvas widget containing them
2361#    scrollbar   Scroll bar in question
2362# Result:
2363#    None
2364#
2365proc ::Plotchart::ConnectHorizScrollbar { w scrollbar } {
2366    variable scaling
2367
2368    $scrollbar configure -command [list ::Plotchart::HorizScrollChart $w]
2369    set scaling($w,hscroll) $scrollbar
2370
2371    RescaleChart $w
2372}
2373
2374# VertScrollChart --
2375#    Scroll a chart using the vertical scroll bar
2376# Arguments:
2377#    w           Canvas widget containing them
2378#    operation   Operation to respond to
2379#    number      Number representing the size of the displacement
2380#    unit        Unit of displacement
2381# Result:
2382#    None
2383#
2384proc ::Plotchart::!VertScrollChart { w operation number {unit {}}} {
2385    variable scaling
2386
2387    set pixheight [expr {$scaling($w,pymax)-$scaling($w,pymin)}]
2388    set height    [expr {$pixheight*$scaling($w,theight)/$scaling($w,ymax)}]
2389
2390    switch -- $operation {
2391        "moveto" {
2392            set dy                 [expr {$height*($scaling($w,curpos)-$number)}]
2393            set scaling($w,curpos) $number
2394        }
2395        "scroll" {
2396            if { $unit == "units" } {
2397                set dy     [expr {-$number*$height/$scaling($w,theight)}]
2398                set newpos [expr {$scaling($w,curpos) + $number/$scaling($w,theight)}]
2399            } else {
2400                set dy     [expr {-$number*$pixheight}]
2401                set newpos [expr {$scaling($w,curpos) + $number*$scaling($w,ymax)/$scaling($w,theight)}]
2402            }
2403
2404            # TODO: guard against scrolling too far
2405            #if { $newpos < 0.0 } {
2406            #    set newpos 0.0
2407            #    set dy     [expr {$...}]
2408            #}
2409            #
2410            #if { $newpos > 1.0 } {
2411            #    set newpos 1.0
2412            #    set dy     [expr {$...}]
2413            #}
2414            set scaling($w,curpos) $newpos
2415        }
2416    }
2417
2418    #
2419    # TODO: limit the position between 0 and 1
2420    #
2421
2422    $w move vertscroll 0 $dy
2423
2424    RescaleChart $w
2425}
2426proc ::Plotchart::VertScrollChart { w operation number {unit {}}} {
2427    variable scaling
2428
2429    # Get the height of the scrolling region and the current position of the slider
2430    set height [expr {$scaling($w,pymax)-$scaling($w,pymin)}]
2431    foreach {ts bs} [$scaling($w,vscroll) get] {break}
2432
2433    if { $unit == "wheel" } {
2434        set operation "scroll"
2435        set unit      "units"
2436        set number    [expr {$number>0? 1 : -1}]
2437    }
2438
2439    switch -- $operation {
2440        "moveto" {
2441            # No scrolling if we are already at the top or bottom
2442            if { $number < 0.0 } {
2443                set number 0.0
2444            }
2445            if { $number+($bs-$ts) > 1.0 } {
2446                set number [expr {1.0-($bs-$ts)}]
2447            }
2448            set dy     [expr {$height*($scaling($w,curpos)-$number)/($bs-$ts)}]
2449            set scaling($w,curpos) $number
2450            $w move vertscroll 0 $dy
2451        }
2452        "scroll" {
2453            # Handle "units" and "pages" the same
2454
2455            # No scrolling if we are at the top or bottom
2456            if {$number == -1 && $ts == 0.0} {
2457                return
2458            }
2459
2460            if {$number == 1 && $bs == 1.0} {
2461                return
2462            }
2463
2464            # Scroll 1 unit in coordinate space, converted to pixel space
2465            foreach {x1 y1} [coordsToPixel $w 0 0.0] {break}
2466            foreach {x2 y2} [coordsToPixel $w 0 1.0] {break}
2467
2468            # This is the amount to scroll based on the current height
2469            set amt [expr {$number*($y2-$y1)/$height}]
2470
2471            # Handle boundary conditions, don't want to scroll too far off
2472            # the top or bottom.
2473            if {$number == 1 && $bs-$amt > 1.0} {
2474                set amt [expr {$bs-1.0}]
2475            } elseif {$number == -1 && $ts-$amt < 0.0} {
2476                set amt $ts
2477            }
2478
2479            # Set the scrolling parameters and scroll
2480            set dy  [expr {$height*($scaling($w,curpos)-($ts-$amt))/($bs-$ts)}]
2481            set scaling($w,curpos) [expr {$ts-$amt}]
2482            $w move vertscroll 0 $dy
2483        }
2484    }
2485
2486    RescaleChart $w
2487}
2488
2489# HorizScrollChart --
2490#    Scroll a chart using the horizontal scroll bar
2491# Arguments:
2492#    w           Canvas widget containing them
2493#    operation   Operation to respond to
2494#    number      Number representing the size of the displacement
2495#    unit        Unit of displacement
2496# Result:
2497#    None
2498#
2499proc ::Plotchart::HorizScrollChart { w operation number {unit {}}} {
2500    variable scaling
2501
2502    # Get the width of the scrolling region and the current position of the slider
2503    set width [expr {double($scaling($w,pxmax)-$scaling($w,pxmin))}]
2504    foreach {ts bs} [$scaling($w,hscroll) get] {break}
2505
2506    switch -- $operation {
2507        "moveto" {
2508            # No scrolling if we are already at the top or bottom
2509            if { $number < 0.0 } {
2510                set number 0.0
2511            }
2512            if { $number+($bs-$ts) > 1.0 } {
2513                set number [expr {1.0-($bs-$ts)}]
2514            }
2515            set dx     [expr {$width*($scaling($w,curhpos)-$number)/($bs-$ts)}]
2516            set scaling($w,curhpos) $number
2517            $w move horizscroll $dx 0
2518        }
2519        "scroll" {
2520            # Handle "units" and "pages" the same
2521
2522            # No scrolling if we are at the top or bottom
2523            if {$number == -1 && $ts == 0.0} {
2524                return
2525            }
2526
2527            if {$number == 1 && $bs == 1.0} {
2528                return
2529            }
2530
2531            # Scroll 1 unit in coordinate space, converted to pixel space
2532            set dx [expr {0.1*($scaling($w,xmax)-$scaling($w,xmin))}]
2533            foreach {x1 y1} [coordsToPixel $w 0   0.0] {break}
2534            foreach {x2 y2} [coordsToPixel $w $dx 0.0] {break}
2535
2536            # This is the amount to scroll based on the current width
2537            set amt [expr {$number*($x2-$x1)/$width}]
2538
2539            # Handle boundary conditions, don't want to scroll too far off
2540            # the left or the right
2541            if {$number == 1 && $bs-$amt > 1.0} {
2542                set amt [expr {$bs-1.0}]
2543            } elseif {$number == -1 && $ts-$amt < 0.0} {
2544                set amt $ts
2545            }
2546
2547            # Set the scrolling parameters and scroll
2548            set dx  [expr {$width*($scaling($w,curhpos)-($ts-$amt))/($bs-$ts)}]
2549            set scaling($w,curhpos) [expr {$ts-$amt}]
2550            $w move horizscroll $dx 0
2551        }
2552    }
2553
2554    RescaleChart $w
2555}
2556
2557# DrawWindRoseData --
2558#    Draw the data for each sector
2559# Arguments:
2560#    w           Name of the canvas
2561#    data        List of "sectors" data
2562#    colour      Colour to use
2563# Result:
2564#    None
2565# Side effects:
2566#    Data added to the wind rose
2567#
2568proc ::Plotchart::DrawWindRoseData { w data colour } {
2569
2570    variable data_series
2571
2572    set start_angle  $data_series($w,start_angle)
2573    set increment    $data_series($w,increment_angle)
2574    set width_sector $data_series($w,d_angle)
2575
2576    set new_cumulative {}
2577
2578    foreach value $data cumulative_radius $data_series($w,cumulative_radius) {
2579        set radius [expr {$value + $cumulative_radius}]
2580
2581        foreach {xright ytop}    [polarToPixel $w [expr {$radius*sqrt(2.0)}]  45.0] {break}
2582        foreach {xleft  ybottom} [polarToPixel $w [expr {$radius*sqrt(2.0)}] 225.0] {break}
2583
2584        $w create arc $xleft $ytop $xright $ybottom -style pie -fill $colour \
2585            -tag data_$data_series($w,count_data) -start $start_angle -extent $width_sector
2586
2587        lappend new_cumulative $radius
2588
2589        set start_angle [expr {$start_angle - $increment}]
2590    }
2591
2592    $w lower data_$data_series($w,count_data)
2593
2594    set data_series($w,cumulative_radius) $new_cumulative
2595    incr data_series($w,count_data)
2596}
2597
2598# DrawYband --
2599#    Draw a vertical grey band in a plot
2600# Arguments:
2601#    w           Name of the canvas
2602#    xmin        Lower bound of the band
2603#    xmax        Upper bound of the band
2604# Result:
2605#    None
2606# Side effects:
2607#    Horizontal band drawn in canvas
2608#
2609proc ::Plotchart::DrawYband { w xmin xmax } {
2610    variable scaling
2611
2612
2613    foreach {xp1 yp1} [coordsToPixel $w $xmin $scaling($w,ymin)] {break}
2614    foreach {xp2 yp2} [coordsToPixel $w $xmax $scaling($w,ymax)] {break}
2615
2616    $w create rectangle $xp1 $yp1 $xp2 $yp2 -fill grey70 -outline grey70 -tag band
2617
2618    $w lower band ;# TODO: also in "plot" method
2619}
2620
2621# DrawXband --
2622#    Draw a horizontal grey band in a plot
2623# Arguments:
2624#    w           Name of the canvas
2625#    ymin        Lower bound of the band
2626#    ymax        Upper bound of the band
2627# Result:
2628#    None
2629# Side effects:
2630#    Horizontal band drawn in canvas
2631#
2632proc ::Plotchart::DrawXband { w ymin ymax } {
2633    variable scaling
2634
2635
2636    foreach {xp1 yp1} [coordsToPixel $w $scaling($w,xmin) $ymin] {break}
2637    foreach {xp2 yp2} [coordsToPixel $w $scaling($w,xmax) $ymax] {break}
2638
2639    $w create rectangle $xp1 $yp1 $xp2 $yp2 -fill grey70 -outline grey70 -tag band
2640
2641    $w lower band ;# TODO: also in "plot" method
2642}
2643
2644# DrawLabelDot --
2645#    Draw a label and a symbol (dot) in a plot
2646# Arguments:
2647#    w           Name of the canvas
2648#    x           X coordinate of the dot
2649#    y           Y coordinate of the dot
2650#    text        Text to be shown
2651#    orient      (Optional) orientation of the text wrt the dot
2652#                (w, e, n, s)
2653#
2654# Result:
2655#    None
2656# Side effects:
2657#    Label and dot drawn in canvas
2658# Note:
2659#    The routine uses the data series name "labeldot" to derive
2660#    the properties
2661#
2662proc ::Plotchart::DrawLabelDot { w x y text {orient w} } {
2663    variable scaling
2664
2665    foreach {xp yp} [coordsToPixel $w $x $y] {break}
2666
2667    switch -- [string tolower $orient] {
2668        "w" {
2669            set xp [expr {$xp - 5}]
2670            set anchor e
2671        }
2672        "e" {
2673            set xp [expr {$xp + 10}]
2674            set anchor w
2675        }
2676        "s" {
2677            set yp [expr {$yp + 5}]
2678            set anchor n
2679        }
2680        "n" {
2681            set yp [expr {$yp - 5}]
2682            set anchor s
2683        }
2684        default {
2685            set xp [expr {$xp - 5}]
2686            set anchor w
2687        }
2688    }
2689
2690    $w create text $xp $yp -text $text -fill grey -tag data -anchor $anchor
2691    DrawData $w labeldot $x $y
2692}
2693
2694# DrawLabelDotPolar --
2695#    Draw a label and a symbol (dot) in a polar plot
2696# Arguments:
2697#    w           Name of the canvas
2698#    rad         Radial coordinate of the dot
2699#    angle       Tangential coordinate of the dot
2700#    text        Text to be shown
2701#    orient      (Optional) orientation of the text wrt the dot
2702#                (w, e, n, s)
2703#
2704# Result:
2705#    None
2706# Side effects:
2707#    Label and dot drawn in canvas
2708# Note:
2709#    The routine uses the data series name "labeldot" to derive
2710#    the properties
2711#
2712proc ::Plotchart::DrawLabelDotPolar { w rad angle text {orient w} } {
2713    variable torad
2714
2715    set xcrd [expr {$rad*cos($angle*$torad)}]
2716    set ycrd [expr {$rad*sin($angle*$torad)}]
2717
2718    DrawLabelDot $w $xcrd $ycrd $text $orient
2719}
2720
2721# ConfigBar --
2722#    Configuration options for vertical and horizontal barcharts
2723# Arguments:
2724#    w           Name of the canvas
2725#    args        List of arguments
2726# Result:
2727#    None
2728# Side effects:
2729#    Items that are already visible will NOT be changed to the new look
2730#
2731proc ::Plotchart::ConfigBar { w args } {
2732    variable settings
2733
2734    foreach {option value} $args {
2735        set option [string range $option 1 end]
2736        if { [lsearch {showvalues valuefont valuecolour valuecolor valueformat} \
2737                $option] >= 0} {
2738            if { $option == "valuecolor" } {
2739                set option "valuecolour"
2740            }
2741            set settings($w,$option) $value
2742        } else {
2743            return -code error "Unknown barchart option: -$option"
2744        }
2745    }
2746}
2747
2748# DrawFunction --
2749#    Draw a function f(x) in an XY-plot
2750# Arguments:
2751#    w           Name of the canvas
2752#    series      Data series (for the colour)
2753#    xargs       List of arguments to the (anonymous) function
2754#    function    Function expression
2755#    args        All parameters in the expression
2756#                (and possibly the option -samples x)
2757# Result:
2758#    None
2759# Side effects:
2760#    New data drawn in canvas
2761#
2762# Note:
2763#    This method requires Tcl 8.5
2764#
2765# TODO:
2766#    Check for numerical problems!
2767#
2768proc ::Plotchart::DrawFunction { w series xargs function args } {
2769   variable data_series
2770   variable scaling
2771
2772   #
2773   # Check the number of arguments
2774   #
2775   if { [llength $xargs]     != [llength $args] + 1 &&
2776        [llength $xargs] + 2 != [llength $args] + 1 } {
2777       return -code error "plotfunc: number of (extra) arguments does not match the list of variables"
2778   }
2779
2780   #
2781   # Determine the number of samples
2782   #
2783   set number 50
2784   if { [llength $xargs] + 2 == [llength $args] + 1 } {
2785       if { [lindex $args end-1] != "-samples" } {
2786           return -code error "plotfunc: unknown option - [lindex $args end-1]"
2787       }
2788       if { ! [string is integer [lindex $args end]] } {
2789           return -code error "plotfunc: number of samples must be an integer - is instead \"[lindex $args end]\""
2790       }
2791       set number [lindex $args end]
2792       set args   [lrange $args 0 end-2]
2793   }
2794
2795   #
2796   # Get the caller's namespace
2797   #
2798   set namespace [uplevel 2 {namespace current}]
2799
2800   #
2801   # The actual drawing
2802   #
2803   set colour black
2804   if { [info exists data_series($w,$series,-colour)] } {
2805      set colour $data_series($w,$series,-colour)
2806   }
2807
2808   set xmin   $scaling($w,xmin)
2809   set dx     [expr {($scaling($w,xmax) - $xmin) / ($number - 1.0)}]
2810
2811   set coords {}
2812   set lambda [string map [list XARGS $xargs FUNCTION $function NS $namespace] {{XARGS} {expr {FUNCTION}} NS}]
2813
2814   for { set i 0 } { $i < $number } { incr i } {
2815       set x [expr {$xmin + $dx*$i}]
2816
2817       if { [catch {
2818           set y [apply $lambda $x {*}$args]
2819
2820           foreach {pxcrd pycrd} [coordsToPixel $w $x $y] {break}
2821
2822           lappend coords $pxcrd $pycrd
2823       } msg] } {
2824           if { [llength $coords] > 2 } {
2825               $w create line $coords -fill $colour -smooth 1 -tag [list data data_$series]
2826               set coords {}
2827           }
2828       }
2829
2830   }
2831   if { [llength $coords] > 2 } {
2832       $w create line $coords -fill $colour -smooth 1 -tag [list data data_$series]
2833   }
2834
2835   $w lower data
2836}
2837