Context Navigation

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

Last change on this file since 3544 was 3510, checked in by gah, 12 years ago
start of string trim fixes for gauge and switch (boolean)
File size: 25.9 KB

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

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

Download in other formats: