Context Navigation

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

Last change on this file since 1925 was 1925, checked in by dkearney, 14 years ago
updates for video widget code. adding uploadWord to filexfer to match the downloadWord. adding some images.
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: