1# plotconfig.tcl -- 2# Facilities for configuring the various procedures of Plotchart 3# 4 5namespace eval ::Plotchart { 6 variable config 7 8 # FontMetrics -- 9 # Determine the font metrics 10 # 11 # Arguments: 12 # w Canvas to be used 13 # 14 # Result: 15 # List of character width and height 16 # 17 proc FontMetrics {w} { 18 set item [$w create text 0 0 -text "M"] 19 set bbox [$w bbox $item] 20 set char_width [expr {[lindex $bbox 2] - [lindex $bbox 0]}] 21 set char_height [expr {[lindex $bbox 3] - [lindex $bbox 1]}] 22 if { $char_width < 8 } { set char_width 8 } 23 if { $char_height < 14 } { set char_height 14 } 24 $w delete $item 25 26 return [list $char_width $char_height] 27 } 28 29 # 30 # Set default configuration options 31 # 32 set config(charttypes) {xyplot xlogyplot logxyplot logxlogyplot 33 piechart polarplot 34 histogram horizbars vertbars ganttchart 35 timechart stripchart isometric 3dplot 3dbars 36 radialchart txplot 3dribbon boxplot windrose 37 targetdiagram performance} 38 39 set config(xyplot,components) {title margin text legend leftaxis rightaxis bottomaxis background} 40 set config(xlogyplot,components) {title margin text legend leftaxis bottomaxis background} 41 set config(logxyplot,components) {title margin text legend leftaxis bottomaxis background} 42 set config(logxlogyplot,components) {title margin text legend leftaxis bottomaxis background} 43 set config(piechart,components) {title margin text legend labels background} 44 set config(polarplot,components) {title margin text legend axis background} 45 set config(histogram,components) {title margin text legend leftaxis rightaxis bottomaxis background} 46 set config(horizbars,components) {title margin text legend leftaxis bottomaxis background} 47 set config(vertbars,components) {title margin text legend leftaxis bottomaxis background} 48 set config(ganttchart,components) {title margin text legend axis background} 49 set config(timechart,components) {title margin text legend leftaxis bottomaxis background} 50 set config(stripchart,components) {title margin text legend leftaxis bottomaxis background} 51 set config(isometric,components) {title margin text legend leftaxis bottomaxis background} 52 set config(3dplot,components) {title margin text legend xaxis yaxis zaxis background} 53 set config(3dbars,components) {title margin text legend leftaxis bottomaxis background} 54 set config(radialchart,components) {title margin text legend leftaxis bottomaxis background} 55 set config(txplot,components) {title margin text legend leftaxis rightaxis bottomaxis background} 56 set config(3dribbon,components) {title margin text legend leftaxis bottomaxis background} 57 set config(boxplot,components) {title margin text legend leftaxis bottomaxis background} 58 set config(windrose,components) {title margin text legend axis background} 59 set config(targetdiagram,components) {title margin text legend leftaxis bottomaxis background limits} 60 set config(performance,components) {title margin text legend leftaxis bottomaxis background limits} 61 62 set config(axis,properties) {color thickness font format ticklength textcolor labeloffset minorticks} 63 set config(leftaxis,properties) $config(axis,properties) 64 set config(rightaxis,properties) $config(axis,properties) 65 set config(topaxis,properties) $config(axis,properties) 66 set config(bottomaxis,properties) $config(axis,properties) 67 set config(xaxis,properties) $config(axis,properties) 68 set config(yaxis,properties) $config(axis,properties) 69 set config(zaxis,properties) $config(axis,properties) 70 set config(margin,properties) {left right top bottom} 71 set config(title,properties) {textcolor font anchor} 72 set config(text,properties) {textcolor font anchor} 73 set config(labels,properties) {textcolor font} 74 set config(background,properties) {outercolor innercolor} 75 set config(legend,properties) {background border position} 76 set config(limits,properties) {color} 77 78 # TODO: default values 79 canvas .invisibleCanvas 80 set invisibleLabel [.invisibleCanvas create text 0 0 -text "M"] 81 82 set _color "black" 83 set _font [.invisibleCanvas itemcget $invisibleLabel -font] 84 set _thickness 1 85 set _format "" 86 set _ticklength 3 87 set _minorticks 0 88 set _textcolor "black" 89 set _anchor n 90 set _labeloffset 2 91 92 foreach {char_width char_height} [FontMetrics .invisibleCanvas] {break} 93 94 set config(font,char_width) $char_width 95 set config(font,char_height) $char_height 96 97 set _left [expr {$char_width * 8}] 98 set _right [expr {$char_width * 4}] 99 set _top [expr {$char_height * 2}] 100 set _bottom [expr {$char_height * 2 + 2}] 101 set _bgcolor "white" 102 set _outercolor "white" 103 set _innercolor "white" ;# Not implemented yet: "$w lower data" gets in the way 104 set _background "white" 105 set _border "black" 106 set _position "top-right" 107 108 destroy .invisibleCanvas 109 110 foreach type $config(charttypes) { 111 foreach comp $config($type,components) { 112 foreach prop $config($comp,properties) { 113 set config($type,$comp,$prop) [set _$prop] 114 set config($type,$comp,$prop,default) [set _$prop] 115 } 116 } 117 } 118 119 # 120 # Specific defaults 121 # 122 set config(targetdiagram,limits,color) "gray" 123} 124 125# plotconfig -- 126# Set or query general configuration options of Plotchart 127# 128# Arguments: 129# charttype Type of plot or chart or empty (optional) 130# component Component of the type of plot or chart or empty (optional) 131# property Property of the component or empty (optional) 132# value New value of the property if given (optional) 133# (if "default", default is restored) 134# 135# Result: 136# No arguments: list of supported chart types 137# Only chart type given: list of components for that type 138# Chart type and component given: list of properties for that component 139# Chart type, component and property given: current value 140# If a new value is given, nothing 141# 142# Note: 143# The command contains a lot of functionality, but its structure is 144# fairly simple. No property has an empty string as a sensible value. 145# 146proc ::Plotchart::plotconfig {{charttype {}} {component {}} {property {}} {value {}}} { 147 variable config 148 149 if { $charttype == {} } { 150 return $config(charttypes) 151 } else { 152 if { [lsearch $config(charttypes) $charttype] < 0 } { 153 return -code error "Unknown chart type - $charttype" 154 } 155 } 156 157 if { $component == {} } { 158 return $config($charttype,components) 159 } else { 160 if { [lsearch $config($charttype,components) $component] < 0 } { 161 return -code error "Unknown component '$component' for this chart type - $charttype" 162 } 163 } 164 165 if { $property == {} } { 166 return $config($component,properties) 167 } else { 168 if { [lsearch $config($component,properties) $property] < 0 } { 169 return -code error "Unknown property '$property' for this component '$component' (chart: $charttype)" 170 } 171 } 172 173 if { $value == {} } { 174 return $config($charttype,$component,$property) 175 } elseif { $value == "default" } { 176 set config($charttype,$component,$property) \ 177 $config($charttype,$component,$property,default) 178 return $config($charttype,$component,$property) 179 } else { 180 if { $value == "none" } { 181 set value "" 182 } 183 set config($charttype,$component,$property) $value 184 } 185} 186 187# CopyConfig -- 188# Copy the configuration options to a particular plot/chart 189# 190# Arguments: 191# charttype Type of plot or chart 192# chart Widget of the actual chart 193# 194# Result: 195# None 196# 197# Side effects: 198# The configuration options are available for the particular plot or 199# chart and can be modified specifically for that plot or chart. 200# 201proc ::Plotchart::CopyConfig {charttype chart} { 202 variable config 203 204 foreach {prop value} [array get config $charttype,*] { 205 set chprop [string map [list $charttype, $chart,] $prop] 206 set config($chprop) $value 207 } 208} 209 210# plotmethod -- 211# Register a new plotting method 212# 213# Arguments: 214# charttype Type of plot or chart 215# methodname Name of the method 216# plotproc Plotting procedure that implements the method 217# 218# Result: 219# None 220# 221# Side effects: 222# Registers the plotting procedure under the method name, 223# so that for that type of plot/chart you can now use: 224# 225# $p methodname ... 226# 227# and the plotting procedure is invoked. 228# 229# The plotting procedure must have the following interface: 230# 231# proc plotproc {plot widget ...} {...} 232# 233# The first argument is the identification of the plot 234# (the $p in the above example), the second is the name 235# of the widget. This way you can use canvas subcommands 236# via $widget and Plotchart's existing commands via $plot. 237# 238proc ::Plotchart::plotmethod {charttype methodname plotproc} { 239 240 variable methodProc 241 242 set fullname [uplevel 1 [list namespace which $plotproc]] 243 244 if { $fullname != "" } { 245 set methodProc($charttype,$methodname) [list $fullname $charttype] 246 } else { 247 return -code error "No such command or procedure: $plotproc" 248 } 249} 250