Context Navigation

source: trunk/gui/scripts/videodial.tcl @ 1926

Last change on this file since 1926 was 1926, checked in by dkearney, 14 years ago
typo in videodial, adding demo for video dial code
File size: 40.2 KB

Line
1	# ----------------------------------------------------------------------
2	# COMPONENT: Videodial - selector, like the dial on a flow
3	#
4	# This widget looks like the dial on an old-fashioned car flow.
5	# It draws a series of values along an axis, and allows a selector
6	# to move back and forth to select the values.
7	# ======================================================================
8	# AUTHOR: Michael McLennan, Purdue University
9	# Copyright (c) 2004-2005 Purdue Research Foundation
10	#
11	# See the file "license.terms" for information on usage and
12	# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13	# ======================================================================
14	package require Itk
15	package require BLT
16
17	option add *Videodial.dialProgressColor #6666cc widgetDefault
18	option add *Videodial.thickness 10 widgetDefault
19	option add *Videodial.length 2i widgetDefault
20	option add *Videodial.knobImage knob widgetDefault
21	option add *Videodial.knobPosition n@middle widgetDefault
22	option add *Videodial.dialOutlineColor black widgetDefault
23	option add *Videodial.dialFillColor white widgetDefault
24	option add *Videodial.lineColor gray widgetDefault
25	option add *Videodial.activeLineColor black widgetDefault
26	option add *Videodial.padding 0 widgetDefault
27	option add *Videodial.valueWidth 10 widgetDefault
28	option add *Videodial.valuePadding 0.1 widgetDefault
29	option add *Videodial.foreground black widgetDefault
30	option add *Videodial.font \
31	--helvetica-medium-r-normal--12-* widgetDefault
32
33	itcl::class Rappture::Videodial {
34	inherit itk::Widget
35
36	itk_option define -min min Min ""
37	itk_option define -max max Max ""
38	itk_option define -variable variable Variable ""
39	itk_option define -offset offset Offset 1
40
41	itk_option define -thickness thickness Thickness 0
42	itk_option define -length length Length 0
43	itk_option define -padding padding Padding 0
44
45	itk_option define -foreground foreground Foreground "black"
46	itk_option define -dialoutlinecolor dialOutlineColor Color "black"
47	itk_option define -dialfillcolor dialFillColor Color "white"
48	itk_option define -dialprogresscolor dialProgressColor Color ""
49	itk_option define -linecolor lineColor Color "black"
50	itk_option define -activelinecolor activeLineColor Color "black"
51	itk_option define -knobimage knobImage KnobImage ""
52	itk_option define -knobposition knobPosition KnobPosition ""
53
54	itk_option define -font font Font ""
55	itk_option define -valuewidth valueWidth ValueWidth 0
56	itk_option define -valuepadding valuePadding ValuePadding 0
57
58
59	constructor {args} { # defined below }
60	destructor { # defined below }
61
62	public method current {value}
63	public method clear {}
64	public method color {value}
65	public method mark {type args}
66	public method bball {}
67
68	protected method _bindings {type args}
69	protected method _redraw {}
70	protected method _marker {tag action x y}
71	protected method _move {action x y}
72	protected method _knob {x y}
73	protected method _navigate {offset}
74	protected method _fixSize {}
75	protected method _fixValue {args}
76	protected method _fixOffsets {}
77
78	private method _current {value}
79	private method _see {item}
80	private method _draw_major_timeline {}
81	private method _draw_minor_timeline {}
82	private method _offsetx {x}
83	private method ms2rel {value}
84	private method rel2ms {value}
85	private common _click ;# x,y point where user clicked
86	private common _marks ;# list of marks
87	private variable _values "" ;# list of all values on the dial
88	private variable _val2label ;# maps value => string label(s)
89	private variable _current 0 ;# current value (where pointer is)
90	private variable _variable "" ;# variable associated with -variable
91	private variable _knob "" ;# image for knob
92	private variable _spectrum "" ;# width allocated for values
93	private variable _activecolor "" ;# width allocated for values
94	private variable _vwidth 0 ;# width allocated for values
95	private variable _offset_pos 1 ;#
96	private variable _offset_neg -1 ;#
97	private variable _imspace 10 ;# pixels between intermediate marks
98	private variable _pmcnt 0 ;# particle marker count
99	public variable min 0.0
100	public variable max 1.0
101	}
102
103	itk::usual Videodial {
104	keep -foreground -cursor -font
105	}
106
107	# ----------------------------------------------------------------------
108	# CONSTRUCTOR
109	# ----------------------------------------------------------------------
110	itcl::body Rappture::Videodial::constructor {args} {
111
112	# ----------------------------------------------------------------------
113	# controls for the major timeline.
114	# ----------------------------------------------------------------------
115	itk_component add majordial {
116	canvas $itk_interior.majordial
117	}
118
119	bind $itk_component(majordial) <Configure> [itcl::code $this _draw_major_timeline]
120
121	bind $itk_component(majordial) <ButtonPress-1> [itcl::code $this _knob %x %y]
122	bind $itk_component(majordial) <B1-Motion> [itcl::code $this _knob %x %y]
123	bind $itk_component(majordial) <ButtonRelease-1> [itcl::code $this _knob %x %y]
124
125	#bind $itk_component(hull) <KeyPress-Left> [itcl::code $this _navigate $_offset_neg]
126	#bind $itk_component(hull) <KeyPress-Right> [itcl::code $this _navigate $_offset_pos]
127
128	$itk_component(majordial) bind "knob" <Enter> \
129	[list $itk_component(majordial) configure -cursor sb_h_double_arrow]
130	$itk_component(majordial) bind "knob" <Leave> \
131	[list $itk_component(majordial) configure -cursor ""]
132
133	# ----------------------------------------------------------------------
134	# controls for the major timeline.
135	# ----------------------------------------------------------------------
136	itk_component add minordial {
137	canvas $itk_interior.minordial -background blue
138	}
139
140
141	bind $itk_component(minordial) <Configure> [itcl::code $this _draw_minor_timeline]
142
143	bind $itk_component(minordial) <ButtonPress-1> [itcl::code $this _move click %x %y]
144	bind $itk_component(minordial) <B1-Motion> [itcl::code $this _move drag %x %y]
145	bind $itk_component(minordial) <ButtonRelease-1> [itcl::code $this _move release %x %y]
146
147	# ----------------------------------------------------------------------
148	# place controls in widget.
149	# ----------------------------------------------------------------------
150
151	blt::table $itk_interior \
152	0,0 $itk_component(majordial) -fill x \
153	1,0 $itk_component(minordial) -fill x
154
155	blt::table configure $itk_interior c* -resize both
156	blt::table configure $itk_interior r0 -resize both -pady 1
157	blt::table configure $itk_interior r1 -resize none -pady 1
158
159
160	eval itk_initialize $args
161
162	$itk_component(majordial) configure -background red
163	$itk_component(minordial) configure -background blue
164
165	_fixSize
166	_fixOffsets
167	}
168
169	# ----------------------------------------------------------------------
170	# DESTRUCTOR
171	# ----------------------------------------------------------------------
172	itcl::body Rappture::Videodial::destructor {} {
173	configure -variable "" ;# remove variable trace
174	after cancel [itcl::code $this _redraw]
175	}
176
177	# ----------------------------------------------------------------------
178	# USAGE: current ?<value>?
179	#
180	# Clients use this to set a new value for the dial. Values are always
181	# sorted in order along the dial. If the value is not specified,
182	# then it is created automatically based on the number of elements
183	# on the dial.
184	# ----------------------------------------------------------------------
185	itcl::body Rappture::Videodial::current {value} {
186	if {"" == $value} {
187	return
188	}
189	_current [ms2rel $value]
190	_see "frame[expr int($value)]"
191	event generate $itk_component(hull) <<Value>>
192	}
193
194	# ----------------------------------------------------------------------
195	# USAGE: _current ?<value>?
196	#
197	# Clients use this to set a new value for the dial. Values are always
198	# sorted in order along the dial. If the value is not specified,
199	# then it is created automatically based on the number of elements
200	# on the dial.
201	# ----------------------------------------------------------------------
202	itcl::body Rappture::Videodial::_current {relval} {
203	if { $relval < 0.0 } {
204	set relval 0.0
205	}
206	if { $relval > 1.0 } {
207	set relval 1.0
208	}
209	set _current $relval
210	after cancel [itcl::code $this _draw_major_timeline]
211	after idle [itcl::code $this _draw_major_timeline]
212	if { $_variable != "" } {
213	upvar #0 $_variable var
214	set var [rel2ms $_current]
215	}
216	}
217
218	# ----------------------------------------------------------------------
219	# USAGE: color <value>
220	#
221	# Clients use this to query the color associated with a <value>
222	# along the dial.
223	# ----------------------------------------------------------------------
224	itcl::body Rappture::Videodial::color {value} {
225	if {"" != $_spectrum} {
226	set frac [expr {double($value-$min)/($max-$min)}]
227	set color [$_spectrum get $frac]
228	} else {
229	if {$value == $_current} {
230	set color $_activecolor
231	} else {
232	set color $itk_option(-linecolor)
233	}
234	}
235	return $color
236	}
237
238	# ----------------------------------------------------------------------
239	# USAGE: _bindings <type> ?args?
240	#
241	# ----------------------------------------------------------------------
242	itcl::body Rappture::Videodial::_bindings {type args} {
243	switch -- $type {
244	"marker" {
245	set tag [lindex $args 0]
246	bind $itk_component(minordial) <ButtonPress-1> [itcl::code $this _marker $tag click %x %y]
247	bind $itk_component(minordial) <B1-Motion> [itcl::code $this _marker $tag drag %x %y]
248	bind $itk_component(minordial) <ButtonRelease-1> [itcl::code $this _marker $tag release %x %y]
249	}
250	"timeline" {
251	bind $itk_component(minordial) <ButtonPress-1> [itcl::code $this _move click %x %y]
252	bind $itk_component(minordial) <B1-Motion> [itcl::code $this _move drag %x %y]
253	bind $itk_component(minordial) <ButtonRelease-1> [itcl::code $this _move release %x %y]
254	}
255	}
256	}
257
258	# ----------------------------------------------------------------------
259	# USAGE: mark <type> ?[-xcoord\|-tag]? <where>
260	#
261	# Clients use this to add a mark to the timeline
262	# type can be any one of start, end
263	# where is interpreted based on the preceeding flag if available.
264	# in the default case, <where> is interpreted as a frame number
265	# or "current". if the -xcoord flag is provided, where is
266	# interpreted as the x coordinate of where to center the marker.
267	# -xcoord should only be used for temporary placement of a
268	# marker. when -xcoord is used, the marker is placed exactly at
269	# the provided x coordinate, and is not associated with any
270	# frame. It's purpose is mainly for <B1-Motion> events.
271	# ----------------------------------------------------------------------
272	itcl::body Rappture::Videodial::mark {type args} {
273
274	set c $itk_component(minordial)
275
276	set cx0 0
277	set cy0 0
278	set cx1 0
279	set cy1 0
280	foreach {cx0 cy0 cx1 cy1} [$c bbox "imbox"] break
281
282	# get coords of where to place the marker
283	set frx0 0
284	set fry0 0
285	set frx1 0
286	set fry1 0
287
288	set where ""
289	set largs [llength $args]
290	if {$largs == 1} {
291	set where [lindex $args 0]
292	if {[string compare "current" $where] == 0} {
293	set where [expr int([rel2ms ${_current}])]
294	} elseif {[string is integer $where] == 0} {
295	error "bad value \"$where\": <where> should be an integer value"
296	}
297	foreach {frx0 fry0 frx1 fry1} [$c coords "frame$where"] break
298	set where "frame$where"
299	} elseif {$largs == 2} {
300	set flag [lindex $args 0]
301	switch -- $flag {
302	"-xcoord" {
303	set frx0 [lindex $args 1]
304	# where is not set for the -xcoord flag
305	}
306	"-tag" {
307	set id [lindex $args 1]
308	foreach {frx0 fry0 frx1 fry1} [$c coords $id] break
309	# find the frame# tag to associate with the marker with
310	if {[regexp {frame[0-9]+} $id] == 0} {
311	foreach tags [$c gettags $id] {
312	if {"" != [set tmp [lsearch -inline -regexp $tags {frame[0-9]+}]]} {
313	set where $tmp
314	break
315	}
316	}
317	} else {
318	set where $id
319	}
320	}
321	default {
322	error "bad value \"$flag\": should be -xcoord or -tag"
323	}
324	}
325	if {[string is double $frx0] == 0} {
326	error "bad value \"$frx0\": <where> should be a double value"
327	}
328	} else {
329	error "wrong # args: should be \"mark <type> ?-xcoord? <where>\""
330	}
331
332	# place the marker
333
334	switch -glob -- $type {
335	"start" {
336	# add start marker
337
338	set smx0 $frx0 ;# start marker x0
339	set smy0 $cy0 ;# start marker y0
340
341	# polygon's outline adds a border to only one
342	# side of the object? so we have weird +1 in
343	# the triangle base in start marker
344
345	# marker stem is 3 pixels thick
346	set smx1 [expr {$smx0+1}] ;# triangle top x
347	set smy1 [expr {$smy0-10}] ;# triangle top y
348	set smx2 $smx1 ;# stem bottom right x
349	set smy2 [expr {$cy1+5}] ;# stem bottom right y
350	set smx3 [expr {$smx0-1}] ;# stem bottom left x
351	set smy3 $smy2 ;# stem bottom left y
352	set smx4 $smx3 ;# stem middle left x
353	set smy4 $smy0 ;# stem middle left y
354	set smx5 [expr {$smx0-10+1}] ;# triangle bottom left x
355	set smy5 $smy0 ;# triangle bottom left y
356
357	set tag $type
358	$c delete $tag
359	$c create polygon \
360	$smx1 $smy1 \
361	$smx2 $smy2 \
362	$smx3 $smy3 \
363	$smx4 $smy4 \
364	$smx5 $smy5 \
365	-outline black -fill black -tags $tag
366
367	$c bind $tag <Enter> [itcl::code $this _bindings marker $tag]
368	$c bind $tag <Leave> [itcl::code $this _bindings timeline]
369
370	if {[string compare "" $where] != 0} {
371	set _marks($type) $where
372	}
373	}
374	"end" {
375	# add end marker
376
377	set emx0 $frx0 ;# end marker x0
378	set emy0 $cy0 ;# end marker y0
379
380	set emx1 [expr {$emx0-1}] ;# triangle top x
381	set emy1 [expr {$emy0-10}] ;# triangle top y
382	set emx2 $emx1 ;# stem bottom left x
383	set emy2 [expr {$cy1+5}] ;# stem bottom left y
384	set emx3 [expr {$emx0+1}] ;# stem bottom right x
385	set emy3 $emy2 ;# stem bottom right y
386	set emx4 $emx3 ;# stem middle right x
387	set emy4 $emy0 ;# stem middle right y
388	set emx5 [expr {$emx0+10-1}] ;# triangle bottom right x
389	set emy5 $emy0 ;# triangle bottom right y
390
391	set tag $type
392	$c delete $tag
393	$c create polygon \
394	$emx1 $emy1 \
395	$emx2 $emy2 \
396	$emx3 $emy3 \
397	$emx4 $emy4 \
398	$emx5 $emy5 \
399	-outline black -fill black -tags $tag
400
401	$c bind $tag <Enter> [itcl::code $this _bindings marker $tag]
402	$c bind $tag <Leave> [itcl::code $this _bindings timeline]
403
404	if {[string compare "" $where] != 0} {
405	set _marks($type) $where
406	}
407	}
408	"particle*" {
409	set radius 3
410	set pmx0 $frx0
411	set pmy0 [expr {$cy1+5}]
412	set coords [list [expr $pmx0-$radius] [expr $pmy0-$radius] \
413	[expr $pmx0+$radius] [expr $pmy0+$radius]]
414
415	set tag $type
416	$c create oval $coords \
417	-fill green \
418	-outline black \
419	-width 1 \
420	-tags $tag
421
422	#$c bind $tag <Enter> [itcl::code $this _bindings marker $tag]
423	#$c bind $tag <Leave> [itcl::code $this _bindings timeline]
424
425	if {[string compare "" $where] != 0} {
426	set _marks($type) $where
427	}
428
429	}
430	"arrow" {
431	set radius 3
432	set amx0 $frx0
433	set amy0 [expr {$cy1+15}]
434	set coords [list [expr $amx0-$radius] [expr $amy0-$radius] \
435	[expr $amx0+$radius] [expr $amy0+$radius]]
436
437	set tag $type
438	$c create line $coords \
439	-fill red \
440	-width 3 \
441	-tags $tag
442
443	#$c bind $tag <Enter> [itcl::code $this _bindings marker $tag]
444	#$c bind $tag <Leave> [itcl::code $this _bindings timeline]
445
446	if {[string compare "" $where] != 0} {
447	set _marks($type) $where
448	}
449
450	}
451	default {
452	error "bad value \"$type\": should be \"start\" or \"end\""
453	}
454	}
455	return
456	}
457
458	# ----------------------------------------------------------------------
459	# USAGE: _draw_major_timeline
460	#
461	# ----------------------------------------------------------------------
462	itcl::body Rappture::Videodial::_draw_major_timeline {} {
463	set c $itk_component(majordial)
464	$c delete all
465
466	set fg $itk_option(-foreground)
467
468	set w [winfo width $c]
469	set h [winfo height $c]
470	set p [winfo pixels $c $itk_option(-padding)]
471	set t [expr {$itk_option(-thickness)+1}]
472	set ay1 [expr {$h-5}]
473
474	if {"" != $_knob} {
475	set kw [image width $_knob]
476	set kh [image height $_knob]
477
478	# anchor refers to where on knob
479	# top/middle/bottom refers to where on the dial
480	# leave room for the bottom of the knob if needed
481	switch -- $itk_option(-knobposition) {
482	n@top - nw@top - ne@top {
483	set extra [expr {$t-$kh}]
484	if {$extra < 0} {set extra 0}
485	set ay1 [expr {$ay1-$extra}]
486	}
487	n@middle - nw@middle - ne@middle {
488	set extra [expr {int(ceil($kh-0.5*$t))}]
489	if {$extra < 0} {set extra 0}
490	set ay1 [expr {$ay1-$extra}]
491	}
492	n@bottom - nw@bottom - ne@bottom {
493	set ay1 [expr {$ay1-$kh}]
494	}
495
496	e@top - w@top - center@top -
497	e@bottom - w@bottom - center@bottom {
498	set extra [expr {int(ceil(0.5*$kh))}]
499	set ay1 [expr {$ay1-$extra}]
500	}
501	e@middle - w@middle - center@middle {
502	set extra [expr {int(ceil(0.5*($kh-$t)))}]
503	if {$extra < 0} {set extra 0}
504	set ay1 [expr {$ay1-$extra}]
505	}
506
507	s@top - sw@top - se@top -
508	s@middle - sw@middle - se@middle -
509	s@bottom - sw@bottom - se@bottom {
510	set ay1 [expr {$ay1-1}]
511	}
512	}
513	}
514	set ay0 [expr {$ay1-$t}]
515	set ax0 [expr {$p+1}]
516	set ax1 [expr {$w-$_vwidth-$p-4}]
517
518
519	# draw the background rectangle for the major time line
520	$c create rectangle $ax0 $ay0 $ax1 $ay1 \
521	-outline $itk_option(-dialoutlinecolor) \
522	-fill $itk_option(-dialfillcolor)
523
524	# draw the optional progress bar for the major time line,
525	# from start to current
526	if {"" != $itk_option(-dialprogresscolor) } {
527	set xx1 [expr {$_current*($ax1-$ax0) + $ax0}]
528	$c create rectangle [expr {$ax0+1}] [expr {$ay0+3}] $xx1 [expr {$ay1-2}] \
529	-outline "" -fill $itk_option(-dialprogresscolor)
530	}
531
532	regexp {([nsew]+\|center)@} $itk_option(-knobposition) match anchor
533	switch -glob -- $itk_option(-knobposition) {
534	*@top { set kpos $ay0 }
535	@middle { set kpos [expr {int(ceil(0.5($ay1+$ay0)))}] }
536	*@bottom { set kpos $ay1 }
537	}
538
539	set x [expr {$_current*($ax1-$ax0) + $ax0}]
540
541	set color $_activecolor
542	set thick 3
543	if {"" != $color} {
544	$c create line $x [expr {$ay0+1}] $x $ay1 -fill $color -width $thick
545	}
546
547	$c create image $x $kpos -anchor $anchor -image $_knob -tags "knob"
548	}
549
550	# ----------------------------------------------------------------------
551	# USAGE: bball
552	# debug function to print out the bounding box information for
553	# minor dial
554	#
555	# ----------------------------------------------------------------------
556	itcl::body Rappture::Videodial::bball {} {
557	set c $itk_component(minordial)
558	foreach item [$c find all] {
559	foreach {x0 y0 x1 y1} [$c bbox $item] break
560	if {! [info exists y1]} continue
561	puts stderr "$item : [expr $y1-$y0]: $y0 $y1"
562	lappend q $y0 $y1
563	}
564	set q [lsort -real $q]
565	puts stderr "q [lindex $q 0] [lindex $q end]"
566	puts stderr "height [winfo height $c]"
567	puts stderr "bbox all [$c bbox all]"
568	puts stderr "parent height [winfo height [winfo parent $c]]"
569	}
570
571	# ----------------------------------------------------------------------
572	# USAGE: _draw_minor_timeline
573	#
574	# ----------------------------------------------------------------------
575	itcl::body Rappture::Videodial::_draw_minor_timeline {} {
576	set c $itk_component(minordial)
577	$c delete all
578
579	set fg $itk_option(-foreground)
580
581	set w [winfo width $c]
582	set h [winfo height $c]
583	set p [winfo pixels $c $itk_option(-padding)]
584	set t [expr {$itk_option(-thickness)+1}]
585	set cy1 [expr {$h-5}]
586	set cy0 [expr {$cy1-$t}]
587	set cx0 [expr {$p+1}]
588	set cx1 [expr {$w-$_vwidth-$p-4}]
589
590
591	# draw the background rectangle for the minor time line
592	$c create rectangle $cx0 $cy0 $cx1 $cy1 \
593	-outline $itk_option(-dialoutlinecolor) \
594	-fill $itk_option(-dialfillcolor) \
595	-tags "imbox"
596
597	# add intermediate marks between markers
598	set imw 1.0 ;# intermediate mark width
599
600	set imsh [expr {$t/3.0}] ;# intermediate mark short height
601	set imsy0 [expr {$cy0+(($t-$imsh)/2.0)}] ;# precalc'd imark short y0 coord
602	set imsy1 [expr {$imsy0+$imsh}] ;# precalc'd imark short y1 coord
603
604	set imlh [expr {$t*2.0/3.0}] ;# intermediate mark long height
605	set imly0 [expr {$cy0+(($t-$imlh)/2.0)}] ;# precalc'd imark long y0 coord
606	set imly1 [expr {$imly0+$imlh}] ;# precalc'd imark long y1 coord
607
608	set imty [expr {$cy0-5}] ;# height of marker value
609
610	set bw 70 ;# bracketwidth, number of imarks
611	set _imspace 10 ;# space between imarks
612
613
614	for {set i [expr {int($min)}]; set imx $cx0} {$i <= $max} {incr i; set imx [expr $imx+${_imspace}]} {
615	if {($i%5) == 0} {
616	# draw major tick
617	$c create line $imx $imly0 $imx $imly1 \
618	-fill red \
619	-width $imw \
620	-tags [list longmark-c imark-c "frame$i"]
621
622	$c create text $imx $imty -anchor center -text $i \
623	-font $itk_option(-font) -tags "frame$i"
624	} else {
625	# draw minor tick
626	$c create line $imx $imsy0 $imx $imsy1 \
627	-fill blue \
628	-width $imw \
629	-tags [list shortmark-c imark-c "frame$i"]
630	}
631	}
632
633	# add any marks that the user previously specified
634	foreach n [array names _marks] {
635	mark $n -tag $_marks($n)
636	}
637
638	foreach {cx0 cy0 cx1 cy1} [$c bbox "all"] break
639	$c coords "imbox" [list $cx0 $cy0 $cx1 $cy1]
640	$c configure \
641	-scrollregion [list $cx0 $cy0 $cx1 $cy1] \
642	-xscrollincrement 1p \
643	-yscrollincrement 1p
644	if 0 {
645	}
646
647	}
648
649
650	# ----------------------------------------------------------------------
651	# USAGE: _redraw
652	#
653	# Called automatically whenever the widget changes size to redraw
654	# all elements within it.
655	# ----------------------------------------------------------------------
656	itcl::body Rappture::Videodial::_redraw {} {
657	# _draw_major_timeline
658	# _draw_minor_timeline
659	}
660
661	# ----------------------------------------------------------------------
662	# USAGE: _knob <x> <y>
663	#
664	# Called automatically whenever the user clicks or drags on the widget
665	# to select a value. Moves the current value to the one nearest the
666	# click point. If the value actually changes, it generates a <<Value>>
667	# event to notify clients.
668	# ----------------------------------------------------------------------
669	itcl::body Rappture::Videodial::_knob {x y} {
670	set c $itk_component(majordial)
671	set w [winfo width $c]
672	set h [winfo height $c]
673	set x0 1
674	set x1 [expr {$w-$_vwidth-4}]
675	focus $itk_component(hull)
676	if {$x >= $x0 && $x <= $x1} {
677	current [rel2ms [expr double($x - $x0) / double($x1 - $x0)]]
678	}
679	}
680
681	# ----------------------------------------------------------------------
682	# USAGE: _offsetx <x>
683	#
684	# Calculate an x coordinate that has been offsetted by a scrolled canvas
685	# ----------------------------------------------------------------------
686	itcl::body Rappture::Videodial::_offsetx {x} {
687	set c $itk_component(minordial)
688	set w [lindex [$c cget -scrollregion] 2]
689	set x0 [lindex [$c xview] 0]
690	set offset [expr {$w*$x0}]
691	set x [expr {$x+$offset}]
692	return $x
693	}
694
695	# ----------------------------------------------------------------------
696	# USAGE: _marker <tag> click <x> <y>
697	# _marker <tag> drag <x> <y>
698	# _marker <tag> release <x> <y>
699	#
700	# Called automatically whenever the user clicks or drags on a marker
701	# widget. Moves the selected marker to the next nearest tick mark.
702	# ----------------------------------------------------------------------
703	itcl::body Rappture::Videodial::_marker {tag action x y} {
704	set c $itk_component(minordial)
705	set x [_offsetx $x]
706	switch $action {
707	"click" {
708	}
709	"drag" {
710	mark $tag -xcoord $x
711	# if we are too close to the edge, scroll the canvas.
712	# $c xview scroll $dist "unit"
713	}
714	"release" {
715	# on release, snap to the closest imark
716	foreach {junk y0 junk y1} [$c bbox "imark-c"] break
717	set id ""
718	foreach item [$c find enclosed [expr {$x-((${_imspace}+1)/2.0)}] $y0 \
719	[expr {$x+((${_imspace}+1)/2.0)}] $y1] {
720	set itemtags [$c gettags $item]
721	if {[lsearch -exact $itemtags "imark-c"] != -1} {
722	set id [lsearch -inline -regexp $itemtags {frame[0-9]}]
723	break
724	}
725	}
726	if {[string compare "" $id] == 0} {
727	# something went wrong
728	# we should have found an imark with
729	# an associated "frame#" tag to snap to
730	# bailout
731	error "could not find an intermediate mark to snap marker to"
732	}
733
734	mark $tag -tag $id
735
736	# take care of cases where the mouse leaves the marker's boundries
737	# before the button-1 has been released. we check if the last
738	# coord was within the bounds of the marker. if not, we manually
739	# generate the "Leave" event.
740	set leave 1
741	foreach item [$c find overlapping $x $y $x $y] {
742	if {[lsearch -exact [$c gettags $item] $tag] != -1} {
743	set leave 0
744	}
745	}
746	if {$leave == 1} {
747	# FIXME:
748	# i want to generate the event rather than
749	# calling the function myself...
750	# event generate $c <Leave>
751	_bindings timeline
752	}
753	}
754	}
755	}
756
757	# ----------------------------------------------------------------------
758	# USAGE: _move click <x> <y>
759	# _move drag <x> <y>
760	# _move release <x> <y>
761	#
762	# Called automatically whenever the user clicks or drags on the widget
763	# to select a value. Moves the current value to the one nearest the
764	# click point. If the value actually changes, it generates a <<Value>>
765	# event to notify clients.
766	# ----------------------------------------------------------------------
767	itcl::body Rappture::Videodial::_move {action x y} {
768	switch $action {
769	"click" {
770	set _click(x) $x
771	set _click(y) $y
772	}
773	"drag" {
774	set c $itk_component(minordial)
775	set dist [expr ${_click(x)}-$x]
776	$c xview scroll $dist "units"
777	set _click(x) $x
778	set _click(y) $y
779	}
780	"release" {
781	_move drag $x $y
782	catch {unset _click}
783	}
784	}
785	}
786
787	## from http://tcl.sourceforge.net/faqs/tk/#canvas/see
788	## "see" method alternative for canvas
789	## Aligns the named item as best it can in the middle of the screen
790	##
791	## item - a canvas tagOrId
792	itcl::body Rappture::Videodial::_see {item} {
793	set c $itk_component(minordial)
794	set box [$c bbox $item]
795	if {![llength $box]} return
796	## always properly set -scrollregion
797	foreach {x y x1 y1} $box \
798	{top btm} [$c yview] \
799	{left right} [$c xview] \
800	{p q xmax ymax} [$c cget -scrollregion] {
801	set xpos [expr {(($x1+$x)/2.0)/$xmax - ($right-$left)/2.0}]
802	set ypos [expr {(($y1+$y)/2.0)/$ymax - ($btm-$top)/2.0}]
803	}
804	$c xview moveto $xpos
805	#$c yview moveto $ypos
806	}
807
808
809	# ----------------------------------------------------------------------
810	# USAGE: _navigate <offset>
811	#
812	# Called automatically whenever the user presses left/right keys
813	# to nudge the current value left or right by some <offset>. If the
814	# value actually changes, it generates a <<Value>> event to notify
815	# clients.
816	# ----------------------------------------------------------------------
817	#itcl::body Rappture::Videodial::_navigate {offset} {
818	# set index [lsearch -exact $_values $_current]
819	# if {$index >= 0} {
820	# incr index $offset
821	# if {$index >= [llength $_values]} {
822	# set index [expr {[llength $_values]-1}]
823	# } elseif {$index < 0} {
824	# set index 0
825	# }
826	#
827	# set newval [lindex $_values $index]
828	# if {$newval != $_current} {
829	# current $newval
830	# _redraw
831	#
832	# event generate $itk_component(hull) <<Value>>
833	# }
834	# }
835	#}
836
837
838	# ----------------------------------------------------------------------
839	# USAGE: _navigate <offset>
840	#
841	# Called automatically whenever the user presses left/right keys
842	# to nudge the current value left or right by some <offset>. If the
843	# value actually changes, it generates a <<Value>> event to notify
844	# clients.
845	# ----------------------------------------------------------------------
846	itcl::body Rappture::Videodial::_navigate {offset} {
847	_current [ms2rel [expr $_current + $offset]]
848	event generate $itk_component(hull) <<Value>>
849	}
850
851
852	# ----------------------------------------------------------------------
853	# USAGE: _fixSize
854	#
855	# Used internally to compute the overall size of the widget based
856	# on the -thickness and -length options.
857	# ----------------------------------------------------------------------
858	itcl::body Rappture::Videodial::_fixSize {} {
859	set h [winfo pixels $itk_component(hull) $itk_option(-thickness)]
860
861	if {"" != $_knob} {
862	set kh [image height $_knob]
863
864	switch -- $itk_option(-knobposition) {
865	n@top - nw@top - ne@top -
866	s@bottom - sw@bottom - se@bottom {
867	if {$kh > $h} { set h $kh }
868	}
869	n@middle - nw@middle - ne@middle -
870	s@middle - sw@middle - se@middle {
871	set h [expr {int(ceil(0.5*$h + $kh))}]
872	}
873	n@bottom - nw@bottom - ne@bottom -
874	s@top - sw@top - se@top {
875	set h [expr {$h + $kh}]
876	}
877	e@middle - w@middle - center@middle {
878	set h [expr {(($h > $kh) ? $h : $kh) + 1}]
879	}
880	n@middle - ne@middle - nw@middle -
881	s@middle - se@middle - sw@middle {
882	set extra [expr {int(ceil($kh-0.5*$h))}]
883	if {$extra < 0} { set extra 0 }
884	set h [expr {$h+$extra}]
885	}
886	}
887	}
888	incr h 5
889
890	set w [winfo pixels $itk_component(hull) $itk_option(-length)]
891
892	# if the -valuewidth is > 0, then make room for the value
893	if {$itk_option(-valuewidth) > 0} {
894	set charw [font measure $itk_option(-font) "n"]
895	set _vwidth [expr {$itk_option(-valuewidth)*$charw}]
896	set w [expr {$w+$_vwidth+4}]
897	} else {
898	set _vwidth 0
899	}
900
901	$itk_component(majordial) configure -width $w -height $h
902	}
903
904	# ----------------------------------------------------------------------
905	# USAGE: _fixValue ?<name1> <name2> <op>?
906	#
907	# Invoked automatically whenever the -variable associated with this
908	# widget is modified. Copies the value to the current settings for
909	# the widget.
910	# ----------------------------------------------------------------------
911	itcl::body Rappture::Videodial::_fixValue {args} {
912	if {"" == $itk_option(-variable)} {
913	return
914	}
915	upvar #0 $itk_option(-variable) var
916	_current [ms2rel $var]
917	}
918
919	# ----------------------------------------------------------------------
920	# USAGE: _fixOffsets
921	#
922	# ----------------------------------------------------------------------
923	itcl::body Rappture::Videodial::_fixOffsets {} {
924	if {0 == $itk_option(-offset)} {
925	return
926	}
927	set _offset_pos $itk_option(-offset)
928	set _offset_neg [expr -1*$_offset_pos]
929	bind $itk_component(hull) <KeyPress-Left> [itcl::code $this _navigate $_offset_neg]
930	bind $itk_component(hull) <KeyPress-Right> [itcl::code $this _navigate $_offset_pos]
931	}
932
933	itcl::body Rappture::Videodial::ms2rel { value } {
934	if { $max > $min } {
935	return [expr {1.0 * ($value - $min) / ($max - $min)}]
936	}
937	return 0
938	}
939
940	itcl::body Rappture::Videodial::rel2ms { value } {
941	return [expr $value * ($max - $min) + $min]
942	}
943
944	# ----------------------------------------------------------------------
945	# CONFIGURE: -thickness
946	# ----------------------------------------------------------------------
947	itcl::configbody Rappture::Videodial::thickness {
948	_fixSize
949	}
950
951	# ----------------------------------------------------------------------
952	# CONFIGURE: -length
953	# ----------------------------------------------------------------------
954	itcl::configbody Rappture::Videodial::length {
955	_fixSize
956	}
957
958	# ----------------------------------------------------------------------
959	# CONFIGURE: -font
960	# ----------------------------------------------------------------------
961	itcl::configbody Rappture::Videodial::font {
962	_fixSize
963	}
964
965	# ----------------------------------------------------------------------
966	# CONFIGURE: -valuewidth
967	# ----------------------------------------------------------------------
968	itcl::configbody Rappture::Videodial::valuewidth {
969	if {![string is integer $itk_option(-valuewidth)]} {
970	error "bad value \"$itk_option(-valuewidth)\": should be integer"
971	}
972	_fixSize
973	after cancel [itcl::code $this _redraw]
974	after idle [itcl::code $this _redraw]
975	}
976
977	# ----------------------------------------------------------------------
978	# CONFIGURE: -foreground
979	# ----------------------------------------------------------------------
980	itcl::configbody Rappture::Videodial::foreground {
981	after cancel [itcl::code $this _redraw]
982	after idle [itcl::code $this _redraw]
983	}
984
985	# ----------------------------------------------------------------------
986	# CONFIGURE: -dialoutlinecolor
987	# ----------------------------------------------------------------------
988	itcl::configbody Rappture::Videodial::dialoutlinecolor {
989	after cancel [itcl::code $this _redraw]
990	after idle [itcl::code $this _redraw]
991	}
992
993	# ----------------------------------------------------------------------
994	# CONFIGURE: -dialfillcolor
995	# ----------------------------------------------------------------------
996	itcl::configbody Rappture::Videodial::dialfillcolor {
997	after cancel [itcl::code $this _redraw]
998	after idle [itcl::code $this _redraw]
999	}
1000
1001	# ----------------------------------------------------------------------
1002	# CONFIGURE: -dialprogresscolor
1003	# ----------------------------------------------------------------------
1004	itcl::configbody Rappture::Videodial::dialprogresscolor {
1005	after cancel [itcl::code $this _redraw]
1006	after idle [itcl::code $this _redraw]
1007	}
1008
1009	# ----------------------------------------------------------------------
1010	# CONFIGURE: -linecolor
1011	# ----------------------------------------------------------------------
1012	itcl::configbody Rappture::Videodial::linecolor {
1013	after cancel [itcl::code $this _redraw]
1014	after idle [itcl::code $this _redraw]
1015	}
1016
1017	# ----------------------------------------------------------------------
1018	# CONFIGURE: -activelinecolor
1019	# ----------------------------------------------------------------------
1020	itcl::configbody Rappture::Videodial::activelinecolor {
1021	set val $itk_option(-activelinecolor)
1022	if {[catch {$val isa ::Rappture::Spectrum} valid] == 0 && $valid} {
1023	set _spectrum $val
1024	set _activecolor ""
1025	} elseif {[catch {winfo rgb $itk_component(hull) $val}] == 0} {
1026	set _spectrum ""
1027	set _activecolor $val
1028	} elseif {"" != $val} {
1029	error "bad value \"$val\": should be Spectrum object or color"
1030	}
1031	after cancel [itcl::code $this _redraw]
1032	after idle [itcl::code $this _redraw]
1033	}
1034
1035	# ----------------------------------------------------------------------
1036	# CONFIGURE: -knobimage
1037	# ----------------------------------------------------------------------
1038	itcl::configbody Rappture::Videodial::knobimage {
1039	if {[regexp {^image[0-9]+$} $itk_option(-knobimage)]} {
1040	set _knob $itk_option(-knobimage)
1041	} elseif {"" != $itk_option(-knobimage)} {
1042	set _knob [Rappture::icon $itk_option(-knobimage)]
1043	} else {
1044	set _knob ""
1045	}
1046	_fixSize
1047
1048	after cancel [itcl::code $this _redraw]
1049	after idle [itcl::code $this _redraw]
1050	}
1051
1052	# ----------------------------------------------------------------------
1053	# CONFIGURE: -knobposition
1054	# ----------------------------------------------------------------------
1055	itcl::configbody Rappture::Videodial::knobposition {
1056	if {![regexp {^([nsew]+\|center)@(top\|middle\|bottom)$} $itk_option(-knobposition)]} {
1057	error "bad value \"$itk_option(-knobposition)\": should be anchor@top\|middle\|bottom"
1058	}
1059	_fixSize
1060
1061	after cancel [itcl::code $this _redraw]
1062	after idle [itcl::code $this _redraw]
1063	}
1064
1065	# ----------------------------------------------------------------------
1066	# CONFIGURE: -padding
1067	# This adds padding on left/right side of dial background.
1068	# ----------------------------------------------------------------------
1069	itcl::configbody Rappture::Videodial::padding {
1070	if {[catch {winfo pixels $itk_component(hull) $itk_option(-padding)}]} {
1071	error "bad value \"$itk_option(-padding)\": should be size in pixels"
1072	}
1073	}
1074
1075	# ----------------------------------------------------------------------
1076	# CONFIGURE: -valuepadding
1077	# This shifts min/max limits in by a fraction of the overall size.
1078	# ----------------------------------------------------------------------
1079	itcl::configbody Rappture::Videodial::valuepadding {
1080	if {![string is double $itk_option(-valuepadding)]
1081	\|\| $itk_option(-valuepadding) < 0} {
1082	error "bad value \"$itk_option(-valuepadding)\": should be >= 0.0"
1083	}
1084	}
1085
1086	# ----------------------------------------------------------------------
1087	# CONFIGURE: -variable
1088	# ----------------------------------------------------------------------
1089	itcl::configbody Rappture::Videodial::variable {
1090	if {"" != $_variable} {
1091	upvar #0 $_variable var
1092	trace remove variable var write [itcl::code $this _fixValue]
1093	}
1094
1095	set _variable $itk_option(-variable)
1096
1097	if {"" != $_variable} {
1098	upvar #0 $_variable var
1099	trace add variable var write [itcl::code $this _fixValue]
1100
1101	# sync to the current value of this variable
1102	if {[info exists var]} {
1103	_fixValue
1104	}
1105	}
1106	}
1107
1108	# ----------------------------------------------------------------------
1109	# CONFIGURE: -offset
1110	# ----------------------------------------------------------------------
1111	itcl::configbody Rappture::Videodial::offset {
1112	if {![string is double $itk_option(-offset)]} {
1113	error "bad value \"$itk_option(-offset)\": should be >= 0.0"
1114	}
1115	_fixOffsets
1116	}

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

Download in other formats: