Context Navigation

source: branches/1.4/gui/scripts/gauge.tcl @ 5057

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

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

Download in other formats: