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