Scid  4.6.5
graph.tcl
Go to the documentation of this file.
1 # utils/graph.tcl: Graph plotting package for Scid.
2 #
3 
4 namespace eval ::utils::graph {}
5 
6 # Configuration options, specific to each graph:
7 #
8 # -width: width of graph in canvas units.
9 # -height: height of graph in canvas units.
10 # -xtop: x-coord of top-left graph corner in canvas.
11 # -ytop: y-coord of top-left graph corner in canvas.
12 # -background: background color in graph.
13 # -font: font of axis text.
14 # -textcolor: color of axis text.
15 # -ticksize: length of ticks on axes, in canvas units.
16 # -tickcolor: color to draw x-axis and y-axis ticks.
17 # -textgap: distance from graph border to text, in canvas units.
18 # -xtick: distance between x-axis ticks, in graph units.
19 # -ytick: distance between y-axis ticks, in graph units.
20 # -xlabels, -ylabels: lists of {value,label} pairs to print on each axis.
21 # If a list has no pairs, values are printed at each tick.
22 # -xmin, -xmax, -ymin, -ymax: minimum/maximum graph units to plot.
23 # -canvas: canvas to plot the graph in.
24 # -vline, -hline: list of vertical/horizontal lines to plot. Each
25 # element is a list of four items: {color width type value}
26 # where color is the line color, width is its width in
27 # pixels, type is "each" or "at", and value is the value.
28 # -brect: list of background rectangles. Each element is a list of 5 items:
29 # the graph coordinates of a rectangle, and its color.
30 #
31 set ::utils::graph::_options(graph) {
32  width height xtop ytop background font ticksize textgap xtick ytick
33  xmin xmax ymin ymax canvas vline hline textcolor tickcolor
34  xlabels ylabels brect
35 }
36 set ::utils::graph::_defaults(graph) \
37  { -width 400 -height 300 -xtop 50 -ytop 30 -ticksize 5 -textgap 2 \
38  -xtick 5 -ytick 5 -tickcolor black -font fixed -background white \
39  -canvas {} -hline {} -vline {} -textcolor black \
40  -xlabels {} -ylabels {} -brect {} }
41 
42 # Data options, specific to each data set within a graph:
43 #
44 # -points: 1 to display data points.
45 # -lines: 1 to display data line.
46 # -bars: 1 to display vertical bars.
47 # -color: color to display points, lines and bars in.
48 # -outline: color for outline of bars or points. Not used for lines.
49 # -radius: radius of points in canvas units.
50 # -linewidth: width of line in canvas units.
51 # -barwidth: width of bars -- in GRAPH units, NOT canvas units.
52 # -key: key name to print by line.
53 # -coords: actual data to plot; should be a list containing an
54 # EVEN number of numeric values.
55 #
56 set ::utils::graph::_options(data) {
57  points lines bars color outline radius linewidth barwidth coords key
58 }
59 set ::utils::graph::_defaults(data) \
60  { -points 0 -lines 1 -bars 0 -color red -outline black -radius 2 \
61  -linewidth 1 -barwidth 1.0 -key {} -coords {} }
62 
63 set ::utils::graph::_graphs {}
64 array set ::utils::graph::_data {}
65 
66 
67 # create:
68 # Create a new graph. Sets up the graph configuration and creates a
69 # new proc (in the global namespace) with the same name as the graph.
70 #
71 proc ::utils::graph::create args {
72  set graph [lindex $args 0]
73  lappend ::utils::graph::_graphs $graph
74 
75  # Remove any existing data for this graph name:
76  foreach key [array names ::utils::graph::_data] {
77  if {[string match "$graph,*" $key]} { unset ::utils::graph::_data($key)}
78  }
79  set ::utils::graph::_data($graph,sets) {}
80 
81  set args [concat graph $graph $::utils::graph::_defaults(graph) [lrange $args 1 end]]
82  set extraArgs [eval "::utils::graph::_configure $args"]
83  if {$extraArgs != ""} {
84  error "Unrecognised arguments: $extraArgs"
85  }
86  return $graph
87 }
88 
89 
90 # delete:
91 # Removes all privately stored information about a graph.
92 #
93 proc ::utils::graph::delete {graph} {
94  # Remove from the list of available graphs:
95  set index [lindex $::utils::graph::_graphs $graph]
96  if {$index < 0} { return}
97  set ::utils::graph::_graphs [lreplace $::utils::graph::_graphs $index $index]
98  # Remove all configuration data for the graph:
99  foreach key [array names ::utils::graph::_data] {
100  if {[string match "$graph,*" $key]} {
101  unset ::utils::graph::_data($key)
102  }
103  }
104 }
105 
106 
107 # isgraph:
108 # Returns true if the named graph exists.
109 #
110 proc ::utils::graph::isgraph {graph} {
111  if {[lsearch $::utils::graph::_graphs $graph] >= 0} { return 1}
112  return 0
113 }
114 
115 
116 # data:
117 # Adds a new data set to the graph, or modifies an existing one.
118 #
119 proc ::utils::graph::data args {
120  variable _data
121  variable _defaults
122  set graph [lindex $args 0]
123  set dataset [lindex $args 1]
124 
125  set args [concat data $graph,$dataset $_defaults(data) \
126  [lrange $args 2 end]]
127 
128  set extraArgs [eval "::utils::graph::_configure $args"]
129  if {$extraArgs != ""} {
130  error "Unrecognised graph data options: $extraArgs"
131  }
132 
133  set marklist $_data($graph,sets)
134  if {[lsearch -exact $marklist $dataset] < 0} {
135  lappend _data($graph,sets) $dataset
136  }
137 
138  set datalength 0
139  set ncoords [llength $_data($graph,$dataset,coords)]
140  if {$ncoords % 2 != 0} {
141  error "Error: coordinates list must have an even length"
142  }
143 
144  # Redraw graph: do we want to do this here?
145  #::utils::graph::redraw $graph
146 }
147 
148 
149 # cget:
150 # Return a stored attribute of a graph.
151 #
152 proc ::utils::graph::cget {graph opt} {
153  variable _data
154  # Remove initial "-" if necessary:
155  if {[string index $opt 0] == "-"} { set opt [string range $opt 1 end]}
156 
157  # If asking for axmin/axmax/aymin/aymax, set ranges first:
158  if {[string match "a?m??" $opt]} { ::utils::graph::set_range $graph}
159 
160  if {! [info exists _data($graph,$opt)]} {
161  error "No such graph option: $opt"
162  }
163  return $_data($graph,$opt)
164 }
165 
166 # configure:
167 # Modify stored attributes for a graph.
168 #
169 proc ::utils::graph::configure args {
170  set newargs [concat "graph" [lindex $args 0] [lrange $args 1 end]]
171  eval "::utils::graph::_configure $newargs"
172 }
173 
174 
175 # _configure:
176 # Handle configuration of both the graph, and individual data sets.
177 # The first arg (type) should be "graph" or "data". The second should
178 # be a graph name for graph configuration, or a "graph,set" pair
179 # for dataset configuration.
180 #
181 proc ::utils::graph::_configure args {
182  variable _data
183  set type [lindex $args 0]
184  set dataset [lindex $args 1]
185  set args [lrange $args 2 end]
186 
187  set optionList $::utils::graph::_options($type)
188  set option {}
189 
190  if {[llength $args] % 2} { error "Error: odd-length options list: $args"}
191 
192  for {set i 0} {$i < [llength $args]} {incr i 2} {
193  set option [lindex $args $i]
194  if {[string index $option 0] != "-"} { return [lrange $args $i end]}
195  set option [string range $option 1 end]
196  if {[lsearch $optionList $option] >= 0} {
197  set _data($dataset,$option) [lindex $args [expr {$i + 1}]]
198  }
199  }
200 }
201 
202 # redraw:
203 # Redraw the entire graph, axes and data.
204 #
205 proc ::utils::graph::redraw {graph} {
206  if {! [::utils::graph::isgraph $graph]} { error "$graph: no such graph"}
207  if {! [info exists ::utils::graph::_data($graph,canvas)]} { return}
208  $::utils::graph::_data($graph,canvas) delete -withtag g$graph
211 }
212 
213 # plot_axes:
214 # Replot the graph axes.
215 #
216 proc ::utils::graph::plot_axes {graph} {
217  variable _data
218  # Set ranges and scaling factors:
221 
222  set xmin $_data($graph,axmin)
223  set xmax $_data($graph,axmax)
224  set ymin $_data($graph,aymin)
225  set ymax $_data($graph,aymax)
226 
227  set xminc [xmap $graph $xmin]
228  set xmaxc [xmap $graph $xmax]
229  set yminc [ymap $graph $ymin]
230  set ymaxc [ymap $graph $ymax]
231  #Klimmek: additional space for 6.and 7.number
232  set fontsize [font configure font_Small -size]
233  if { $ymax > 99999 } { set xminc [expr {$xminc + $fontsize}]}
234  if { $ymax > 999999 } { set xminc [expr {$xminc + $fontsize}]}
235 
236  set canvas $_data($graph,canvas)
237  set tag g$graph
238 
239  # Extract the graph attributes we will need to use:
240  foreach attr {ticksize font textcolor tickcolor textgap \
241  xtick ytick xlabels ylabels} {
242  set $attr $_data($graph,$attr)
243  }
244 
245  $canvas create rectangle $xminc $yminc $xmaxc $ymaxc -outline $tickcolor \
246  -fill $_data($graph,background) -tag $tag
247 
248  set brect $_data($graph,brect)
249  for {set i 0} {$i < [llength $brect]} {incr i} {
250  set item [lindex $brect $i]
251  set x1 [xmap $graph [lindex $item 0]]
252  set y1 [ymap $graph [lindex $item 1]]
253  set x2 [xmap $graph [lindex $item 2]]
254  set y2 [ymap $graph [lindex $item 3]]
255  if {$x1 < $xminc} { set x1 $xminc}
256  if {$x1 > $xmaxc} { set x1 $xmaxc}
257  if {$x2 < $xminc} { set x2 $xminc}
258  if {$x2 > $xmaxc} { set x2 $xmaxc}
259  if {$y1 > $yminc} { set y1 $yminc}
260  if {$y1 < $ymaxc} { set y1 $ymaxc}
261  if {$y2 > $yminc} { set y2 $yminc}
262  if {$y2 < $ymaxc} { set y2 $ymaxc}
263  $canvas create rectangle $x1 $y1 $x2 $y2 -fill [lindex $item 4] -width 0 \
264  -tag $tag
265  }
266 
267  # Plot vertical guide lines:
268  foreach vline $_data($graph,vline) {
269  set color [lindex $vline 0]
270  set width [lindex $vline 1]
271  set type [lindex $vline 2]
272  set inc [lindex $vline 3]
273  set xminvalue [xmap $graph $xmin]
274  set xmaxvalue [xmap $graph $xmax]
275  if {$type == "at"} {
276  # Plot just one line:
277  set xvalue [xmap $graph $inc]
278  if {$xvalue != $xminvalue && $xvalue != $xmaxvalue} {
279  $canvas create line $xvalue $yminc $xvalue $ymaxc -width $width \
280  -fill $color -tag $tag
281  }
282  } elseif {$inc > 0} {
283  # Plot a line at each multiple of "inc" units:
284  set x [expr {int($xmin/$inc) * $inc + $inc}]
285  while {$x < $xmax} {
286  set xvalue [xmap $graph $x]
287  if {$xvalue != $xminvalue && $xvalue != $xmaxvalue} {
288  $canvas create line $xvalue $yminc $xvalue $ymaxc -width $width \
289  -fill $color -tag $tag
290  }
291  set x [expr {$x + $inc}]
292  }
293  }
294  }
295 
296  # Plot horizontal guide lines:
297  foreach hline $_data($graph,hline) {
298  set color [lindex $hline 0]
299  set width [lindex $hline 1]
300  set type [lindex $hline 2]
301  set inc [lindex $hline 3]
302  set yminvalue [ymap $graph $ymin]
303  set ymaxvalue [ymap $graph $ymax]
304  if {$type == "at"} {
305  set yvalue [ymap $graph $inc]
306  if {$yvalue != $yminvalue && $yvalue != $ymaxvalue} {
307  $canvas create line $xminc $yvalue $xmaxc $yvalue -width $width \
308  -fill $color -tag $tag
309  }
310  } elseif {$inc > 0} {
311  set y [expr {int($ymin/$inc) * $inc + $inc}]
312  while {$y < $ymax} {
313  set yvalue [ymap $graph $y]
314  if {$yvalue != $yminvalue && $yvalue != $ymaxvalue} {
315  $canvas create line $xminc $yvalue $xmaxc $yvalue -width $width \
316  -fill $color -tag $tag
317  }
318  set y [expr {$y + $inc}]
319  }
320  }
321  }
322 
323  # Plot x ticks and y ticks:
324  set nxlabels [llength $xlabels]
325  set nylabels [llength $ylabels]
326 
327  if {$xtick > 0} {
328  set x [expr {int($xmin/$xtick) * $xtick}]
329  while {$x < $xmin} { set x [expr {$x + $xtick}]}
330  while {$x <= $xmax} {
331  set xc [xmap $graph $x]
332  $canvas create line $xc $yminc $xc [expr {$yminc - $ticksize}] \
333  -tag $tag -fill $tickcolor
334  $canvas create line $xc $ymaxc $xc [expr {$ymaxc + $ticksize}] \
335  -tag $tag -fill $tickcolor
336  if {$nxlabels == 0} {
337  $canvas create text $xc [expr {$yminc + $textgap}] -font $font \
338  -text [::utils::graph::round $x] -anchor n -tag $tag -fill $textcolor
339  }
340  set x [expr {$x + $xtick}]
341  }
342  }
343  for {set i 0} {$i < $nxlabels} {incr i} {
344  set label [lindex $xlabels $i]
345  set x [lindex $label 0]
346  set text [lindex $label 1]
347  set xc [xmap $graph $x]
348  $canvas create text $xc [expr {$yminc + $textgap}] -font $font \
349  -text $text -anchor n -tag $tag -fill $textcolor -justify center
350  }
351 
352  if {$ytick > 0} {
353  set y [expr {int($ymin/$ytick) * $ytick}]
354  while {$y < $ymin} { set y [expr {$y + $ytick}]}
355  while {$y <= $ymax} {
356  set yc [ymap $graph $y]
357  $canvas create line $xminc $yc [expr {$xminc + $ticksize}] $yc \
358  -tag $tag -fill $tickcolor
359  $canvas create line [expr {$xmaxc - $ticksize}] $yc $xmaxc $yc \
360  -tag $tag -fill $tickcolor
361  if {$nylabels == 0} {
362  $canvas create text [expr {$xminc - $textgap}] $yc -font $font \
363  -text [::utils::graph::round $y] -anchor e -tag $tag -fill $textcolor
364  }
365  set y [expr {$y + $ytick}]
366  }
367  }
368  for {set i 0} {$i < $nylabels} {incr i} {
369  set label [lindex $ylabels $i]
370  set y [lindex $label 0]
371  set text [lindex $label 1]
372  set yc [ymap $graph $y]
373  $canvas create text [expr {$xminc - $textgap}] $yc -font $font \
374  -text $text -anchor e -tag $tag -fill $textcolor
375  }
376 }
377 
378 # plot_data:
379 # Plot the lines/points/bars for each data set in the graph.
380 #
381 proc ::utils::graph::plot_data {graph} {
382  variable _data
383  set canvas $_data($graph,canvas)
384 
385  foreach dataset $_data($graph,sets) {
386  set color $_data($graph,$dataset,color)
387  set outline $_data($graph,$dataset,outline)
388  set tag g$graph
389  set coords [scale_data $graph $_data($graph,$dataset,coords)]
390  set ncoords [expr {[llength $coords] - 1}]
391 
392  # Draw key:
393  if {$_data($graph,$dataset,key) != ""} {
394  set key $_data($graph,$dataset,key)
395  if {$ncoords >= 1} {
396  set dy 3
397  set anchor nw
398  set x [expr {[lindex $coords 0] + 3}]
399  set y [lindex $coords 1]
400  if {$ncoords >= 3} {
401  set nexty [lindex $coords 3]
402  if {$nexty > $y} { set dy -3; set anchor sw}
403  }
404  incr y $dy
405  catch {$canvas create text $x $y -fill $color -tag $tag \
406  -text $_data($graph,$dataset,key) \
407  -font $_data($graph,font) -anchor $anchor}
408  }
409  }
410 
411  # Plot line:
412  if {$_data($graph,$dataset,lines)} {
413  # Catch errors drawing line in case the data set contains no data:
414  catch {eval "$canvas create line $coords -fill $color \
415  -width $_data($graph,$dataset,linewidth) -tag $tag"}
416  }
417 
418  # Plot points:
419  if {$_data($graph,$dataset,points)} {
420  for {set i 0} {$i < $ncoords} {incr i 2} {
421  set x [lindex $coords $i]
422  set y [lindex $coords [expr {$i + 1}]]
423  set p $_data($graph,$dataset,radius)
424  $canvas create oval [expr {$x-$p}] [expr {$y-$p}] \
425  [expr {$x+$p}] [expr {$y+$p}] \
426  -fill $color -outline $outline -width 1 -tag $tag
427  }
428  }
429 
430  # Plot bars:
431  if {$_data($graph,$dataset,bars)} {
432  set base [ymap $graph $_data($graph,aymin)]
433  set hwidth [xmap $graph $_data($graph,$dataset,barwidth)]
434  set hwidth [expr {$hwidth - [xmap $graph 0]}]
435  set hwidth [expr {$hwidth / 2}]
436  if {$hwidth < 1} { set hwidth 1}
437 
438  for {set i 0} {$i < $ncoords} {incr i 2} {
439  set x [lindex $coords $i]
440  set y [lindex $coords [expr {$i + 1}]]
441  $canvas create rectangle \
442  [expr {$x-$hwidth}] $y [expr {$x+$hwidth}] $base \
443  -fill $color -outline $outline -tag $tag
444  }
445  }
446  }
447 }
448 
449 
450 # round
451 #
452 # Returns a value n rounded to the nearest integer if it is
453 # within 0.1 of n, or to one decimal place otherwise.
454 # Used to print axis values to a sensible precision.
455 #
456 proc ::utils::graph::round {n} {
457  set intn [expr {int($n)}]
458  if {[expr {$n - $intn}] < 0.1 && [expr {$intn - $n}] < 0.1} {
459  return [expr {round($n)}]
460  }
461  return [expr {double(round($n * 10.0)) / 10.0}]
462 }
463 
464 
465 # point_visible
466 #
467 # Returns true if a point (in graph coordinates) is visible given
468 # the current display boundaries.
469 #
470 proc ::utils::graph::point_visible {graph x y} {
471  variable data
472  set xmin $_data($graph,xtop)
473  set ymin $_data($graph,ytop)
474  set xmax [expr {$xmin + $_data($graph,width)}]
475  set ymax [expr {$ymin + $_data($graph,height)}]
476 
477  if {$x >= $xmin && $x <= $xmax && $y >= $ymin && $y <= $ymax} { return 1}
478  return 0
479 }
480 
481 
482 # rescale:
483 # Sets the scaling factors used for mapping graph to canvas coordinates.
484 #
485 proc ::utils::graph::rescale {graph} {
486  variable _data
487  set width $_data($graph,width)
488  set height $_data($graph,height)
489  set xdelta [expr {double($_data($graph,axmax) - $_data($graph,axmin))}]
490  set ydelta [expr {double($_data($graph,aymax) - $_data($graph,aymin))}]
491  # Ensure deltas are not zero or too close to it:
492  if {$xdelta < 0.0001} { set xdelta 0.0001}
493  if {$ydelta < 0.0001} { set ydelta 0.0001}
494 
495  set _data($graph,xfac) [expr {double($width)/$xdelta}]
496  set _data($graph,yfac) [expr {double($height)/$ydelta}]
497 }
498 
499 
500 # xmap:
501 # Map a graph X coordinate to its canvas unit equivalent.
502 #
503 proc ::utils::graph::xmap {graph x} {
504  variable _data
505  return [expr {int(($x - $_data($graph,axmin)) * \
506  $_data($graph,xfac) + $_data($graph,xtop))}]
507 }
508 
509 # ymap:
510 # Map a graph Y coordinate to its canvas unit equivalent.
511 #
512 proc ::utils::graph::ymap {graph y} {
513  variable _data
514 if {$y == ""} { error "y is empty"}
515  return [expr {int(($_data($graph,aymax) - $y) * \
516  $_data($graph,yfac) + $_data($graph,ytop))}]
517 }
518 
519 # Xunmap:
520 # Transform a canvas unit to its graph X coordinate equivalent.
521 #
522 proc ::utils::graph::xunmap {graph cx} {
523  variable _data
524  return [expr {$_data($graph,axmin) + \
525  double($cx - $_data($graph,xtop)) / \
526  double($_data($graph,xfac))}]
527 }
528 
529 # Yunmap:
530 # Transform a canvas unit to its graph Y coordinate equivalent.
531 #
532 proc ::utils::graph::yunmap {graph cy} {
533  variable _data
534  return [expr {$_data($graph,aymax) - \
535  double($cy - $_data($graph,ytop)) / \
536  double($_data($graph,yfac))}]
537 }
538 
539 # scale_data:
540 # Transforms an even-sized list of graph coordinates to canvas units.
541 #
542 proc ::utils::graph::scale_data {graph coords} {
543  set result {}
544  for {set i 0} {$i < [llength $coords] - 1} {incr i 2} {
545  lappend result [xmap $graph [lindex $coords $i]]
546  lappend result [ymap $graph [lindex $coords [expr {$i + 1}]]]
547  }
548  return $result
549 }
550 
551 # set_range:
552 # Sets any range boundaries that are not already set for a graph.
553 #
554 proc ::utils::graph::set_range {graph} {
555  variable _data
556 
557  set xmin 1000000000; set xmax -100000000
558  set ymin 1000000000; set ymax -100000000
559 
560  foreach dataset $_data($graph,sets) {
561  set coords $_data($graph,$dataset,coords)
562  for {set i 0} {$i < [llength $coords] - 1} {incr i 2} {
563  set x [lindex $coords $i]
564  set y [lindex $coords [expr {$i + 1}]]
565 
566  if {$x < $xmin} { set xmin $x}
567  if {$x > $xmax} { set xmax $x}
568  if {$y < $ymin} { set ymin $y}
569  if {$y > $ymax} { set ymax $y}
570  }
571  }
572 
573  # Set sane values if no data coordinates exist at all:
574  if {$xmax < $xmin} { set xmin 0; set xmax 1}
575  if {$ymax < $ymin} { set ymin 0; set ymax 1}
576 
577  set xtick $_data($graph,xtick)
578  set ytick $_data($graph,ytick)
579  set _data($graph,axmin) [expr {floor($xmin/$xtick) * $xtick}]
580  set _data($graph,axmax) [expr {floor($xmax/$xtick) * $xtick + $xtick}]
581  set _data($graph,aymin) [expr {floor($ymin/$ytick) * $ytick}]
582  set _data($graph,aymax) [expr {floor($ymax/$ytick) * $ytick + $ytick}]
583 
584  # Explicitly set boundaries override the detected ranges:
585  foreach coord {xmin xmax ymin ymax} {
586  if {[info exists _data($graph,$coord)]} {
587  set _data($graph,a$coord) $_data($graph,$coord)
588  }
589  }
590 }
591