Context Navigation

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

Last change on this file since 5370 was 3330, checked in by gah, 12 years ago
merge (by hand) with Rappture1.2 branch
File size: 29.0 KB

Rev	Line
[3330]	1	# -- mode: tcl; indent-tabs-mode: nil --
[11]	2	# ----------------------------------------------------------------------
	3	# COMPONENT: Radiodial - selector, like the dial on a car radio
	4	#
	5	# This widget looks like the dial on an old-fashioned car radio.
	6	# It draws a series of values along an axis, and allows a selector
	7	# to move back and forth to select the values.
	8	# ======================================================================
	9	# AUTHOR: Michael McLennan, Purdue University
[3177]	10	# Copyright (c) 2004-2012 HUBzero Foundation, LLC
[115]	11	#
	12	# See the file "license.terms" for information on usage and
	13	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
[11]	14	# ======================================================================
	15	package require Itk
	16
	17	option add *Radiodial.thickness 10 widgetDefault
	18	option add *Radiodial.length 2i widgetDefault
[428]	19	option add *Radiodial.knobImage knob widgetDefault
	20	option add *Radiodial.knobPosition n@middle widgetDefault
[11]	21	option add *Radiodial.dialOutlineColor black widgetDefault
	22	option add *Radiodial.dialFillColor white widgetDefault
	23	option add *Radiodial.lineColor gray widgetDefault
[64]	24	option add *Radiodial.activeLineColor black widgetDefault
[428]	25	option add *Radiodial.padding 0 widgetDefault
[11]	26	option add *Radiodial.valueWidth 10 widgetDefault
[428]	27	option add *Radiodial.valuePadding 0.1 widgetDefault
	28	option add *Radiodial.foreground black widgetDefault
[11]	29	option add *Radiodial.font \
[676]	30	--helvetica-medium-r-normal--12-* widgetDefault
[11]	31
	32	itcl::class Rappture::Radiodial {
	33	inherit itk::Widget
	34
	35	itk_option define -min min Min ""
	36	itk_option define -max max Max ""
[413]	37	itk_option define -variable variable Variable ""
	38
[11]	39	itk_option define -thickness thickness Thickness 0
	40	itk_option define -length length Length 0
[428]	41	itk_option define -padding padding Padding 0
[11]	42
[428]	43	itk_option define -foreground foreground Foreground "black"
[11]	44	itk_option define -dialoutlinecolor dialOutlineColor Color "black"
	45	itk_option define -dialfillcolor dialFillColor Color "white"
[428]	46	itk_option define -dialprogresscolor dialProgressColor Color ""
[11]	47	itk_option define -linecolor lineColor Color "black"
	48	itk_option define -activelinecolor activeLineColor Color "black"
[428]	49	itk_option define -knobimage knobImage KnobImage ""
	50	itk_option define -knobposition knobPosition KnobPosition ""
[11]	51
	52	itk_option define -font font Font ""
	53	itk_option define -valuewidth valueWidth ValueWidth 0
[428]	54	itk_option define -valuepadding valuePadding ValuePadding 0
[11]	55
[3186]	56	itk_option define -interactcommand interactCommand InteractCommand ""
[11]	57
[3186]	58
[11]	59	constructor {args} { # defined below }
	60	destructor { # defined below }
	61
	62	public method add {label {value ""}}
	63	public method clear {}
	64	public method get {args}
	65	public method current {args}
	66	public method color {value}
[1929]	67
[413]	68	protected method _setCurrent {val}
[11]	69	protected method _redraw {}
	70	protected method _click {x y}
	71	protected method _navigate {offset}
	72	protected method _limits {}
[1400]	73	protected method _findLabel {str}
[11]	74	protected method _fixSize {}
[413]	75	protected method _fixValue {args}
[3186]	76	protected method _doInteract {}
[11]	77
	78	private variable _values "" ;# list of all values on the dial
[1400]	79	private variable _val2label ;# maps value => string label(s)
[11]	80	private variable _current "" ;# current value (where pointer is)
[413]	81	private variable _variable "" ;# variable associated with -variable
[11]	82
[428]	83	private variable _knob "" ;# image for knob
[11]	84	private variable _spectrum "" ;# width allocated for values
	85	private variable _activecolor "" ;# width allocated for values
	86	private variable _vwidth 0 ;# width allocated for values
	87	}
[1929]	88
[11]	89	itk::usual Radiodial {
[428]	90	keep -background -foreground -cursor -font
[11]	91	}
	92
	93	# ----------------------------------------------------------------------
	94	# CONSTRUCTOR
	95	# ----------------------------------------------------------------------
	96	itcl::body Rappture::Radiodial::constructor {args} {
	97	itk_component add dial {
[1929]	98	canvas $itk_interior.dial
[11]	99	}
	100	pack $itk_component(dial) -expand yes -fill both
	101	bind $itk_component(dial) <Configure> [itcl::code $this _redraw]
	102
	103	bind $itk_component(dial) <ButtonPress-1> [itcl::code $this _click %x %y]
	104	bind $itk_component(dial) <B1-Motion> [itcl::code $this _click %x %y]
	105	bind $itk_component(dial) <ButtonRelease-1> [itcl::code $this _click %x %y]
	106
	107	bind $itk_component(hull) <KeyPress-Left> [itcl::code $this _navigate -1]
	108	bind $itk_component(hull) <KeyPress-Right> [itcl::code $this _navigate 1]
	109
	110	eval itk_initialize $args
	111
	112	_fixSize
	113	}
	114
	115	# ----------------------------------------------------------------------
	116	# DESTRUCTOR
	117	# ----------------------------------------------------------------------
	118	itcl::body Rappture::Radiodial::destructor {} {
[413]	119	configure -variable "" ;# remove variable trace
[11]	120	after cancel [itcl::code $this _redraw]
	121	}
	122
	123	# ----------------------------------------------------------------------
	124	# USAGE: add <label> ?<value>?
	125	#
	126	# Clients use this to add new values to the dial. Values are always
	127	# sorted in order along the dial. If the value is not specified,
	128	# then it is created automatically based on the number of elements
	129	# on the dial.
	130	# ----------------------------------------------------------------------
	131	itcl::body Rappture::Radiodial::add {label {value ""}} {
	132	if {"" == $value} {
[1929]	133	set value [llength $_values]
[11]	134	}
	135
[1400]	136	# Add this value if we've never see it before
	137	if {[lsearch -real $_values $value] < 0} {
	138	lappend _values $value
	139	set _values [lsort -real $_values]
	140	}
	141
	142	# Keep all equivalent strings for this value.
	143	# That way, we can later select either "1e18" or "1.0e+18"
	144	lappend _val2label($value) $label
	145
[11]	146	if {"" == $_current} {
[1929]	147	_setCurrent $value
[11]	148	}
	149
	150	after cancel [itcl::code $this _redraw]
	151	after idle [itcl::code $this _redraw]
	152	}
	153
	154	# ----------------------------------------------------------------------
	155	# USAGE: clear
	156	#
	157	# Clients use this to remove all existing values from the dial.
	158	# ----------------------------------------------------------------------
	159	itcl::body Rappture::Radiodial::clear {} {
	160	set _values ""
[413]	161	_setCurrent ""
[11]	162	catch {unset _val2label}
	163
	164	after cancel [itcl::code $this _redraw]
	165	after idle [itcl::code $this _redraw]
	166	}
	167
	168	# ----------------------------------------------------------------------
	169	# USAGE: get ?-format what? ?current\|@index?
	170	#
	171	# Clients use this to query values within this radiodial. With no
	172	# args, it returns a list of all values stored in the widget. The
	173	# "current" arg requests only the current value on the radiodial.
	174	# The @index syntax can be used to request a particular value at
	175	# an index within the list of values.
	176	#
	177	# By default, this method returns the label for each value. The
	178	# format option can be used to request the label, the value, or
	179	# both.
	180	# ----------------------------------------------------------------------
	181	itcl::body Rappture::Radiodial::get {args} {
	182	Rappture::getopts args params {
[1929]	183	value -format "label"
[11]	184	}
	185	if {[llength $args] > 1} {
[1929]	186	error "wrong # args: should be \"get ?-format f? ?current\|@index\""
[11]	187	}
	188	set index [lindex $args 0]
	189	if {"" == $index} {
[1929]	190	set ilist ""
	191	for {set i 0} {$i < [llength $_values]} {incr i} {
	192	lappend ilist $i
	193	}
[11]	194	} elseif {"current" == $index} {
[1929]	195	set ilist [lsearch -exact $_values $_current]
	196	if {$ilist < 0} {
	197	set ilist ""
	198	}
[11]	199	} elseif {[regexp {^@([0-9]+\|end)$} $index match i]} {
[1929]	200	set ilist $i
[11]	201	}
	202	if {[llength $ilist] == 1} {
[1929]	203	set op set
[11]	204	} else {
[1929]	205	set op lappend
[11]	206	}
	207
	208	set rlist ""
	209	foreach i $ilist {
[1929]	210	switch -- $params(-format) {
	211	label {
	212	set v [lindex $_values $i]
	213	$op rlist [lindex $_val2label($v) 0]
	214	}
	215	value {
	216	$op rlist [lindex $_values $i]
	217	}
	218	position {
	219	foreach {min max} [_limits] break
	220	set v [lindex $_values $i]
	221	set frac [expr {double($v-$min)/($max-$min)}]
	222	$op rlist $frac
	223	}
	224	all {
	225	set v [lindex $_values $i]
	226	foreach {min max} [_limits] break
	227	set frac [expr {double($v-$min)/($max-$min)}]
[1400]	228	set l [lindex $_val2label($v) 0]
[1929]	229	$op rlist [list $l $v $frac]
	230	}
	231	default {
	232	error "bad value \"$v\": should be label, value, position, all"
	233	}
	234	}
[11]	235	}
	236	return $rlist
	237	}
	238
	239	# ----------------------------------------------------------------------
	240	# USAGE: current ?<newval>?
	241	#
	242	# Clients use this to get/set the current value for this widget.
	243	# ----------------------------------------------------------------------
	244	itcl::body Rappture::Radiodial::current {args} {
	245	if {[llength $args] == 0} {
[1929]	246	return $_current
[11]	247	} elseif {[llength $args] == 1} {
[1929]	248	set newval [lindex $args 0]
[1407]	249	set n [_findLabel $newval]
[1422]	250
[1929]	251	# Don't use expr (?:) because it evaluates the resulting string.
	252	# For example, it changes -0.020 to -0.02.
	253	if { $n >= 0 } {
	254	set rawval [lindex $_values $n]
	255	} else {
	256	set rawval ""
	257	}
	258	_setCurrent $rawval
[67]	259
[1929]	260	after cancel [itcl::code $this _redraw]
	261	after idle [itcl::code $this _redraw]
	262	event generate $itk_component(hull) <<Value>>
[67]	263
[1929]	264	return $_current
[11]	265	}
	266	error "wrong # args: should be \"current ?newval?\""
	267	}
	268
	269	# ----------------------------------------------------------------------
	270	# USAGE: color <value>
	271	#
	272	# Clients use this to query the color associated with a <value>
	273	# along the dial.
	274	# ----------------------------------------------------------------------
	275	itcl::body Rappture::Radiodial::color {value} {
[1400]	276	_findLabel $value ;# make sure this label is recognized
[11]	277
	278	if {"" != $_spectrum} {
[1929]	279	foreach {min max} [_limits] break
	280	set frac [expr {double($value-$min)/($max-$min)}]
	281	set color [$_spectrum get $frac]
[11]	282	} else {
[1929]	283	if {$value == $_current} {
	284	set color $_activecolor
	285	} else {
	286	set color $itk_option(-linecolor)
	287	}
[11]	288	}
	289	return $color
	290	}
	291
	292	# ----------------------------------------------------------------------
[413]	293	# USAGE: _setCurrent <value>
	294	#
	295	# Called automatically whenever the widget changes size to redraw
	296	# all elements within it.
	297	# ----------------------------------------------------------------------
	298	itcl::body Rappture::Radiodial::_setCurrent {value} {
	299	set _current $value
	300	if {"" != $_variable} {
[1929]	301	upvar #0 $_variable var
	302	if {[info exists _val2label($value)]} {
	303	set var [lindex $_val2label($value) 0]
	304	} else {
	305	set var $value
	306	}
[413]	307	}
	308	}
	309
	310	# ----------------------------------------------------------------------
[11]	311	# USAGE: _redraw
	312	#
	313	# Called automatically whenever the widget changes size to redraw
	314	# all elements within it.
	315	# ----------------------------------------------------------------------
	316	itcl::body Rappture::Radiodial::_redraw {} {
	317	set c $itk_component(dial)
	318	$c delete all
	319
[428]	320	set fg $itk_option(-foreground)
	321
[11]	322	set w [winfo width $c]
	323	set h [winfo height $c]
[428]	324	set p [winfo pixels $c $itk_option(-padding)]
	325	set t [expr {$itk_option(-thickness)+1}]
	326	set y1 [expr {$h-1}]
[11]	327
[428]	328	if {"" != $_knob} {
[1929]	329	set kw [image width $_knob]
	330	set kh [image height $_knob]
[428]	331
[1929]	332	switch -- $itk_option(-knobposition) {
	333	n@top - nw@top - ne@top {
	334	set extra [expr {$t-$kh}]
	335	if {$extra < 0} {set extra 0}
	336	set y1 [expr {$h-$extra-1}]
	337	}
	338	n@middle - nw@middle - ne@middle {
	339	set extra [expr {int(ceil($kh-0.5*$t))}]
	340	if {$extra < 0} {set extra 0}
	341	set y1 [expr {$h-$extra-1}]
	342	}
	343	n@bottom - nw@bottom - ne@bottom {
	344	set y1 [expr {$h-$kh-1}]
	345	}
[428]	346
[1929]	347	e@top - w@top - center@top -
	348	e@bottom - w@bottom - center@bottom {
	349	set extra [expr {int(ceil(0.5*$kh))}]
	350	set y1 [expr {$h-$extra-1}]
	351	}
	352	e@middle - w@middle - center@middle {
	353	set extra [expr {int(ceil(0.5*($kh-$t)))}]
	354	if {$extra < 0} {set extra 0}
	355	set y1 [expr {$h-$extra-1}]
	356	}
[428]	357
[1929]	358	s@top - sw@top - se@top -
	359	s@middle - sw@middle - se@middle -
	360	s@bottom - sw@bottom - se@bottom {
	361	set y1 [expr {$h-2}]
	362	}
	363	}
[428]	364	}
	365	set y0 [expr {$y1-$t}]
	366	set x0 [expr {$p+1}]
	367	set x1 [expr {$w-$_vwidth-$p-4}]
	368	foreach {min max} [_limits] break
	369
[11]	370	# draw the background rectangle
	371	$c create rectangle $x0 $y0 $x1 $y1 \
[1929]	372	-outline $itk_option(-dialoutlinecolor) \
	373	-fill $itk_option(-dialfillcolor)
[11]	374
[428]	375	# draw the optional progress bar, from start to current
	376	if {"" != $itk_option(-dialprogresscolor)
[1929]	377	&& [llength $_values] > 0 && "" != $_current} {
	378	if {$max != $min} {
	379	set frac [expr {double($_current-$min)/($max-$min)}]
	380	} else {
	381	set frac 0.
	382	}
	383	set xx1 [expr {$frac*($x1-$x0) + $x0}]
	384	$c create rectangle [expr {$x0+1}] [expr {$y0+3}] $xx1 [expr {$y1-2}] \
	385	-outline "" -fill $itk_option(-dialprogresscolor)
[428]	386	}
	387
[11]	388	# draw lines for all values
	389	if {$max > $min} {
[1929]	390	foreach v $_values {
	391	set frac [expr {double($v-$min)/($max-$min)}]
	392	if {"" != $_spectrum} {
	393	set color [$_spectrum get $frac]
	394	} else {
	395	if {$v == $_current} {
	396	set color $_activecolor
	397	} else {
	398	set color $itk_option(-linecolor)
	399	}
	400	}
	401	set thick [expr {($v == $_current) ? 3 : 1}]
[11]	402
[1929]	403	if {"" != $color} {
	404	set x [expr {$frac*($x1-$x0) + $x0}]
	405	$c create line $x [expr {$y0+1}] $x $y1 \
	406	-fill $color -width $thick
	407	}
	408	}
[11]	409
[1929]	410	if {"" != $_current} {
	411	set x [expr {double($_current-$min)/($max-$min)*($x1-$x0) + $x0}]
	412	regexp {([nsew]+\|center)@} $itk_option(-knobposition) match anchor
	413	switch -glob -- $itk_option(-knobposition) {
	414	*@top { set kpos $y0 }
	415	@middle { set kpos [expr {int(ceil(0.5($y1+$y0)))}] }
	416	*@bottom { set kpos $y1 }
	417	}
	418	$c create image $x $kpos -anchor $anchor -image $_knob
	419	}
[11]	420	}
	421
	422	# if the -valuewidth is > 0, then make room for the value
	423	set vw $itk_option(-valuewidth)
	424	if {$vw > 0 && "" != $_current} {
[1929]	425	set str [lindex $_val2label($_current) 0]
	426	if {[string length $str] >= $vw} {
	427	set str "[string range $str 0 [expr {$vw-3}]]..."
	428	}
[11]	429
[1929]	430	set dy [expr {([font metrics $itk_option(-font) -linespace]
	431	- [font metrics $itk_option(-font) -ascent])/2}]
[11]	432
[1929]	433	set id [$c create text [expr {$x1+4}] [expr {($y1+$y0)/2+$dy}] \
	434	-anchor w -text $str -font $itk_option(-font) -foreground $fg]
	435	foreach {x0 y0 x1 y1} [$c bbox $id] break
	436	set x0 [expr {$x0 + 10}]
[11]	437
[1929]	438	# set up a tooltip so you can mouse over truncated values
	439	Rappture::Tooltip::text $c [lindex $_val2label($_current) 0]
	440	$c bind $id <Enter> \
	441	[list ::Rappture::Tooltip::tooltip pending %W +$x0,$y1]
	442	$c bind $id <Leave> \
	443	[list ::Rappture::Tooltip::tooltip cancel]
	444	$c bind $id <ButtonPress> \
	445	[list ::Rappture::Tooltip::tooltip cancel]
	446	$c bind $id <KeyPress> \
	447	[list ::Rappture::Tooltip::tooltip cancel]
[11]	448	}
	449	}
	450
	451	# ----------------------------------------------------------------------
	452	# USAGE: _click <x> <y>
	453	#
	454	# Called automatically whenever the user clicks or drags on the widget
	455	# to select a value. Moves the current value to the one nearest the
	456	# click point. If the value actually changes, it generates a <<Value>>
	457	# event to notify clients.
	458	# ----------------------------------------------------------------------
	459	itcl::body Rappture::Radiodial::_click {x y} {
	460	set c $itk_component(dial)
	461	set w [winfo width $c]
	462	set h [winfo height $c]
	463	set x0 1
	464	set x1 [expr {$w-$_vwidth-4}]
	465
	466	focus $itk_component(hull)
	467
	468	# draw lines for all values
	469	foreach {min max} [_limits] break
	470	if {$max > $min && $x >= $x0 && $x <= $x1} {
[1929]	471	set dmin $w
	472	set xnearest 0
	473	set vnearest ""
	474	foreach v $_values {
	475	set xv [expr {double($v-$min)/($max-$min)*($x1-$x0) + $x0}]
	476	if {abs($xv-$x) < $dmin} {
	477	set dmin [expr {abs($xv-$x)}]
	478	set xnearest $xv
	479	set vnearest $v
	480	}
	481	}
[11]	482
[1929]	483	if {$vnearest != $_current} {
	484	_setCurrent $vnearest
	485	_redraw
[11]	486
[1929]	487	event generate $itk_component(hull) <<Value>>
[3186]	488	_doInteract
[1929]	489	}
[11]	490	}
	491	}
	492
	493	# ----------------------------------------------------------------------
	494	# USAGE: _navigate <offset>
	495	#
	496	# Called automatically whenever the user presses left/right keys
	497	# to nudge the current value left or right by some <offset>. If the
	498	# value actually changes, it generates a <<Value>> event to notify
	499	# clients.
	500	# ----------------------------------------------------------------------
	501	itcl::body Rappture::Radiodial::_navigate {offset} {
	502	set index [lsearch -exact $_values $_current]
	503	if {$index >= 0} {
[1929]	504	incr index $offset
	505	if {$index >= [llength $_values]} {
	506	set index [expr {[llength $_values]-1}]
	507	} elseif {$index < 0} {
	508	set index 0
	509	}
[11]	510
[1929]	511	set newval [lindex $_values $index]
	512	if {$newval != $_current} {
	513	_setCurrent $newval
	514	_redraw
[11]	515
[1929]	516	event generate $itk_component(hull) <<Value>>
[3186]	517	_doInteract
[1929]	518	}
[11]	519	}
	520	}
	521
	522	# ----------------------------------------------------------------------
	523	# USAGE: _limits
	524	#
	525	# Used internally to compute the overall min/max limits for the
	526	# radio dial. Returns {min max}, representing the end values for
	527	# the scale.
	528	# ----------------------------------------------------------------------
	529	itcl::body Rappture::Radiodial::_limits {} {
	530	if {[llength $_values] == 0} {
[1929]	531	set min 0
	532	set max 0
[11]	533	} else {
[1929]	534	set min [lindex $_values 0]
	535	set max $min
	536	foreach v [lrange $_values 1 end] {
	537	if {$v < $min} { set min $v }
	538	if {$v > $max} { set max $v }
	539	}
	540	set del [expr {$max-$min}]
	541	set min [expr {$min-$itk_option(-valuepadding)*$del}]
	542	set max [expr {$max+$itk_option(-valuepadding)*$del}]
[11]	543	}
	544
	545	if {"" != $itk_option(-min)} {
[1929]	546	set min $itk_option(-min)
[11]	547	}
	548	if {"" != $itk_option(-max)} {
[1929]	549	set max $itk_option(-max)
[11]	550	}
	551	return [list $min $max]
	552	}
	553
	554	# ----------------------------------------------------------------------
[1400]	555	# USAGE: _findLabel <string>
	556	#
	557	# Used internally to search for the given <string> label among the
	558	# known values. Returns an index into the _values list, or throws
	559	# an error if the string is not recognized. Given the null string,
	560	# it returns -1, indicating that the value is not in _values, but
	561	# it is valid.
	562	# ----------------------------------------------------------------------
	563	itcl::body Rappture::Radiodial::_findLabel {str} {
	564	if {"" == $str} {
	565	return -1
	566	}
	567	for {set nv 0} {$nv < [llength $_values]} {incr nv} {
	568	set v [lindex $_values $nv]
	569	if {[lsearch -exact $_val2label($v) $str] >= 0} {
	570	return $nv
	571	}
	572	}
[3024]	573
	574	# didn't match -- build a return string of possible values
	575	set labels ""
	576	foreach vlist $_values {
	577	foreach v $vlist {
	578	lappend labels "\"$_val2label($v)\""
	579	}
	580	}
	581	error "bad value \"$str\": should be one of [join $labels ,]"
[1400]	582	}
	583
	584	# ----------------------------------------------------------------------
[11]	585	# USAGE: _fixSize
	586	#
	587	# Used internally to compute the overall size of the widget based
	588	# on the -thickness and -length options.
	589	# ----------------------------------------------------------------------
	590	itcl::body Rappture::Radiodial::_fixSize {} {
	591	set h [winfo pixels $itk_component(hull) $itk_option(-thickness)]
	592
[428]	593	if {"" != $_knob} {
[1929]	594	set kh [image height $_knob]
[428]	595
[1929]	596	switch -- $itk_option(-knobposition) {
	597	n@top - nw@top - ne@top -
	598	s@bottom - sw@bottom - se@bottom {
	599	if {$kh > $h} { set h $kh }
	600	}
	601	n@middle - nw@middle - ne@middle -
	602	s@middle - sw@middle - se@middle {
	603	set h [expr {int(ceil(0.5*$h + $kh))}]
	604	}
	605	n@bottom - nw@bottom - ne@bottom -
	606	s@top - sw@top - se@top {
	607	set h [expr {$h + $kh}]
	608	}
	609	e@middle - w@middle - center@middle {
	610	set h [expr {(($h > $kh) ? $h : $kh) + 1}]
	611	}
	612	n@middle - ne@middle - nw@middle -
	613	s@middle - se@middle - sw@middle {
	614	set extra [expr {int(ceil($kh-0.5*$h))}]
	615	if {$extra < 0} { set extra 0 }
	616	set h [expr {$h+$extra}]
	617	}
	618	}
[428]	619	}
	620	incr h 1
	621
[11]	622	set w [winfo pixels $itk_component(hull) $itk_option(-length)]
	623
	624	# if the -valuewidth is > 0, then make room for the value
	625	if {$itk_option(-valuewidth) > 0} {
[1929]	626	set charw [font measure $itk_option(-font) "n"]
	627	set _vwidth [expr {$itk_option(-valuewidth)*$charw}]
	628	set w [expr {$w+$_vwidth+4}]
[11]	629	} else {
[1929]	630	set _vwidth 0
[11]	631	}
	632
	633	$itk_component(dial) configure -width $w -height $h
	634	}
	635
	636	# ----------------------------------------------------------------------
[413]	637	# USAGE: _fixValue ?<name1> <name2> <op>?
	638	#
	639	# Invoked automatically whenever the -variable associated with this
	640	# widget is modified. Copies the value to the current settings for
	641	# the widget.
	642	# ----------------------------------------------------------------------
	643	itcl::body Rappture::Radiodial::_fixValue {args} {
	644	if {"" == $itk_option(-variable)} {
[1929]	645	return
[413]	646	}
	647	upvar #0 $itk_option(-variable) var
	648
	649	set newval $var
[1400]	650	set n [_findLabel $newval]
[1407]	651	set rawval [expr {($n >= 0) ? [lindex $_values $n] : ""}]
	652	set _current $rawval ;# set current directly, so we don't trigger again
[413]	653
	654	after cancel [itcl::code $this _redraw]
	655	after idle [itcl::code $this _redraw]
	656	event generate $itk_component(hull) <<Value>>
	657	}
	658
	659	# ----------------------------------------------------------------------
[3186]	660	# USAGE: _doInteract
	661	#
	662	# Used internally to call the -interactcommand code whenever the user
	663	# changes the value of the widget. This is different from the <<Value>>
	664	# event, which gets invoked whenever the value changes for any reason,
	665	# including programmatic changes. If there is no command code, then
	666	# this does nothing.
	667	# ----------------------------------------------------------------------
	668	itcl::body Rappture::Radiodial::_doInteract {} {
	669	if {[string length $itk_option(-interactcommand)] > 0} {
	670	uplevel #0 $itk_option(-interactcommand)
	671	}
	672	}
	673
	674	# ----------------------------------------------------------------------
[11]	675	# CONFIGURE: -thickness
	676	# ----------------------------------------------------------------------
	677	itcl::configbody Rappture::Radiodial::thickness {
	678	_fixSize
	679	}
	680
	681	# ----------------------------------------------------------------------
	682	# CONFIGURE: -length
	683	# ----------------------------------------------------------------------
	684	itcl::configbody Rappture::Radiodial::length {
	685	_fixSize
	686	}
	687
	688	# ----------------------------------------------------------------------
	689	# CONFIGURE: -font
	690	# ----------------------------------------------------------------------
	691	itcl::configbody Rappture::Radiodial::font {
	692	_fixSize
	693	}
	694
	695	# ----------------------------------------------------------------------
	696	# CONFIGURE: -valuewidth
	697	# ----------------------------------------------------------------------
	698	itcl::configbody Rappture::Radiodial::valuewidth {
	699	if {![string is integer $itk_option(-valuewidth)]} {
[1929]	700	error "bad value \"$itk_option(-valuewidth)\": should be integer"
[11]	701	}
[413]	702	_fixSize
[11]	703	after cancel [itcl::code $this _redraw]
	704	after idle [itcl::code $this _redraw]
	705	}
	706
	707	# ----------------------------------------------------------------------
[428]	708	# CONFIGURE: -foreground
	709	# ----------------------------------------------------------------------
	710	itcl::configbody Rappture::Radiodial::foreground {
	711	after cancel [itcl::code $this _redraw]
	712	after idle [itcl::code $this _redraw]
	713	}
	714
	715	# ----------------------------------------------------------------------
[11]	716	# CONFIGURE: -dialoutlinecolor
	717	# ----------------------------------------------------------------------
	718	itcl::configbody Rappture::Radiodial::dialoutlinecolor {
	719	after cancel [itcl::code $this _redraw]
	720	after idle [itcl::code $this _redraw]
	721	}
	722
	723	# ----------------------------------------------------------------------
	724	# CONFIGURE: -dialfillcolor
	725	# ----------------------------------------------------------------------
	726	itcl::configbody Rappture::Radiodial::dialfillcolor {
	727	after cancel [itcl::code $this _redraw]
	728	after idle [itcl::code $this _redraw]
	729	}
	730
	731	# ----------------------------------------------------------------------
[428]	732	# CONFIGURE: -dialprogresscolor
	733	# ----------------------------------------------------------------------
	734	itcl::configbody Rappture::Radiodial::dialprogresscolor {
	735	after cancel [itcl::code $this _redraw]
	736	after idle [itcl::code $this _redraw]
	737	}
	738
	739	# ----------------------------------------------------------------------
[11]	740	# CONFIGURE: -linecolor
	741	# ----------------------------------------------------------------------
	742	itcl::configbody Rappture::Radiodial::linecolor {
	743	after cancel [itcl::code $this _redraw]
	744	after idle [itcl::code $this _redraw]
	745	}
	746
	747	# ----------------------------------------------------------------------
	748	# CONFIGURE: -activelinecolor
	749	# ----------------------------------------------------------------------
	750	itcl::configbody Rappture::Radiodial::activelinecolor {
	751	set val $itk_option(-activelinecolor)
	752	if {[catch {$val isa ::Rappture::Spectrum} valid] == 0 && $valid} {
[1929]	753	set _spectrum $val
	754	set _activecolor ""
[11]	755	} elseif {[catch {winfo rgb $itk_component(hull) $val}] == 0} {
[1929]	756	set _spectrum ""
	757	set _activecolor $val
[428]	758	} elseif {"" != $val} {
[1929]	759	error "bad value \"$val\": should be Spectrum object or color"
[11]	760	}
	761	after cancel [itcl::code $this _redraw]
	762	after idle [itcl::code $this _redraw]
	763	}
[413]	764
	765	# ----------------------------------------------------------------------
[428]	766	# CONFIGURE: -knobimage
	767	# ----------------------------------------------------------------------
	768	itcl::configbody Rappture::Radiodial::knobimage {
	769	if {[regexp {^image[0-9]+$} $itk_option(-knobimage)]} {
[1929]	770	set _knob $itk_option(-knobimage)
[428]	771	} elseif {"" != $itk_option(-knobimage)} {
[1929]	772	set _knob [Rappture::icon $itk_option(-knobimage)]
[428]	773	} else {
[1929]	774	set _knob ""
[428]	775	}
	776	_fixSize
	777
	778	after cancel [itcl::code $this _redraw]
	779	after idle [itcl::code $this _redraw]
	780	}
	781
	782	# ----------------------------------------------------------------------
	783	# CONFIGURE: -knobposition
	784	# ----------------------------------------------------------------------
	785	itcl::configbody Rappture::Radiodial::knobposition {
	786	if {![regexp {^([nsew]+\|center)@(top\|middle\|bottom)$} $itk_option(-knobposition)]} {
[1929]	787	error "bad value \"$itk_option(-knobposition)\": should be anchor@top\|middle\|bottom"
[428]	788	}
	789	_fixSize
	790
	791	after cancel [itcl::code $this _redraw]
	792	after idle [itcl::code $this _redraw]
	793	}
	794
	795	# ----------------------------------------------------------------------
	796	# CONFIGURE: -padding
	797	# This adds padding on left/right side of dial background.
	798	# ----------------------------------------------------------------------
	799	itcl::configbody Rappture::Radiodial::padding {
	800	if {[catch {winfo pixels $itk_component(hull) $itk_option(-padding)}]} {
[1929]	801	error "bad value \"$itk_option(-padding)\": should be size in pixels"
[428]	802	}
	803	}
	804
	805	# ----------------------------------------------------------------------
	806	# CONFIGURE: -valuepadding
	807	# This shifts min/max limits in by a fraction of the overall size.
	808	# ----------------------------------------------------------------------
	809	itcl::configbody Rappture::Radiodial::valuepadding {
	810	if {![string is double $itk_option(-valuepadding)]
[1929]	811	\|\| $itk_option(-valuepadding) < 0} {
	812	error "bad value \"$itk_option(-valuepadding)\": should be >= 0.0"
[428]	813	}
	814	}
	815
	816	# ----------------------------------------------------------------------
[413]	817	# CONFIGURE: -variable
	818	# ----------------------------------------------------------------------
	819	itcl::configbody Rappture::Radiodial::variable {
	820	if {"" != $_variable} {
[1929]	821	upvar #0 $_variable var
	822	trace remove variable var write [itcl::code $this _fixValue]
[413]	823	}
	824
	825	set _variable $itk_option(-variable)
	826
	827	if {"" != $_variable} {
[1929]	828	upvar #0 $_variable var
	829	trace add variable var write [itcl::code $this _fixValue]
[413]	830
[1929]	831	# sync to the current value of this variable
	832	if {[info exists var]} {
	833	_fixValue
	834	}
[413]	835	}
	836	}

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

Download in other formats: