Context Navigation

source: trunk/gui/scripts/gauge.tcl @ 479

Last change on this file since 479 was 442, checked in by mmc, 18 years ago
Fixed the up/down buttons on the <integer> element so they report min/max limit errors with a nice tooltip, instead of an ugly error dialog!
File size: 23.3 KB

Line
1	# ----------------------------------------------------------------------
2	# COMPONENT: gauge - compact readout for real values
3	#
4	# This widget is a readout for a real value. It has a little glyph
5	# filled with color according to the value, followed by a numeric
6	# representation of the value itself. The value can be edited, and
7	# a list of predefined values can be associated with a menu that
8	# drops down from the value.
9	# ======================================================================
10	# AUTHOR: Michael McLennan, Purdue University
11	# Copyright (c) 2004-2005 Purdue Research Foundation
12	#
13	# See the file "license.terms" for information on usage and
14	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15	# ======================================================================
16	package require Itk
17	package require BLT
18
19	option add *Gauge.sampleWidth 30 widgetDefault
20	option add *Gauge.sampleHeight 20 widgetDefault
21	option add *Gauge.valuePosition "right" widgetDefault
22	option add *Gauge.textBackground #cccccc widgetDefault
23	option add *Gauge.editable yes widgetDefault
24
25	itcl::class Rappture::Gauge {
26	inherit itk::Widget
27
28	itk_option define -editable editable Editable ""
29	itk_option define -state state State "normal"
30	itk_option define -spectrum spectrum Spectrum ""
31	itk_option define -type type Type "real"
32	itk_option define -units units Units ""
33	itk_option define -minvalue minValue MinValue ""
34	itk_option define -maxvalue maxValue MaxValue ""
35	itk_option define -presets presets Presets ""
36	itk_option define -valueposition valuePosition ValuePosition ""
37	itk_option define -image image Image ""
38	itk_option define -samplewidth sampleWidth SampleWidth 0
39	itk_option define -sampleheight sampleHeight SampleHeight 0
40
41	constructor {args} { # defined below }
42
43	public method value {args}
44	public method edit {option}
45	public method bump {delta}
46
47	protected method _redraw {}
48	protected method _resize {}
49	protected method _hilite {comp state}
50	protected method _editor {option args}
51	protected method _presets {option}
52	protected method _layout {}
53
54	private variable _value 0 ;# value for this widget
55
56	blt::bitmap define GaugeArrow-up {
57	#define up_width 8
58	#define up_height 4
59	static unsigned char up_bits[] = {
60	0x10, 0x38, 0x7c, 0xfe};
61	}
62	blt::bitmap define GaugeArrow-down {
63	#define arrow_width 8
64	#define arrow_height 4
65	static unsigned char arrow_bits[] = {
66	0xfe, 0x7c, 0x38, 0x10};
67	}
68
69	blt::bitmap define GaugeArrow {
70	#define arrow_width 9
71	#define arrow_height 4
72	static unsigned char arrow_bits[] = {
73	0x7f, 0x00, 0x3e, 0x00, 0x1c, 0x00, 0x08, 0x00};
74	}
75	}
76
77	itk::usual Gauge {
78	keep -cursor -font -foreground -background
79	keep -selectbackground -selectforeground -selectborderwidth
80	}
81
82	# ----------------------------------------------------------------------
83	# CONSTRUCTOR
84	# ----------------------------------------------------------------------
85	itcl::body Rappture::Gauge::constructor {args} {
86	itk_component add icon {
87	canvas $itk_interior.icon -width 1 -height 1 \
88	-borderwidth 0 -highlightthickness 0
89	} {
90	usual
91	ignore -highlightthickness -highlightbackground -highlightcolor
92	}
93	pack $itk_component(icon) -side left
94	bind $itk_component(icon) <Configure> [itcl::code $this _redraw]
95
96	itk_component add -protected vframe {
97	frame $itk_interior.vframe
98	}
99
100	itk_component add value {
101	label $itk_component(vframe).value -borderwidth 1 -width 7 \
102	-textvariable [itcl::scope _value]
103	} {
104	rename -background -textbackground textBackground Background
105	}
106	pack $itk_component(value) -side left -expand yes -fill both
107
108	bind $itk_component(value) <Enter> [itcl::code $this _hilite value on]
109	bind $itk_component(value) <Leave> [itcl::code $this _hilite value off]
110
111	bind $itk_component(value) <<Cut>> [itcl::code $this edit cut]
112	bind $itk_component(value) <<Copy>> [itcl::code $this edit copy]
113	bind $itk_component(value) <<Paste>> [itcl::code $this edit paste]
114
115	itk_component add emenu {
116	menu $itk_component(value).menu -tearoff 0
117	} {
118	usual
119	ignore -tearoff
120	}
121	$itk_component(emenu) add command -label "Cut" -accelerator "^X" \
122	-command [list event generate $itk_component(value) <<Cut>>]
123	$itk_component(emenu) add command -label "Copy" -accelerator "^C" \
124	-command [list event generate $itk_component(value) <<Copy>>]
125	$itk_component(emenu) add command -label "Paste" -accelerator "^V" \
126	-command [list event generate $itk_component(value) <<Paste>>]
127	bind $itk_component(value) <<PopupMenu>> \
128	[itcl::code $this _editor menu]
129
130	itk_component add editor {
131	Rappture::Editor $itk_interior.editor \
132	-activatecommand [itcl::code $this _editor activate] \
133	-validatecommand [itcl::code $this _editor validate] \
134	-applycommand [itcl::code $this _editor apply]
135	}
136	bind $itk_component(value) <ButtonPress> \
137	[itcl::code $this _editor popup]
138
139
140	itk_component add spinner {
141	frame $itk_component(vframe).spinner
142	}
143
144	itk_component add spinup {
145	button $itk_component(spinner).up -bitmap GaugeArrow-up \
146	-borderwidth 1 -relief raised -highlightthickness 0 \
147	-command [itcl::code $this bump 1]
148	} {
149	usual
150	ignore -borderwidth -highlightthickness
151	}
152	pack $itk_component(spinup) -side top -expand yes -fill both
153
154	itk_component add spindn {
155	button $itk_component(spinner).down -bitmap GaugeArrow-down \
156	-borderwidth 1 -relief raised -highlightthickness 0 \
157	-command [itcl::code $this bump -1]
158	} {
159	usual
160	ignore -borderwidth -highlightthickness
161	}
162	pack $itk_component(spindn) -side bottom -expand yes -fill both
163
164
165	itk_component add presets {
166	button $itk_component(vframe).psbtn -bitmap GaugeArrow \
167	-borderwidth 1 -highlightthickness 0 -relief flat
168	} {
169	usual
170	ignore -borderwidth -relief -highlightthickness
171	rename -background -textbackground textBackground Background
172	}
173
174	bind $itk_component(presets) <Enter> [itcl::code $this _hilite presets on]
175	bind $itk_component(presets) <Leave> [itcl::code $this _hilite presets off]
176
177	itk_component add presetlist {
178	Rappture::Dropdownlist $itk_component(presets).plist \
179	-postcommand [itcl::code $this _presets post] \
180	-unpostcommand [itcl::code $this _presets unpost] \
181	}
182
183	bind $itk_component(presetlist) <<DropdownlistSelect>> \
184	[itcl::code $this _presets select]
185
186	$itk_component(presets) configure -command \
187	[list $itk_component(presetlist) post $itk_component(vframe) left]
188
189	eval itk_initialize $args
190	}
191
192	# ----------------------------------------------------------------------
193	# USAGE: value ?-check? ?<newval>?
194	#
195	# Clients use this to query/set the value for this widget. With
196	# no args, it returns the current value for the widget. If the
197	# <newval> is specified, it sets the value of the widget and
198	# sends a <<Value>> event. If the -check flag is included, the
199	# new value is not actually applied, but just checked for correctness.
200	# ----------------------------------------------------------------------
201	itcl::body Rappture::Gauge::value {args} {
202	set onlycheck 0
203	set i [lsearch -exact $args -check]
204	if {$i >= 0} {
205	set onlycheck 1
206	set args [lreplace $args $i $i]
207	}
208
209	if {[llength $args] == 1} {
210	#
211	# If this gauge has -units, try to convert the incoming
212	# value to that system of units. Also, make sure that
213	# the value is bound by any min/max value constraints.
214	#
215	set newval [set nv [lindex $args 0]]
216	set units $itk_option(-units)
217	if {$units != ""} {
218	set newval [Rappture::Units::convert $newval \
219	-context $units]
220	set nv [Rappture::Units::convert $nv \
221	-context $units -to $units -units off]
222	}
223
224	if {"" != $itk_option(-minvalue)} {
225	set minv $itk_option(-minvalue)
226	if {$units != ""} {
227	set minv [Rappture::Units::convert $minv \
228	-context $units -to $units -units off]
229	}
230	if {$nv < $minv} {
231	error "minimum value allowed here is $itk_option(-minvalue)"
232	}
233	}
234
235	if {"" != $itk_option(-maxvalue)} {
236	set maxv $itk_option(-maxvalue)
237	if {$units != ""} {
238	set maxv [Rappture::Units::convert $maxv \
239	-context $units -to $units -units off]
240	}
241	if {$nv > $maxv} {
242	error "maximum value allowed here is $itk_option(-maxvalue)"
243	}
244	}
245
246	switch -- $itk_option(-type) {
247	integer {
248	if {![string is integer -strict $nv]} {
249	error "Should be an integer value"
250	}
251	}
252	real {
253	if {![string is double -strict $nv]} {
254	error "Should be a real number"
255	}
256	}
257	}
258
259	if {$onlycheck} {
260	return
261	}
262	set _value $newval
263	_redraw
264	event generate $itk_component(hull) <<Value>>
265
266	} elseif {[llength $args] != 0} {
267	error "wrong # args: should be \"value ?-check? ?newval?\""
268	}
269	return $_value
270	}
271
272	# ----------------------------------------------------------------------
273	# USAGE: edit cut
274	# USAGE: edit copy
275	# USAGE: edit paste
276	#
277	# Used internally to handle cut/copy/paste operations for the current
278	# value. Usually invoked by <<Cut>>, <<Copy>>, <<Paste>> events, but
279	# can also be called directly through this method.
280	# ----------------------------------------------------------------------
281	itcl::body Rappture::Gauge::edit {option} {
282	if {$itk_option(-state) == "disabled"} {
283	return ;# disabled? then bail out here!
284	}
285	switch -- $option {
286	cut {
287	edit copy
288	_editor popup
289	$itk_component(editor) value ""
290	$itk_component(editor) deactivate
291	}
292	copy {
293	clipboard clear
294	clipboard append $_value
295	}
296	paste {
297	_editor popup
298	$itk_component(editor) value [clipboard get]
299	$itk_component(editor) deactivate
300	}
301	default {
302	error "bad option \"$option\": should be cut, copy, paste"
303	}
304	}
305	}
306
307	# ----------------------------------------------------------------------
308	# USAGE: bump <delta>
309	#
310	# Changes the current value up/down by the <delta> value. Used
311	# internally by the up/down spinner buttons when the value is
312	# -type integer.
313	# ----------------------------------------------------------------------
314	itcl::body Rappture::Gauge::bump {delta} {
315	set val $_value
316	if {$val == ""} {
317	set val 0
318	}
319	if {[catch {value [expr {$val+$delta}]} result]} {
320	if {[regexp {allowed here is (.+)} $result match newval]} {
321	set _value $newval
322	$itk_component(value) configure -text $newval
323	}
324	if {[regexp {^bad.*: +(.)(.+)} $result match first tail]
325	\|\| [regexp {(.)(.+)} $result match first tail]} {
326	set result "[string toupper $first]$tail"
327	}
328	bell
329	Rappture::Tooltip::cue $itk_component(value) $result
330	return 0
331	}
332	}
333
334	# ----------------------------------------------------------------------
335	# USAGE: _redraw
336	#
337	# Used internally to redraw the gauge on the internal canvas based
338	# on the current value and the size of the widget. In this simple
339	# base class, the gauge is drawn as a colored block, with an optional
340	# image in the middle of it.
341	# ----------------------------------------------------------------------
342	itcl::body Rappture::Gauge::_redraw {} {
343	set c $itk_component(icon)
344	set w [winfo width $c]
345	set h [winfo height $c]
346
347	if {"" == [$c find all]} {
348	# first time around, create the items
349	$c create rectangle 0 0 1 1 -outline black -tags block
350	$c create image 0 0 -anchor center -image "" -tags bimage
351	$c create rectangle 0 0 1 1 -outline "" -fill "" -stipple gray50 -tags screen
352	}
353
354	if {"" != $itk_option(-spectrum)} {
355	set color [$itk_option(-spectrum) get $_value]
356	} else {
357	set color ""
358	}
359
360	# update the items based on current values
361	$c coords block 0 0 [expr {$w-1}] [expr {$h-1}]
362	$c coords screen 0 0 $w $h
363	$c itemconfigure block -fill $color
364
365	$c coords bimage [expr {0.5$w}] [expr {0.5$h}]
366
367	if {$itk_option(-state) == "disabled"} {
368	$c itemconfigure screen -fill white
369	} else {
370	$c itemconfigure screen -fill ""
371	}
372	}
373
374	# ----------------------------------------------------------------------
375	# USAGE: _resize
376	#
377	# Used internally to resize the internal canvas based on the -image
378	# option or the size of the text.
379	# ----------------------------------------------------------------------
380	itcl::body Rappture::Gauge::_resize {} {
381	set w 0
382	set h 0
383
384	if {"" != $itk_option(-image) \|\| "" != $itk_option(-spectrum)} {
385	if {$itk_option(-samplewidth) > 0} {
386	set w $itk_option(-samplewidth)
387	} else {
388	if {$itk_option(-image) != ""} {
389	set w [expr {[image width $itk_option(-image)]+4}]
390	} else {
391	set w [winfo reqheight $itk_component(value)]
392	}
393	}
394
395	if {$itk_option(-sampleheight) > 0} {
396	set h $itk_option(-sampleheight)
397	} else {
398	if {$itk_option(-image) != ""} {
399	set h [expr {[image height $itk_option(-image)]+4}]
400	} else {
401	set h [winfo reqheight $itk_component(value)]
402	}
403	}
404	}
405
406	if {$w > 0 && $h > 0} {
407	$itk_component(icon) configure -width $w -height $h
408	}
409	}
410
411	# ----------------------------------------------------------------------
412	# USAGE: _hilite <component> <state>
413	#
414	# Used internally to resize the internal canvas based on the -image
415	# option or the size of the text.
416	# ----------------------------------------------------------------------
417	itcl::body Rappture::Gauge::_hilite {comp state} {
418	if {$itk_option(-state) == "disabled"} {
419	set state 0 ;# disabled? then don't hilite
420	}
421	if {$comp == "value" && !$itk_option(-editable)} {
422	$itk_component(value) configure -relief flat
423	return
424	}
425
426	if {$state} {
427	$itk_component($comp) configure -relief solid
428	} else {
429	$itk_component($comp) configure -relief flat
430	}
431	}
432
433	# ----------------------------------------------------------------------
434	# USAGE: _editor popup
435	# USAGE: _editor activate
436	# USAGE: _editor validate <value>
437	# USAGE: _editor apply <value>
438	# USAGE: _editor menu <rootx> <rooty>
439	#
440	# Used internally to handle the various functions of the pop-up
441	# editor for the value of this gauge.
442	# ----------------------------------------------------------------------
443	itcl::body Rappture::Gauge::_editor {option args} {
444	if {$itk_option(-state) == "disabled"} {
445	return ;# disabled? then bail out here!
446	}
447	switch -- $option {
448	popup {
449	if {$itk_option(-editable)} {
450	$itk_component(editor) activate
451	}
452	}
453	activate {
454	return [list text $_value \
455	x [winfo rootx $itk_component(value)] \
456	y [winfo rooty $itk_component(value)] \
457	w [winfo width $itk_component(value)] \
458	h [winfo height $itk_component(value)]]
459	}
460	validate {
461	if {[llength $args] != 1} {
462	error "wrong # args: should be \"_editor validate val\""
463	}
464	set val [lindex $args 0]
465
466	if {[catch {value -check $val} result]} {
467	if {[regexp {allowed here is (.+)} $result match newval]} {
468	$itk_component(editor) value $newval
469	}
470	if {[regexp {^bad.*: +(.)(.+)} $result match first tail]
471	\|\| [regexp {(.)(.+)} $result match first tail]} {
472	set result "[string toupper $first]$tail"
473	}
474	bell
475	Rappture::Tooltip::cue $itk_component(editor) $result
476	return 0
477	}
478	}
479	apply {
480	if {[llength $args] != 1} {
481	error "wrong # args: should be \"_editor apply val\""
482	}
483	value [lindex $args 0]
484	}
485	menu {
486	eval tk_popup $itk_component(emenu) $args
487	}
488	default {
489	error "bad option \"$option\": should be popup, activate, validate, apply, and menu"
490	}
491	}
492	}
493
494	# ----------------------------------------------------------------------
495	# USAGE: _presets post
496	# USAGE: _presets unpost
497	# USAGE: _presets select
498	#
499	# Used internally to handle the list of presets for this gauge. The
500	# post/unpost options are invoked when the list is posted or unposted
501	# to manage the relief of the controlling button. The select option
502	# is invoked whenever there is a selection from the list, to assign
503	# the value back to the gauge.
504	# ----------------------------------------------------------------------
505	itcl::body Rappture::Gauge::_presets {option} {
506	switch -- $option {
507	post {
508	set i [$itk_component(presetlist) index $_value]
509	if {$i >= 0} {
510	$itk_component(presetlist) select clear 0 end
511	$itk_component(presetlist) select set $i
512	}
513	after 10 [list $itk_component(presets) configure -relief sunken]
514	}
515	unpost {
516	$itk_component(presets) configure -relief flat
517	}
518	select {
519	set val [$itk_component(presetlist) current]
520	if {"" != $val} {
521	value $val
522	}
523	}
524	default {
525	error "bad option \"$option\": should be post, unpost, select"
526	}
527	}
528	}
529
530	# ----------------------------------------------------------------------
531	# USAGE: _layout
532	#
533	# Used internally to fix the layout of widgets whenever there is a
534	# change in the options that affect layout. Puts the value in the
535	# proper position according to the -valueposition option. Also,
536	# adds or removes the icon if it needs to be shown.
537	# ----------------------------------------------------------------------
538	itcl::body Rappture::Gauge::_layout {} {
539	foreach w [pack slaves $itk_component(hull)] {
540	pack forget $w
541	}
542
543	array set side2anchor {
544	left e
545	right w
546	top s
547	bottom n
548	}
549	set pos $itk_option(-valueposition)
550	pack $itk_component(vframe) -side $pos \
551	-expand yes -fill both -ipadx 2
552	$itk_component(value) configure -anchor $side2anchor($pos)
553
554	if {"" != $itk_option(-image) \|\| "" != $itk_option(-spectrum)} {
555	pack $itk_component(icon) -side $pos
556	}
557	}
558
559	# ----------------------------------------------------------------------
560	# CONFIGURATION OPTION: -editable
561	# ----------------------------------------------------------------------
562	itcl::configbody Rappture::Gauge::editable {
563	if {![string is boolean -strict $itk_option(-editable)]} {
564	error "bad value \"$itk_option(-editable)\": should be boolean"
565	}
566	if {!$itk_option(-editable) && [winfo ismapped $itk_component(editor)]} {
567	$itk_component(editor) deactivate -abort
568	}
569	}
570
571	# ----------------------------------------------------------------------
572	# CONFIGURATION OPTION: -state
573	# ----------------------------------------------------------------------
574	itcl::configbody Rappture::Gauge::state {
575	set valid {normal disabled}
576	if {[lsearch -exact $valid $itk_option(-state)] < 0} {
577	error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
578	}
579	$itk_component(value) configure -state $itk_option(-state)
580	$itk_component(spinup) configure -state $itk_option(-state)
581	$itk_component(spindn) configure -state $itk_option(-state)
582	$itk_component(presets) configure -state $itk_option(-state)
583	_redraw ;# fix gauge
584	}
585
586	# ----------------------------------------------------------------------
587	# CONFIGURATION OPTION: -spectrum
588	# ----------------------------------------------------------------------
589	itcl::configbody Rappture::Gauge::spectrum {
590	if {$itk_option(-spectrum) != ""
591	&& ([catch {$itk_option(-spectrum) isa ::Rappture::Spectrum} valid]
592	\|\| !$valid)} {
593	error "bad option \"$itk_option(-spectrum)\": should be Rappture::Spectrum object"
594	}
595	_resize
596	_layout
597	_redraw
598	}
599
600	# ----------------------------------------------------------------------
601	# CONFIGURATION OPTION: -image
602	# ----------------------------------------------------------------------
603	itcl::configbody Rappture::Gauge::image {
604	if {$itk_option(-image) != ""
605	&& [catch {image width $itk_option(-image)}]} {
606	error "bad value \"$itk_option(-image)\": should be Tk image"
607	}
608	_resize
609	_layout
610	$itk_component(icon) itemconfigure bimage -image $itk_option(-image)
611	}
612
613	# ----------------------------------------------------------------------
614	# CONFIGURATION OPTION: -units
615	# ----------------------------------------------------------------------
616	itcl::configbody Rappture::Gauge::units {
617	if {$itk_option(-units) != ""
618	&& [::Rappture::Units::System::for $itk_option(-units)] == ""} {
619	error "unrecognized system of units \"$itk_option(-units)\""
620	}
621	}
622
623	# ----------------------------------------------------------------------
624	# CONFIGURATION OPTION: -valueposition
625	# ----------------------------------------------------------------------
626	itcl::configbody Rappture::Gauge::valueposition {
627	set pos $itk_option(-valueposition)
628	set opts {left right top bottom}
629	if {[lsearch -exact $opts $pos] < 0} {
630	error "bad value \"$pos\": should be [join $opts {, }]"
631	}
632	_layout
633	}
634
635	# ----------------------------------------------------------------------
636	# CONFIGURATION OPTION: -presets
637	# ----------------------------------------------------------------------
638	itcl::configbody Rappture::Gauge::presets {
639	if {"" == $itk_option(-presets)} {
640	pack forget $itk_component(presets)
641	} else {
642	if {$itk_option(-valueposition) == "left"} {
643	set s "left"
644	} else {
645	set s "right"
646	}
647	set first [lindex [pack slaves $itk_component(vframe)] 0]
648	pack $itk_component(presets) -before $first -side $s -fill y
649
650	$itk_component(presetlist) delete 0 end
651	$itk_component(presetlist) insert end $itk_option(-presets)
652	}
653	}
654
655	# ----------------------------------------------------------------------
656	# CONFIGURATION OPTION: -type
657	# ----------------------------------------------------------------------
658	itcl::configbody Rappture::Gauge::type {
659	switch -- $itk_option(-type) {
660	integer {
661	set first [lindex [pack slaves $itk_component(vframe)] 0]
662	if {$first == $itk_component(presets)} {
663	pack $itk_component(spinner) -after $first -side left -fill y
664	} else {
665	pack $itk_component(spinner) -before $first -side right -fill y
666	}
667	}
668	real {
669	pack forget $itk_component(spinner)
670	}
671	default {
672	error "bad number type \"$itk_option(-type)\": should be integer or real"
673	}
674	}
675	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats: