source: trunk/gui/scripts/radiodial.tcl @ 11

Last change on this file since 11 was 11, checked in by mmc, 19 years ago

Major reorganization of the entire package. The config.xml file
is now irrelevant. All the action is in the tool.xml file. The
main program now organizes all input into 1) side-by-side pages,
2) input/result (wizard-style) pages, or 3) a series of wizard-
style pages. The <input> can have <phase> parts representing
the various pages.

Added a new ContourResult? widget based on Swaroop's vtk plotting
code.

Also, added easymesh and showmesh to the "tools" directory.
We need these for Eric Polizzi's code.
File size: 18.0 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: Radiodial - selector, like the dial on a car radio
3#
4#  This widget looks like the dial on an old-fashioned car radio.
5#  It draws a series of values along an axis, and allows a selector
6#  to move back and forth to select the values.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2005
10#  Purdue Research Foundation, West Lafayette, IN
11# ======================================================================
12package require Itk
13
14option add *Radiodial.thickness 10 widgetDefault
15option add *Radiodial.length 2i widgetDefault
16option add *Radiodial.dialOutlineColor black widgetDefault
17option add *Radiodial.dialFillColor white widgetDefault
18option add *Radiodial.lineColor gray widgetDefault
19option add *Radiodial.activeLineColor red widgetDefault
20option add *Radiodial.valueWidth 10 widgetDefault
21option add *Radiodial.font \
22    -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
23
24itcl::class Rappture::Radiodial {
25    inherit itk::Widget
26
27    itk_option define -min min Min ""
28    itk_option define -max max Max ""
29    itk_option define -thickness thickness Thickness 0
30    itk_option define -length length Length 0
31
32    itk_option define -dialoutlinecolor dialOutlineColor Color "black"
33    itk_option define -dialfillcolor dialFillColor Color "white"
34    itk_option define -linecolor lineColor Color "black"
35    itk_option define -activelinecolor activeLineColor Color "black"
36
37    itk_option define -font font Font ""
38    itk_option define -valuewidth valueWidth ValueWidth 0
39
40
41    constructor {args} { # defined below }
42    destructor { # defined below }
43
44    public method add {label {value ""}}
45    public method clear {}
46    public method get {args}
47    public method current {args}
48    public method color {value}
49                                                                               
50    protected method _redraw {}
51    protected method _click {x y}
52    protected method _navigate {offset}
53    protected method _limits {}
54    protected method _fixSize {}
55
56    private variable _values ""       ;# list of all values on the dial
57    private variable _val2label       ;# maps value => label
58    private variable _current ""      ;# current value (where pointer is)
59
60    private variable _spectrum ""     ;# width allocated for values
61    private variable _activecolor ""  ;# width allocated for values
62    private variable _vwidth 0        ;# width allocated for values
63
64    #
65    # Load the image for the knob.
66    #
67    private common images
68    set images(knob) [image create photo -data {
69R0lGODlhCQAMAMIEAAQCBJyanNza3Pz+/P///////////////yH5BAEKAAQALAAAAAAJAAwAAAMj
70SEqwDqO9MYJkVASLh/gbAHmgNX6amZXimrbVFkKyLN44kAAAOw==
71}]
72}
73                                                                               
74itk::usual Radiodial {
75}
76
77# ----------------------------------------------------------------------
78# CONSTRUCTOR
79# ----------------------------------------------------------------------
80itcl::body Rappture::Radiodial::constructor {args} {
81    itk_component add dial {
82        canvas $itk_interior.dial
83    }
84    pack $itk_component(dial) -expand yes -fill both
85    bind $itk_component(dial) <Configure> [itcl::code $this _redraw]
86
87    bind $itk_component(dial) <ButtonPress-1> [itcl::code $this _click %x %y]
88    bind $itk_component(dial) <B1-Motion> [itcl::code $this _click %x %y]
89    bind $itk_component(dial) <ButtonRelease-1> [itcl::code $this _click %x %y]
90
91    bind $itk_component(hull) <KeyPress-Left> [itcl::code $this _navigate -1]
92    bind $itk_component(hull) <KeyPress-Right> [itcl::code $this _navigate 1]
93
94    eval itk_initialize $args
95
96    _fixSize
97}
98
99# ----------------------------------------------------------------------
100# DESTRUCTOR
101# ----------------------------------------------------------------------
102itcl::body Rappture::Radiodial::destructor {} {
103    after cancel [itcl::code $this _redraw]
104}
105
106# ----------------------------------------------------------------------
107# USAGE: add <label> ?<value>?
108#
109# Clients use this to add new values to the dial.  Values are always
110# sorted in order along the dial.  If the value is not specified,
111# then it is created automatically based on the number of elements
112# on the dial.
113# ----------------------------------------------------------------------
114itcl::body Rappture::Radiodial::add {label {value ""}} {
115    if {"" == $value} {
116        set value [llength $_values]
117    }
118    lappend _values $value
119    set _values [lsort -real $_values]
120    set _val2label($value) $label
121
122    if {"" == $_current} {
123        set _current $value
124    }
125
126    after cancel [itcl::code $this _redraw]
127    after idle [itcl::code $this _redraw]
128}
129
130# ----------------------------------------------------------------------
131# USAGE: clear
132#
133# Clients use this to remove all existing values from the dial.
134# ----------------------------------------------------------------------
135itcl::body Rappture::Radiodial::clear {} {
136    set _values ""
137    set _current ""
138    catch {unset _val2label}
139
140    after cancel [itcl::code $this _redraw]
141    after idle [itcl::code $this _redraw]
142}
143
144# ----------------------------------------------------------------------
145# USAGE: get ?-format what? ?current|@index?
146#
147# Clients use this to query values within this radiodial.  With no
148# args, it returns a list of all values stored in the widget.  The
149# "current" arg requests only the current value on the radiodial.
150# The @index syntax can be used to request a particular value at
151# an index within the list of values.
152#
153# By default, this method returns the label for each value.  The
154# format option can be used to request the label, the value, or
155# both.
156# ----------------------------------------------------------------------
157itcl::body Rappture::Radiodial::get {args} {
158    Rappture::getopts args params {
159        value -format "label"
160    }
161    if {[llength $args] > 1} {
162        error "wrong # args: should be \"get ?-format f? ?current|@index\""
163    }
164    set index [lindex $args 0]
165    if {"" == $index} {
166        set ilist ""
167        for {set i 0} {$i < [llength $_values]} {incr i} {
168            append ilist $i
169        }
170    } elseif {"current" == $index} {
171        set ilist [lsearch -exact $_values $_current]
172        if {$ilist < 0} {
173            set ilist ""
174        }
175    } elseif {[regexp {^@([0-9]+|end)$} $index match i]} {
176        set ilist $i
177    }
178    if {[llength $ilist] == 1} {
179        set op set
180    } else {
181        set op lappend
182    }
183
184    set rlist ""
185    foreach i $ilist {
186        switch -- $params(-format) {
187            label {
188                set v [lindex $_values $i]
189                $op rlist $_val2label($v)
190            }
191            value {
192                $op rlist [lindex $_values $i]
193            }
194            all {
195                set v [lindex $_values $i]
196                $op rlist [list $_val2label($v) $v]
197            }
198            default {
199                error "bad value \"$v\": should be label, value, all"
200            }
201        }
202    }
203    return $rlist
204}
205
206# ----------------------------------------------------------------------
207# USAGE: current ?<newval>?
208#
209# Clients use this to get/set the current value for this widget.
210# ----------------------------------------------------------------------
211itcl::body Rappture::Radiodial::current {args} {
212    if {[llength $args] == 0} {
213        return $_current
214    } elseif {[llength $args] == 1} {
215        set newval [lindex $args 0]
216        set found 0
217        foreach v $_values {
218            if {[string equal $_val2label($v) $newval]} {
219                set newval $v
220                set found 1
221                break
222            }
223        }
224        if {!$found} {
225            error "bad value \"$newval\""
226        }
227        set _current $newval
228        return $_current
229    }
230    error "wrong # args: should be \"current ?newval?\""
231}
232
233# ----------------------------------------------------------------------
234# USAGE: color <value>
235#
236# Clients use this to query the color associated with a <value>
237# along the dial.
238# ----------------------------------------------------------------------
239itcl::body Rappture::Radiodial::color {value} {
240    set found 0
241    foreach v $_values {
242        if {[string equal $_val2label($v) $value]} {
243            set value $v
244            set found 1
245            break
246        }
247    }
248    if {!$found} {
249        error "bad value \"$value\""
250    }
251
252    if {"" != $_spectrum} {
253        foreach {min max} [_limits] break
254        set frac [expr {double($value-$min)/($max-$min)}]
255        set color [$_spectrum get $frac]
256    } else {
257        if {$value == $_current} {
258            set color $_activecolor
259        } else {
260            set color $itk_option(-linecolor)
261        }
262    }
263    return $color
264}
265
266# ----------------------------------------------------------------------
267# USAGE: _redraw
268#
269# Called automatically whenever the widget changes size to redraw
270# all elements within it.
271# ----------------------------------------------------------------------
272itcl::body Rappture::Radiodial::_redraw {} {
273    set c $itk_component(dial)
274    $c delete all
275
276    set w [winfo width $c]
277    set h [winfo height $c]
278    set y1 [expr {$h-[image height $images(knob)]/2-1}]
279    set y0 [expr {$y1 - $itk_option(-thickness)-1}]
280    set x0 1
281    set x1 [expr {$w-$_vwidth-4}]
282
283    # draw the background rectangle
284    $c create rectangle $x0 $y0 $x1 $y1 \
285        -outline $itk_option(-dialoutlinecolor) \
286        -fill $itk_option(-dialfillcolor)
287
288    # draw lines for all values
289    foreach {min max} [_limits] break
290    if {$max > $min} {
291        foreach v $_values {
292            set frac [expr {double($v-$min)/($max-$min)}]
293            if {"" != $_spectrum} {
294                set color [$_spectrum get $frac]
295            } else {
296                if {$v == $_current} {
297                    set color $_activecolor
298                } else {
299                    set color $itk_option(-linecolor)
300                }
301            }
302            set thick [expr {($v == $_current) ? 3 : 1}]
303
304            set x [expr {$frac*($x1-$x0) + $x0}]
305            $c create line $x [expr {$y0+1}] $x $y1 -fill $color -width $thick
306        }
307
308        if {"" != $_current} {
309            set x [expr {double($_current-$min)/($max-$min)*($x1-$x0) + $x0}]
310            $c create image $x [expr {$h-1}] -anchor s -image $images(knob)
311        }
312    }
313
314    # if the -valuewidth is > 0, then make room for the value
315    set vw $itk_option(-valuewidth)
316    if {$vw > 0 && "" != $_current} {
317        set str $_val2label($_current)
318        if {[string length $str] >= $vw} {
319            set str "[string range $str 0 [expr {$vw-3}]]..."
320        }
321
322        set dy [expr {([font metrics $itk_option(-font) -linespace]
323                        - [font metrics $itk_option(-font) -ascent])/2}]
324
325        set id [$c create text [expr {$x1+4}] [expr {($y1+$y0)/2+$dy}] \
326            -anchor w -text $str -font $itk_option(-font)]
327        foreach {x0 y0 x1 y1} [$c bbox $id] break
328        set x0 [expr {$x0 + 10}]
329
330        # set up a tooltip so you can mouse over truncated values
331        Rappture::Tooltip::text $c $_val2label($_current)
332        $c bind $id <Enter> \
333            [list ::Rappture::Tooltip::tooltip pending %W +$x0,$y1]
334        $c bind $id <Leave> \
335            [list ::Rappture::Tooltip::tooltip cancel]
336        $c bind $id <ButtonPress> \
337            [list ::Rappture::Tooltip::tooltip cancel]
338        $c bind $id <KeyPress> \
339            [list ::Rappture::Tooltip::tooltip cancel]
340    }
341}
342
343# ----------------------------------------------------------------------
344# USAGE: _click <x> <y>
345#
346# Called automatically whenever the user clicks or drags on the widget
347# to select a value.  Moves the current value to the one nearest the
348# click point.  If the value actually changes, it generates a <<Value>>
349# event to notify clients.
350# ----------------------------------------------------------------------
351itcl::body Rappture::Radiodial::_click {x y} {
352    set c $itk_component(dial)
353    set w [winfo width $c]
354    set h [winfo height $c]
355    set x0 1
356    set x1 [expr {$w-$_vwidth-4}]
357
358    focus $itk_component(hull)
359
360    # draw lines for all values
361    foreach {min max} [_limits] break
362    if {$max > $min && $x >= $x0 && $x <= $x1} {
363        set dmin $w
364        set xnearest 0
365        set vnearest ""
366        foreach v $_values {
367            set xv [expr {double($v-$min)/($max-$min)*($x1-$x0) + $x0}]
368            if {abs($xv-$x) < $dmin} {
369                set dmin [expr {abs($xv-$x)}]
370                set xnearest $xv
371                set vnearest $v
372            }
373        }
374
375        if {$vnearest != $_current} {
376            set _current $vnearest
377            _redraw
378
379            event generate $itk_component(hull) <<Value>>
380        }
381    }
382}
383
384# ----------------------------------------------------------------------
385# USAGE: _navigate <offset>
386#
387# Called automatically whenever the user presses left/right keys
388# to nudge the current value left or right by some <offset>.  If the
389# value actually changes, it generates a <<Value>> event to notify
390# clients.
391# ----------------------------------------------------------------------
392itcl::body Rappture::Radiodial::_navigate {offset} {
393    set index [lsearch -exact $_values $_current]
394    if {$index >= 0} {
395        incr index $offset
396        if {$index >= [llength $_values]} {
397            set index [expr {[llength $_values]-1}]
398        } elseif {$index < 0} {
399            set index 0
400        }
401
402        set newval [lindex $_values $index]
403        if {$newval != $_current} {
404            set _current $newval
405            _redraw
406
407            event generate $itk_component(hull) <<Value>>
408        }
409    }
410}
411
412# ----------------------------------------------------------------------
413# USAGE: _limits
414#
415# Used internally to compute the overall min/max limits for the
416# radio dial.  Returns {min max}, representing the end values for
417# the scale.
418# ----------------------------------------------------------------------
419itcl::body Rappture::Radiodial::_limits {} {
420    if {[llength $_values] == 0} {
421        set min 0
422        set max 0
423    } else {
424        set min [lindex $_values 0]
425        set max $min
426        foreach v [lrange $_values 1 end] {
427            if {$v < $min} { set min $v }
428            if {$v > $max} { set max $v }
429        }
430        set del [expr {$max-$min}]
431        set min [expr {$min-0.1*$del}]
432        set max [expr {$max+0.1*$del}]
433    }
434
435    if {"" != $itk_option(-min)} {
436        set min $itk_option(-min)
437    }
438    if {"" != $itk_option(-max)} {
439        set max $itk_option(-max)
440    }
441    return [list $min $max]
442}
443
444# ----------------------------------------------------------------------
445# USAGE: _fixSize
446#
447# Used internally to compute the overall size of the widget based
448# on the -thickness and -length options.
449# ----------------------------------------------------------------------
450itcl::body Rappture::Radiodial::_fixSize {} {
451    set h [winfo pixels $itk_component(hull) $itk_option(-thickness)]
452    set h [expr {$h/2 + [image height $images(knob)]}]
453
454    set w [winfo pixels $itk_component(hull) $itk_option(-length)]
455
456    # if the -valuewidth is > 0, then make room for the value
457    if {$itk_option(-valuewidth) > 0} {
458        set charw [font measure $itk_option(-font) "n"]
459        set _vwidth [expr {$itk_option(-valuewidth)*$charw}]
460        set w [expr {$w+$_vwidth+4}]
461    } else {
462        set _vwidth 0
463    }
464
465    $itk_component(dial) configure -width $w -height $h
466}
467
468# ----------------------------------------------------------------------
469# CONFIGURE: -thickness
470# ----------------------------------------------------------------------
471itcl::configbody Rappture::Radiodial::thickness {
472    _fixSize
473}
474
475# ----------------------------------------------------------------------
476# CONFIGURE: -length
477# ----------------------------------------------------------------------
478itcl::configbody Rappture::Radiodial::length {
479    _fixSize
480}
481
482# ----------------------------------------------------------------------
483# CONFIGURE: -font
484# ----------------------------------------------------------------------
485itcl::configbody Rappture::Radiodial::font {
486    _fixSize
487}
488
489# ----------------------------------------------------------------------
490# CONFIGURE: -valuewidth
491# ----------------------------------------------------------------------
492itcl::configbody Rappture::Radiodial::valuewidth {
493    if {![string is integer $itk_option(-valuewidth)]} {
494        error "bad value \"$itk_option(-valuewidth)\": should be integer"
495    }
496    after cancel [itcl::code $this _redraw]
497    after idle [itcl::code $this _redraw]
498}
499
500# ----------------------------------------------------------------------
501# CONFIGURE: -dialoutlinecolor
502# ----------------------------------------------------------------------
503itcl::configbody Rappture::Radiodial::dialoutlinecolor {
504    after cancel [itcl::code $this _redraw]
505    after idle [itcl::code $this _redraw]
506}
507
508# ----------------------------------------------------------------------
509# CONFIGURE: -dialfillcolor
510# ----------------------------------------------------------------------
511itcl::configbody Rappture::Radiodial::dialfillcolor {
512    after cancel [itcl::code $this _redraw]
513    after idle [itcl::code $this _redraw]
514}
515
516# ----------------------------------------------------------------------
517# CONFIGURE: -linecolor
518# ----------------------------------------------------------------------
519itcl::configbody Rappture::Radiodial::linecolor {
520    after cancel [itcl::code $this _redraw]
521    after idle [itcl::code $this _redraw]
522}
523
524# ----------------------------------------------------------------------
525# CONFIGURE: -activelinecolor
526# ----------------------------------------------------------------------
527itcl::configbody Rappture::Radiodial::activelinecolor {
528    set val $itk_option(-activelinecolor)
529    if {[catch {$val isa ::Rappture::Spectrum} valid] == 0 && $valid} {
530        set _spectrum $val
531        set _activecolor ""
532    } elseif {[catch {winfo rgb $itk_component(hull) $val}] == 0} {
533        set _spectrum ""
534        set _activecolor $val
535    } else {
536        error "bad value \"$val\": should be Spectrum object or color"
537    }
538    after cancel [itcl::code $this _redraw]
539    after idle [itcl::code $this _redraw]
540}
Note: See TracBrowser for help on using the repository browser.