Context Navigation

source: trunk/gui/scripts/videodial2.tcl @ 3177

Last change on this file since 3177 was 3177, checked in by mmc, 12 years ago
Updated all of the copyright notices to reference the transfer to the new HUBzero Foundation, LLC.
File size: 46.8 KB

Line
1	# ----------------------------------------------------------------------
2	# COMPONENT: Videodial2 - 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-2012 HUBzero Foundation, LLC
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 *Videodial2.thickness 10 widgetDefault
18	option add *Videodial2.padding 0 widgetDefault
19	option add *Videodial2.foreground black widgetDefault
20	option add *Videodial2.font \
21	--helvetica-medium-r-normal--12-* widgetDefault
22
23	itcl::class Rappture::Videodial2 {
24	inherit itk::Widget
25
26	itk_option define -min min Min 0
27	itk_option define -max max Max 1
28	itk_option define -minortick minortick Minortick 1
29	itk_option define -majortick majortick Majortick 5
30	itk_option define -variable variable Variable ""
31	itk_option define -offset offset Offset 1
32
33	itk_option define -thickness thickness Thickness 0
34	itk_option define -padding padding Padding 0
35
36	itk_option define -dialoutlinecolor dialOutlineColor Color "black"
37	itk_option define -dialfillcolor dialFillColor Color "white"
38	itk_option define -foreground foreground Foreground "black"
39
40	itk_option define -font font Font ""
41
42
43	constructor {args} { # defined below }
44	destructor { # defined below }
45
46	public method current {value}
47	public method clear {}
48	public method mark {args}
49	public method bball {}
50	public method loop {action args}
51
52	protected method _bindings {type args}
53	protected method _redraw {args}
54	protected method _marker {tag action x y}
55	protected method _setmark {type args}
56	protected method _move {action x y}
57	protected method _navigate {offset}
58	protected method _fixSize {}
59	protected method _fixValue {args}
60	protected method _fixOffsets {}
61
62	private method _calculateDialDimensions {}
63	private method _calculateDisplayRange {args}
64	private method _drawDial {disp_min disp_max}
65	private method _getFramenumFromId {id}
66	private method _nearestFrameMarker {x y}
67	private method _current {value}
68	private method _see {item}
69	private method _offsetx {x}
70	private method ms2rel {value}
71	private method rel2ms {value}
72	private method _goToFrame {framenum}
73
74	private common _click ;# x,y point where user clicked
75	private common _marks ;# list of marks
76	private common _dd ;# holds the dimensions of the dial
77	private variable _values "" ;# list of all values on the dial
78	private variable _val2label ;# maps value => string label(s)
79	private variable _current 0 ;# current value (where pointer is)
80	private variable _variable "" ;# variable associated with -variable
81	private variable _offset_pos 1 ;#
82	private variable _offset_neg -1 ;#
83	private variable _imspace 10 ;# pixels between intermediate marks
84	private variable _min 0
85	private variable _max 1
86	private variable _minortick 1
87	private variable _majortick 5
88	private variable _lockdial ""
89	private variable _displayMin 0
90	private variable _displayMax 0
91	}
92
93	itk::usual Videodial2 {
94	keep -foreground -cursor -font
95	}
96
97	# ----------------------------------------------------------------------
98	# CONSTRUCTOR
99	# ----------------------------------------------------------------------
100	itcl::body Rappture::Videodial2::constructor {args} {
101
102	# bind $itk_component(hull) <<Frame>> [itcl::code $this _updateCurrent]
103
104	# ----------------------------------------------------------------------
105	# controls for the minor timeline.
106	# ----------------------------------------------------------------------
107	itk_component add minordial {
108	canvas $itk_interior.minordial -background blue
109	}
110
111
112	bind $itk_component(minordial) <Configure> [itcl::code $this _redraw]
113
114	_bindings timeline
115
116	# ----------------------------------------------------------------------
117	# place controls in widget.
118	# ----------------------------------------------------------------------
119
120	blt::table $itk_interior \
121	0,0 $itk_component(minordial) -fill x
122
123	blt::table configure $itk_interior c* -resize both
124	blt::table configure $itk_interior r0 -resize none
125
126
127	eval itk_initialize $args
128
129	$itk_component(minordial) configure -background cyan
130
131	_fixOffsets
132	}
133
134	# ----------------------------------------------------------------------
135	# DESTRUCTOR
136	# ----------------------------------------------------------------------
137	itcl::body Rappture::Videodial2::destructor {} {
138	configure -variable "" ;# remove variable trace
139	after cancel [itcl::code $this _redraw]
140	}
141
142	# ----------------------------------------------------------------------
143	# USAGE: current ?<value>?
144	#
145	# Clients use this to set a new value for the dial. Values are always
146	# sorted in order along the dial. If the value is not specified,
147	# then it is created automatically based on the number of elements
148	# on the dial.
149	# ----------------------------------------------------------------------
150	itcl::body Rappture::Videodial2::current {value} {
151	if {"" == $value} {
152	return
153	}
154
155	if {$value < ${_min}} {
156	set value ${_min}
157	}
158
159	if {$value > ${_max}} {
160	set value ${_max}
161	}
162
163	_current [ms2rel $value]
164	}
165
166	# ----------------------------------------------------------------------
167	# USAGE: _current ?<value>?
168	#
169	# Clients use this to set a new value for the dial. Values are always
170	# sorted in order along the dial. If the value is not specified,
171	# then it is created automatically based on the number of elements
172	# on the dial.
173	# ----------------------------------------------------------------------
174	itcl::body Rappture::Videodial2::_current {relval} {
175
176	if {[string is double $relval] == 0} {
177	error "bad value \"$relval\": expected relval to be a double"
178	}
179	if {${_current} == $relval} {
180	# nothing to do
181	return
182	}
183
184	if { $relval < 0.0 } {
185	set relval 0.0
186	}
187	if { $relval > 1.0 } {
188	set relval 1.0
189	}
190
191	set _current $relval
192	set framenum [expr round([rel2ms $_current])]
193
194	set updated 0
195	if {[llength ${_lockdial}] != 0} {
196	# the dial is "locked" this means we don't center the dial
197	# on the current value. we only move the dial if the
198	# current value is less than or greater than the marks alredy
199	# shown on the dial.
200	if {[expr ${_displayMin}+${_majortick}] >= $framenum} {
201	set newdmin [expr $framenum-${_majortick}]
202	foreach {dmin dmax} [_calculateDisplayRange -min $newdmin] break
203	incr updated
204	} elseif {[expr ${_displayMax}-${_majortick}] <= $framenum} {
205	set newdmax [expr $framenum+${_majortick}]
206	foreach {dmin dmax} [_calculateDisplayRange -max $newdmax] break
207	incr updated
208	}
209	} else {
210	# center the current marker
211	foreach {dmin dmax} [_calculateDisplayRange] break
212	incr updated
213	}
214
215	if {$updated == 1} {
216	_drawDial $dmin $dmax
217	}
218
219	after idle [_setmark currentmark $framenum]
220
221	# update the upvar variable
222	if { $_variable != "" } {
223	upvar #0 $_variable var
224	set var $framenum
225	}
226	}
227
228
229	# ----------------------------------------------------------------------
230	# USAGE: _bindings <type> ?args?
231	# ----------------------------------------------------------------------
232	itcl::body Rappture::Videodial2::_bindings {type args} {
233	set c $itk_component(minordial)
234	switch -- $type {
235	"marker" {
236	set tag [lindex $args 0]
237	bind $c <ButtonPress-1> [itcl::code $this _marker $tag click %x %y]
238	bind $c <B1-Motion> [itcl::code $this _marker $tag drag %x %y]
239	bind $c <ButtonRelease-1> [itcl::code $this _marker $tag release %x %y]
240	$c configure -cursor sb_h_double_arrow
241	}
242	"timeline" {
243	# bind $c <ButtonPress-1> [itcl::code $this _move click %x %y]
244	# bind $c <B1-Motion> [itcl::code $this _move drag %x %y]
245	# bind $c <ButtonRelease-1> [itcl::code $this _move release %x %y]
246	bind $c <ButtonPress-1> { }
247	bind $c <B1-Motion> { }
248	bind $c <ButtonRelease-1> { }
249	$c configure -cursor ""
250	}
251	"toolmark" {
252	if {[llength $args] != 2} {
253	error "wrong # args: should be _bindings toolmark \[enter\|leave\] <tag>"
254	}
255
256	foreach {mode tag} $args break
257
258	switch -- $mode {
259	"enter" {
260	#$c create rectangle [$c bbox $tag] \
261	-outline red \
262	-tags "highlight"
263	bind $c <ButtonPress-1> [itcl::code $this _goToFrame $_marks($tag)]
264	}
265	"leave" {
266	#$c delete "highlight"
267	_bindings timeline
268	}
269	default {
270	error "bad argument \"$mode\": should be enter or leave"
271	}
272	}
273	}
274	}
275	}
276
277	# ----------------------------------------------------------------------
278	# USAGE: mark <property> <args>
279	#
280	# ----------------------------------------------------------------------
281	itcl::body Rappture::Videodial2::mark {property args} {
282	set retval 0
283
284	switch -- $property {
285	add {
286	set retval [eval _setmark $args]
287	}
288	remove {
289	if {[llength $args] != 1} {
290	error "wrong # args: should be \"mark remove <type>\""
291	}
292	set type [lindex $args 0]
293	if {[info exists _marks($type)]} {
294	$itk_component(minordial) delete $type
295	array unset _marks $type
296	}
297	}
298	position {
299	if {[llength $args] != 1} {
300	error "wrong # args: should be \"mark position <type>\""
301	}
302	set type [lindex $args 0]
303	if {[info exists _marks($type)]} {
304	return $_marks($type)
305	}
306	set retval [expr ${_min}-1]
307	}
308	default {
309	error "bad value \"$property\": should be one of add, remove, position"
310	}
311	}
312
313	return $retval
314	}
315
316	# ----------------------------------------------------------------------
317	# USAGE: _getFramenumFromId <id>
318	# ----------------------------------------------------------------------
319	itcl::body Rappture::Videodial2::_getFramenumFromId {id} {
320	set where 0
321
322	# find the frame# tag to associate with the marker with
323	if {[regexp {frame([0-9]+)} $id] == 0} {
324	foreach tags [$c gettags $id] {
325	if {"" != [set tmp [lsearch -inline -regexp $tags {frame[0-9]+}]]} {
326	set where $tmp
327	break
328	}
329	}
330	} else {
331	set where $id
332	}
333	# store the frame number in where
334	regexp {frame([0-9]+)} $where match where
335
336	# restrict <where> to valid frames between min and max
337	if {$where < ${_min}} {
338	set where ${_min}
339	}
340	if {$where > ${_max}} {
341	set where ${_max}
342	}
343
344	return $where
345	}
346
347	# ----------------------------------------------------------------------
348	# USAGE: _setmark <type> ?[-xcoord\|-tag]? <where>
349	#
350	# Clients use this to add a mark to the timeline
351	# type can be any of loopstart, loopend, particle, measure, currentmark
352	# where is interpreted based on the preceeding flag if available.
353	# in the default case, <where> is interpreted as a frame number
354	# or "current". if the -xcoord flag is provided, where is
355	# interpreted as the x coordinate of where to center the marker.
356	# -xcoord should only be used for temporary placement of a
357	# marker. when -xcoord is used, the marker is placed exactly at
358	# the provided x coordinate, and is not associated with any
359	# frame. It's purpose is mainly for <B1-Motion> events.
360	# ----------------------------------------------------------------------
361	itcl::body Rappture::Videodial2::_setmark {type args} {
362
363	set c $itk_component(minordial)
364
365	set cx0 0
366	set cy0 0
367	set cx1 0
368	set cy1 0
369	foreach {cx0 cy0 cx1 cy1} [$c bbox "imbox"] break
370
371	# get coords of where to place the marker
372	set frx0 0
373	set fry0 0
374	set frx1 0
375	set fry1 0
376
377	set where ""
378	set largs [llength $args]
379	if {$largs == 1} {
380	set where [lindex $args 0]
381	if {[string compare "current" $where] == 0} {
382	set where [expr round([rel2ms ${_current}])]
383	} elseif {[string is integer $where] == 0} {
384	error "bad value \"$where\": while trying to place marker \"$type\": <where> should be an integer value"
385	}
386
387	# restrict <where> to valid frames between min and max
388	if {$where < ${_min}} {
389	set where ${_min}
390	}
391	if {$where > ${_max}} {
392	set where ${_max}
393	}
394
395	set coords [$c coords "frame$where"]
396	if {![llength $coords]} {
397	# frame marker does not exist
398	# estimate where to put the marker
399	# use frame0 marker as a x=0 point
400	foreach {frx0 fry0 frx1 fry1} [$c coords "frame0"] break
401	set frx0 [expr {$frx0 + ((1.0$where/${_minortick})${_imspace})}]
402	} else {
403	foreach {frx0 fry0 frx1 fry1} $coords break
404	}
405	# where already contains the frame number
406	} elseif {$largs == 2} {
407	set flag [lindex $args 0]
408	switch -- $flag {
409	"-xcoord" {
410	set frx0 [lindex $args 1]
411	# where is not set for the -xcoord flag
412	}
413	"-tag" {
414	set id [lindex $args 1]
415	set where [_getFramenumFromId $id]
416	foreach {frx0 fry0 frx1 fry1} [$c coords frame$where] break
417	}
418	default {
419	error "bad value \"$flag\": should be -xcoord or -tag"
420	}
421	}
422	if {[string is double $frx0] == 0} {
423	error "bad value \"$frx0\": <where> should be a double value"
424	}
425	} else {
426	error "wrong # args: should be \"mark <type> ?-xcoord? <where>\""
427	}
428
429	# add/remove the marker
430
431	switch -glob -- $type {
432	"loopstart" {
433	# add start marker
434
435	if {($where >= ${_displayMin}) && ($where < ${_displayMax})} {
436	set smx0 $frx0 ;# loopstart marker x0
437	set smy0 $cy0 ;# loopstart marker y0
438
439	# polygon's outline adds a border to only one
440	# side of the object? so we have weird +1 in
441	# the triangle base in loopstart marker
442
443	# marker stem is 3 pixels thick
444	set smx1 [expr {$smx0+1}] ;# triangle top x
445	set smy1 [expr {$smy0-10}] ;# triangle top y
446	set smx2 $smx1 ;# stem bottom right x
447	set smy2 $cy1 ;# stem bottom right y
448	set smx3 [expr {$smx0-1}] ;# stem bottom left x
449	set smy3 $smy2 ;# stem bottom left y
450	set smx4 $smx3 ;# stem middle left x
451	set smy4 $smy0 ;# stem middle left y
452	set smx5 [expr {$smx0-10+1}] ;# triangle bottom left x
453	set smy5 $smy0 ;# triangle bottom left y
454
455	set tag $type
456	$c delete $tag
457	$c create polygon \
458	$smx1 $smy1 \
459	$smx2 $smy2 \
460	$smx3 $smy3 \
461	$smx4 $smy4 \
462	$smx5 $smy5 \
463	-outline black -fill black -tags [list $tag dialval]
464
465	$c bind $tag <Enter> [itcl::code $this _bindings marker $tag]
466	$c bind $tag <Leave> [itcl::code $this _bindings timeline]
467	}
468
469	if {[string compare "" $where] != 0} {
470	set _marks($type) $where
471
472	# make sure loopstart marker is before loopend marker
473	if {[info exists _marks(loopend)]} {
474	set endFrNum $_marks(loopend)
475	if {$endFrNum < $where} {
476	_setmark loopend -tag frame[expr $where+1]
477	}
478	}
479	}
480
481	}
482	"loopend" {
483	# add loopend marker
484
485	if {($where >= ${_displayMin}) && ($where < ${_displayMax})} {
486	set emx0 $frx0 ;# loopend marker x0
487	set emy0 $cy0 ;# loopend marker y0
488
489	set emx1 [expr {$emx0-1}] ;# triangle top x
490	set emy1 [expr {$emy0-10}] ;# triangle top y
491	set emx2 $emx1 ;# stem bottom left x
492	set emy2 $cy1 ;# stem bottom left y
493	set emx3 [expr {$emx0+1}] ;# stem bottom right x
494	set emy3 $emy2 ;# stem bottom right y
495	set emx4 $emx3 ;# stem middle right x
496	set emy4 $emy0 ;# stem middle right y
497	set emx5 [expr {$emx0+10-1}] ;# triangle bottom right x
498	set emy5 $emy0 ;# triangle bottom right y
499
500	set tag $type
501	$c delete $tag
502	$c create polygon \
503	$emx1 $emy1 \
504	$emx2 $emy2 \
505	$emx3 $emy3 \
506	$emx4 $emy4 \
507	$emx5 $emy5 \
508	-outline black -fill black -tags [list $tag dialval]
509
510	$c bind $tag <Enter> [itcl::code $this _bindings marker $tag]
511	$c bind $tag <Leave> [itcl::code $this _bindings timeline]
512	}
513
514	if {[string compare "" $where] != 0} {
515	set _marks($type) $where
516
517	# make sure loopend marker is after loopstart marker
518	if {[info exists _marks(loopstart)]} {
519	set startFrNum $_marks(loopstart)
520	if {$startFrNum > $where} {
521	_setmark loopstart -tag frame[expr $where-1]
522	}
523	}
524	}
525	}
526	"particle*" {
527	if {($where >= ${_displayMin}) && ($where < ${_displayMax})} {
528	set radius 3
529	set pmx0 $frx0
530	set pmy0 [expr {$cy1+5}]
531	set coords [list [expr $pmx0-$radius] [expr $pmy0-$radius] \
532	[expr $pmx0+$radius] [expr $pmy0+$radius]]
533
534	set tag $type
535	$c delete $tag
536	$c create oval $coords \
537	-fill green \
538	-outline black \
539	-width 1 \
540	-tags [list $tag dialval]
541
542	$c bind $tag <Enter> [itcl::code $this _bindings toolmark enter $tag]
543	$c bind $tag <Leave> [itcl::code $this _bindings toolmark leave $tag]
544	}
545
546	if {[string compare "" $where] != 0} {
547	set _marks($type) $where
548	}
549	}
550	"measure*" {
551	if {($where >= ${_displayMin}) && ($where < ${_displayMax})} {
552	set radius 3
553	set amx0 $frx0
554	set amy0 [expr {$cy1+15}]
555	set coords [list [expr $amx0-$radius] [expr $amy0-$radius] \
556	[expr $amx0+$radius] [expr $amy0+$radius]]
557
558	set tag $type
559	$c delete $tag
560	$c create line $coords \
561	-fill red \
562	-width 3 \
563	-tags [list $tag dialval]
564
565	$c bind $tag <Enter> [itcl::code $this _bindings toolmark enter $tag]
566	$c bind $tag <Leave> [itcl::code $this _bindings toolmark leave $tag]
567	}
568
569	if {[string compare "" $where] != 0} {
570	set _marks($type) $where
571	}
572	}
573	"currentmark" {
574
575	if {($where >= ${_displayMin}) && ($where < ${_displayMax})} {
576	set cmx0 $frx0 ;# current marker x0
577	set cmy0 $cy0 ;# current marker y0
578
579	set cmx1 [expr {$cmx0+5}] ;# lower right diagonal edge x
580	set cmy1 [expr {$cmy0-5}] ;# lower right diagonal edge y
581	set cmx2 $cmx1 ;# right top x
582	set cmy2 [expr {$cmy1-5}] ;# right top y
583	set cmx3 [expr {$cmx0-5}] ;# left top x
584	set cmy3 $cmy2 ;# left top y
585	set cmx4 $cmx3 ;# lower left diagonal edge x
586	set cmy4 $cmy1 ;# lower left diagonal edge y
587
588	set tag $type
589	$c delete $tag
590	$c create polygon \
591	$cmx0 $cmy0 \
592	$cmx1 $cmy1 \
593	$cmx2 $cmy2 \
594	$cmx3 $cmy3 \
595	$cmx4 $cmy4 \
596	-outline black \
597	-fill red \
598	-tags [list $tag dialval]
599	$c create line $cmx0 $cmy0 $cmx0 $cy1 \
600	-fill red \
601	-tags [list $tag dialval]
602
603	$c bind $tag <Enter> [itcl::code $this _bindings marker $tag]
604	$c bind $tag <Leave> [itcl::code $this _bindings timeline]
605	}
606
607	if {[string compare "" $where] != 0} {
608	set _marks($type) $where
609	}
610	}
611	default {
612	error "bad value \"$type\": should be \"loopstart\" or \"loopend\""
613	}
614	}
615	return
616	}
617
618	# ----------------------------------------------------------------------
619	# USAGE: bball
620	# debug function to print out the bounding box information for
621	# minor dial
622	# ----------------------------------------------------------------------
623	itcl::body Rappture::Videodial2::bball {} {
624	set c $itk_component(minordial)
625	foreach item [$c find all] {
626	foreach {x0 y0 x1 y1} [$c bbox $item] break
627	if {! [info exists y1]} continue
628	puts stderr "$item : [expr $y1-$y0]: $y0 $y1"
629	lappend q $y0 $y1
630	}
631	set q [lsort -real $q]
632	puts stderr "q [lindex $q 0] [lindex $q end]"
633	puts stderr "height [winfo height $c]"
634	puts stderr "bbox all [$c bbox all]"
635	puts stderr "parent height [winfo height [winfo parent $c]]"
636	}
637
638	# ----------------------------------------------------------------------
639	# USAGE: loop
640	# loop between <start> <end> - setup looping between frames <start> and <end>
641	# loop disable - disable looping
642	# ----------------------------------------------------------------------
643	itcl::body Rappture::Videodial2::loop {action args} {
644	switch -- $action {
645	"between" {
646	if {[llength $args] != 2} {
647	error "wrong # args: should be loop between <start> <end>"
648	}
649	foreach {startframe endframe} $args break
650	mark add loopstart $startframe
651	mark add loopend $endframe
652	lappend _lockdial "loop"
653	}
654	"disable" {
655	if {[llength $args] != 0} {
656	error "wrong # args: should be loop disable"
657	}
658	mark remove loopstart
659	mark remove loopend
660	set idx [lsearch -exact ${_lockdial} "loop"]
661	set _lockdial [lreplace ${_lockdial} $idx $idx]
662	}
663	default {
664	error "bad value \"$action\": should be \"between\" or \"disable\""
665	}
666	}
667	}
668
669	# ----------------------------------------------------------------------
670	# USAGE: _calculateDisplayRange
671	# calculate the minimum and maximum values to display on the dial
672	# ----------------------------------------------------------------------
673	itcl::body Rappture::Videodial2::_calculateDisplayRange {args} {
674
675	Rappture::getopts args params {
676	value -min 0
677	value -max 0
678	}
679
680	set disp_min $params(-min)
681	set disp_max $params(-max)
682
683	if {($disp_min == 0) && ($disp_max == 0)} {
684	# calculate the display min and max by
685	# centering the current value on the dial
686	set framenum [expr round([rel2ms ${_current}])]
687	set disp_min [expr ($framenum-$_dd(ni))]
688	set disp_max [expr ($framenum+$_dd(ni))]
689	} elseif {($disp_min != 0) && ($disp_max == 0)} {
690	# user supplied disp_min value
691	# calculate disp_max
692	set disp_max [expr round($disp_min+($_dd(ni)*2.0))]
693	} elseif {($disp_min == 0) && ($disp_max != 0)} {
694	# user supplied disp_max value
695	# calculate disp_min
696	set disp_min [expr round($disp_max-($_dd(ni)*2.0))]
697	}
698
699	# deal with edge cases
700
701	if {($disp_min < ${_min})} {
702	# don't display marks less than ${_min}
703	set disp_min ${_min}
704	set disp_max [expr round(${_min}+($_dd(ni)*2.0))]
705	if {$disp_max > ${_max}} {
706	set disp_max ${_max}
707	}
708	}
709
710	if {($disp_max > ${_max})} {
711	# don't display marks greater than ${_max}
712	set disp_min [expr round(${_max}-($_dd(ni)*2.0))]
713	if {$disp_min < ${_min}} {
714	set disp_min ${_min}
715	}
716	set disp_max ${_max}
717	}
718
719	return [list $disp_min $disp_max]
720	}
721
722	# ----------------------------------------------------------------------
723	# USAGE: _calculateDialDimensions
724	# calculate dimensions used to draw the dial
725	# ----------------------------------------------------------------------
726	itcl::body Rappture::Videodial2::_calculateDialDimensions {} {
727	set c $itk_component(minordial)
728	set w [winfo width $c]
729	set h [winfo height $c]
730	set p [winfo pixels $c $itk_option(-padding)]
731	set t [expr {$itk_option(-thickness)+1}]
732	set y1 [expr {$h-1}]
733	set y0 [expr {$y1-$t}]
734	set x0 [expr {$p+1}]
735	set x1 [expr {$w-$p-4}]
736
737
738	# add intermediate marks between markers
739	set imw 1.0 ;# intermediate mark width
740
741	set imsh [expr {$t/3.0}] ;# intermediate mark short height
742	set imsy0 [expr {$y0+(($t-$imsh)/2.0)}] ;# precalc'd imark short y0 coord
743	set imsy1 [expr {$imsy0+$imsh}] ;# precalc'd imark short y1 coord
744
745	set imlh [expr {$t*2.0/3.0}] ;# intermediate mark long height
746	set imly0 [expr {$y0+(($t-$imlh)/2.0)}] ;# precalc'd imark long y0 coord
747	set imly1 [expr {$imly0+$imlh}] ;# precalc'd imark long y1 coord
748
749	set imty [expr {$y0-5}] ;# height of marker value
750
751	set x [expr ($x1-$x0)/2.0]
752	set ni [expr int(($x-$x0)/${_imspace})]
753
754	set _dd(x0) $x0
755	set _dd(y0) $y0
756	set _dd(x1) $x1
757	set _dd(y1) $y1
758	set _dd(ni) $ni
759	set _dd(imly0) $imly0
760	set _dd(imly1) $imly1
761	set _dd(imw) $imw
762	set _dd(imty) $imty
763	set _dd(imsy0) $imsy0
764	set _dd(imsy1) $imsy1
765
766	}
767
768	# ----------------------------------------------------------------------
769	# USAGE: _redraw
770	# calculate dimensions, display range, and draw the dial, again
771	# ----------------------------------------------------------------------
772	itcl::body Rappture::Videodial2::_redraw {args} {
773
774	_calculateDialDimensions
775
776	foreach {disp_min disp_max} [_calculateDisplayRange] break
777
778	set c $itk_component(minordial)
779	$c delete all
780
781	# draw the background rectangle for the minor time line
782	$c create rectangle $_dd(x0) $_dd(y0) $_dd(x1) $_dd(y1) \
783	-outline $itk_option(-dialoutlinecolor) \
784	-fill $itk_option(-dialfillcolor) \
785	-tags "imbox"
786
787	_drawDial $disp_min $disp_max
788
789	# calculate the height of the intermediate tick marks
790	# and frame numbers on our canvas, resize the imbox
791	# to include both of them.
792	set box [$c bbox "all"]
793	if {![llength $box]} {
794	set box [list 0 0 0 0]
795	}
796	$c coords "imbox" $box
797
798	# add an invisible box 20 pixels above and below imbox
799	# to keep the canvas from changing sizes when the we add
800	# particle, loopstart, loopend, and line markers
801	foreach {x0 y0 x1 y1} $box break
802	$c create rectangle $x0 [expr $y0-20] $x1 [expr $y1+20] \
803	-outline "" \
804	-fill "" \
805	-tags "markerbox"
806
807	# re-add any marks that the user previously specified
808	# do it again because we changed the size of imbox
809	foreach n [array names _marks] {
810	if {($_marks($n) > ${_displayMin}) && ($_marks($n) < ${_displayMax})} {
811	_setmark $n $_marks($n)
812	}
813	}
814
815	_fixSize
816	}
817
818
819	# ----------------------------------------------------------------------
820	# USAGE: _drawDial
821	# draw the dial
822	# ----------------------------------------------------------------------
823	itcl::body Rappture::Videodial2::_drawDial {dmin dmax} {
824	set c $itk_component(minordial)
825	$c delete dialval
826
827	set _displayMin [expr int($dmin)]
828	set _displayMax [expr int($dmax)]
829
830	set imx [expr $_dd(x0)+5]
831	for {set i ${_displayMin}} {$i <= ${_displayMax}} {incr i} {
832	if {($i%${_majortick}) == 0} {
833	# draw major tick
834	$c create line $imx $_dd(imly0) $imx $_dd(imly1) \
835	-fill red \
836	-width $_dd(imw) \
837	-tags [list dialval longmark imark "frame$i"]
838
839	$c create text $imx $_dd(imty) \
840	-anchor center \
841	-text $i \
842	-font $itk_option(-font) \
843	-tags [list dialval frame$i frame$i-text]
844
845	set imx [expr $imx+${_imspace}]
846	} elseif {($i%${_minortick}) == 0 } {
847	# draw minor tick
848	$c create line $imx $_dd(imsy0) $imx $_dd(imsy1) \
849	-fill blue \
850	-width $_dd(imw) \
851	-tags [list dialval shortmark imark "frame$i"]
852
853	set imx [expr $imx+${_imspace}]
854	}
855	}
856
857	if {(${_displayMin}%${_majortick}) == 0} {
858	# first tick is numbered, delete the text if
859	# it shows up outside of our desired imbox
860	foreach {dmx0 dmy0 dmx1 dmy1} [$c bbox frame${_displayMin}-text] break
861	# need to check for if dmx0 exists because there
862	# are some cases when the widget is first being
863	# created where _calculateDisplayRange gives
864	# back bad values, dmin > dmax.
865	if {[info exists dmx0] && ($dmx0 < $_dd(x0))} {
866	$c delete frame${_displayMin}-text
867	}
868	}
869	if {(${_displayMax}%${_majortick}) == 0} {
870	# last tick is numbered, delete the text if
871	# it shows up outside of our desired imbox
872	foreach {dmx0 dmy0 dmx1 dmy1} [$c bbox frame${_displayMax}-text] break
873	# need to check for if dmx1 exists because there
874	# are some cases when the widget is first being
875	# created where _calculateDisplayRange gives
876	# back bad values, dmin > dmax.
877	if {[info exists dmx1] && ($dmx1 > $_dd(x1))} {
878	$c delete frame${_displayMax}-text
879	}
880	}
881
882	# add any marks that the user previously specified
883	foreach n [array names _marks] {
884	if {($_marks($n) > ${_displayMin}) && ($_marks($n) < ${_displayMax})} {
885	_setmark $n $_marks($n)
886	}
887	}
888	}
889
890	# ----------------------------------------------------------------------
891	# USAGE: _fixSize
892	#
893	# Used internally to compute the height of the minor dial based
894	# on the items placed on the canvas
895	#
896	# FIXME: instead of calling this in the mark command, figure out how to
897	# make the canvas the correct size to start with
898	# ----------------------------------------------------------------------
899	itcl::body Rappture::Videodial2::_fixSize {} {
900	# resize the height of the minor timeline canvas
901	# to include everything we know about
902
903	set c $itk_component(minordial)
904
905	set box [$c bbox "all"]
906	if {![llength $box]} {
907	set box [list 0 0 0 0]
908	}
909
910	foreach {x0 y0 x1 y1} $box break
911	set h [expr $y1-$y0]
912
913	$c configure -height $h -scrollregion $box -xscrollincrement 1p
914	}
915
916	# ----------------------------------------------------------------------
917	# USAGE: _goToFrame <framenum>
918	#
919	# lock the dial and go to frame <framenum>
920	# ----------------------------------------------------------------------
921	itcl::body Rappture::Videodial2::_goToFrame {framenum} {
922	lappend _lockdial "_goToFrame"
923	current $framenum
924	event generate $itk_component(hull) <<Value>>
925	set idx [lsearch -exact ${_lockdial} "_goToFrame"]
926	set _lockdial [lreplace ${_lockdial} $idx $idx]
927	}
928
929	# ----------------------------------------------------------------------
930	# USAGE: _offsetx <x>
931	#
932	# Calculate an x coordinate that has been offsetted by a scrolled canvas
933	# ----------------------------------------------------------------------
934	itcl::body Rappture::Videodial2::_offsetx {x} {
935	set c $itk_component(minordial)
936	set w [lindex [$c cget -scrollregion] 2]
937	set x0 [lindex [$c xview] 0]
938	set offset [expr {$w*$x0}]
939	set x [expr {$x+$offset}]
940	return $x
941	}
942
943	# ----------------------------------------------------------------------
944	# USAGE: _nearestFrameMarker <x> <y>
945	#
946	# Called automatically whenever the user clicks or drags on a marker
947	# widget. Moves the selected marker to the next nearest tick mark.
948	# ----------------------------------------------------------------------
949	itcl::body Rappture::Videodial2::_nearestFrameMarker {x y} {
950
951	set c $itk_component(minordial)
952
953	foreach {junk y0 junk y1} [$c bbox "imark"] break
954	set id ""
955	# FIXME:
956	# the amount added to _imspace should be 1
957	# but for some reason the dial is slightly shifted
958	# on the canvas by 2 or 3 pixels. so we have to
959	# add a larger value like 3 to _imspace to find
960	# the next frame marker
961	set x0 [expr {$x-round((${_imspace}+3)/2.0)}]
962	set x1 [expr {$x+round((${_imspace}+3)/2.0)}]
963
964	#$c delete scrap
965	#$c create rectangle $x0 $y0 $x1 $y1 \
966	-outline green -tags "scrap"
967
968	foreach item [$c find enclosed $x0 $y0 $x1 $y1] {
969	set itemtags [$c gettags $item]
970
971	foreach {x00 junk x11 junk} [$c bbox $item] break
972
973	if {[lsearch -exact $itemtags "imark"] != -1} {
974	set id [lsearch -inline -regexp $itemtags {frame[0-9]}]
975	break
976	}
977	}
978	if {[string compare "" $id] == 0} {
979	# something went wrong
980	# we should have found an imark with
981	# an associated "frame#" tag to snap to
982	# bailout
983	#error "could not find an intermediate mark to snap marker to"
984	puts stderr "could not find an intermediate mark to snap marker to"
985	}
986
987	return $id
988
989	}
990
991	# ----------------------------------------------------------------------
992	# USAGE: _marker <tag> click <x> <y>
993	# _marker <tag> drag <x> <y>
994	# _marker <tag> release <x> <y>
995	#
996	# Called automatically whenever the user clicks or drags on a marker
997	# widget. Moves the selected marker to the next nearest tick mark.
998	# ----------------------------------------------------------------------
999	itcl::body Rappture::Videodial2::_marker {tag action x y} {
1000	set c $itk_component(minordial)
1001	switch $action {
1002	"click" {
1003	if {"currentmark" == $tag} {
1004	focus $itk_component(hull)
1005	lappend _lockdial "currentmark"
1006	}
1007	}
1008	"drag" {
1009	set x [_offsetx $x]
1010
1011	# as the marker passes over frame marks, snap to the closest frame mark
1012	set id [_nearestFrameMarker $x $y]
1013	if {"" == $id} {
1014	return
1015	}
1016
1017	if {"currentmark" == $tag} {
1018	# update the current frame shown on the screen
1019	# this doesn't quite work yet, i think because
1020	# the seek requests are buffered until the gui
1021	# is idle
1022	set newfn [_getFramenumFromId $id]
1023	set oldfn [expr round([rel2ms ${_current}])]
1024	if {$newfn != $oldfn} {
1025	_goToFrame $newfn
1026	}
1027	} else {
1028	_setmark $tag -tag $id
1029	}
1030	}
1031	"release" {
1032
1033	_marker $tag drag $x $y
1034
1035	if {"currentmark" == $tag} {
1036	set idx [lsearch -exact ${_lockdial} "currentmark"]
1037	set _lockdial [lreplace ${_lockdial} $idx $idx]
1038	}
1039
1040	# take care of cases where the mouse leaves the marker's boundries
1041	# before the button-1 has been released. we check if the last
1042	# coord was within the bounds of the marker. if not, we manually
1043	# generate the "Leave" event.
1044	set leave 1
1045	set x [_offsetx $x]
1046	foreach item [$c find overlapping $x $y $x $y] {
1047	if {[lsearch -exact [$c gettags $item] $tag] != -1} {
1048	set leave 0
1049	}
1050	}
1051	if {$leave == 1} {
1052	# FIXME:
1053	# i want to generate the event rather than
1054	# calling the function myself...
1055	# event generate $c <Leave>
1056	_bindings timeline
1057	}
1058	}
1059	}
1060	}
1061
1062	# ----------------------------------------------------------------------
1063	# USAGE: _move click <x> <y>
1064	# _move drag <x> <y>
1065	# _move release <x> <y>
1066	#
1067	# Scroll the timeline canvas based on user's b1 click, drag, and release
1068	# ----------------------------------------------------------------------
1069	itcl::body Rappture::Videodial2::_move {action x y} {
1070	switch $action {
1071	"click" {
1072	set _click(x) $x
1073	set _click(y) $y
1074	}
1075	"drag" {
1076	set c $itk_component(minordial)
1077	set dist [expr $_click(x)-$x]
1078	#$c xview scroll $dist "units"
1079	set _click(x) $x
1080	set _click(y) $y
1081
1082
1083	#set disp_min
1084	#set disp_max
1085	#_redraw $disp_min $disp_max
1086	}
1087	"release" {
1088	_move drag $x $y
1089	catch {unset _click}
1090	}
1091	}
1092	}
1093
1094	# ----------------------------------------------------------------------
1095	# USAGE: _see <item>
1096	#
1097	# from http://tcl.sourceforge.net/faqs/tk/#canvas/see
1098	# "see" method alternative for canvas
1099	# Aligns the named item as best it can in the middle of the screen
1100	#
1101	# item - a canvas tagOrId
1102	# ----------------------------------------------------------------------
1103	itcl::body Rappture::Videodial2::_see {item} {
1104	set c $itk_component(minordial)
1105	set box [$c bbox $item]
1106	if {![llength $box]} return
1107	## always properly set -scrollregion
1108	foreach {x y x1 y1} $box \
1109	{top btm} [$c yview] \
1110	{left right} [$c xview] \
1111	{p q xmax ymax} [$c cget -scrollregion] {
1112	set xpos [expr {(($x1+$x)/2.0)/$xmax - ($right-$left)/2.0}]
1113	#set ypos [expr {(($y1+$y)/2.0)/$ymax - ($btm-$top)/2.0}]
1114	}
1115	$c xview moveto $xpos
1116	#$c yview moveto $ypos
1117	}
1118
1119
1120	# ----------------------------------------------------------------------
1121	# USAGE: _navigate <offset>
1122	#
1123	# Called automatically whenever the user presses left/right keys
1124	# to nudge the current value left or right by some <offset>. If the
1125	# value actually changes, it generates a <<Value>> event to notify
1126	# clients.
1127	# ----------------------------------------------------------------------
1128	#itcl::body Rappture::Videodial2::_navigate {offset} {
1129	# set index [lsearch -exact $_values $_current]
1130	# if {$index >= 0} {
1131	# incr index $offset
1132	# if {$index >= [llength $_values]} {
1133	# set index [expr {[llength $_values]-1}]
1134	# } elseif {$index < 0} {
1135	# set index 0
1136	# }
1137	#
1138	# set newval [lindex $_values $index]
1139	# if {$newval != $_current} {
1140	# current $newval
1141	# _redraw
1142	#
1143	# event generate $itk_component(hull) <<Value>>
1144	# }
1145	# }
1146	#}
1147
1148
1149	# ----------------------------------------------------------------------
1150	# USAGE: _navigate <offset>
1151	#
1152	# Called automatically whenever the user presses left/right keys
1153	# to nudge the current value left or right by some <offset>. If the
1154	# value actually changes, it generates a <<Value>> event to notify
1155	# clients.
1156	# ----------------------------------------------------------------------
1157	itcl::body Rappture::Videodial2::_navigate {offset} {
1158	_goToFrame [expr [rel2ms ${_current}] + $offset]
1159	}
1160
1161	# ----------------------------------------------------------------------
1162	# USAGE: _fixValue ?<name1> <name2> <op>?
1163	#
1164	# Invoked automatically whenever the -variable associated with this
1165	# widget is modified. Copies the value to the current settings for
1166	# the widget.
1167	# ----------------------------------------------------------------------
1168	itcl::body Rappture::Videodial2::_fixValue {args} {
1169	if {"" == $itk_option(-variable)} {
1170	return
1171	}
1172	upvar #0 $itk_option(-variable) var
1173	_current [ms2rel $var]
1174	}
1175
1176	# ----------------------------------------------------------------------
1177	# USAGE: _fixOffsets
1178	#
1179	# ----------------------------------------------------------------------
1180	itcl::body Rappture::Videodial2::_fixOffsets {} {
1181	if {0 == $itk_option(-offset)} {
1182	return
1183	}
1184	set _offset_pos $itk_option(-offset)
1185	set _offset_neg [expr -1*$_offset_pos]
1186	bind $itk_component(hull) <KeyPress-Left> [itcl::code $this _navigate $_offset_neg]
1187	bind $itk_component(hull) <KeyPress-Right> [itcl::code $this _navigate $_offset_pos]
1188	}
1189
1190	# ----------------------------------------------------------------------
1191	# USAGE: ms2rel
1192	#
1193	# ----------------------------------------------------------------------
1194	itcl::body Rappture::Videodial2::ms2rel { value } {
1195	if { ${_max} > ${_min} } {
1196	return [expr {1.0 * ($value - ${_min}) / (${_max} - ${_min})}]
1197	}
1198	return 0
1199	}
1200
1201	# ----------------------------------------------------------------------
1202	# USAGE: rel2ms
1203	#
1204	# ----------------------------------------------------------------------
1205	itcl::body Rappture::Videodial2::rel2ms { value } {
1206	return [expr $value * (${_max} - ${_min}) + ${_min}]
1207	}
1208
1209	# ----------------------------------------------------------------------
1210	# CONFIGURE: -thickness
1211	# ----------------------------------------------------------------------
1212	itcl::configbody Rappture::Videodial2::thickness {
1213	}
1214
1215	# ----------------------------------------------------------------------
1216	# CONFIGURE: -font
1217	# ----------------------------------------------------------------------
1218	itcl::configbody Rappture::Videodial2::font {
1219	}
1220
1221	# ----------------------------------------------------------------------
1222	# CONFIGURE: -foreground
1223	# ----------------------------------------------------------------------
1224	itcl::configbody Rappture::Videodial2::foreground {
1225	after cancel [itcl::code $this _redraw]
1226	after idle [itcl::code $this _redraw]
1227	}
1228
1229	# ----------------------------------------------------------------------
1230	# CONFIGURE: -dialoutlinecolor
1231	# ----------------------------------------------------------------------
1232	itcl::configbody Rappture::Videodial2::dialoutlinecolor {
1233	after cancel [itcl::code $this _redraw]
1234	after idle [itcl::code $this _redraw]
1235	}
1236
1237	# ----------------------------------------------------------------------
1238	# CONFIGURE: -dialfillcolor
1239	# ----------------------------------------------------------------------
1240	itcl::configbody Rappture::Videodial2::dialfillcolor {
1241	after cancel [itcl::code $this _redraw]
1242	after idle [itcl::code $this _redraw]
1243	}
1244
1245	# ----------------------------------------------------------------------
1246	# CONFIGURE: -padding
1247	# This adds padding on left/right side of dial background.
1248	# ----------------------------------------------------------------------
1249	itcl::configbody Rappture::Videodial2::padding {
1250	if {[catch {winfo pixels $itk_component(hull) $itk_option(-padding)}]} {
1251	error "bad value \"$itk_option(-padding)\": should be size in pixels"
1252	}
1253	}
1254
1255	# ----------------------------------------------------------------------
1256	# CONFIGURE: -variable
1257	# ----------------------------------------------------------------------
1258	itcl::configbody Rappture::Videodial2::variable {
1259	if {"" != $_variable} {
1260	upvar #0 $_variable var
1261	trace remove variable var write [itcl::code $this _fixValue]
1262	}
1263
1264	set _variable $itk_option(-variable)
1265
1266	if {"" != $_variable} {
1267	upvar #0 $_variable var
1268	trace add variable var write [itcl::code $this _fixValue]
1269
1270	# sync to the current value of this variable
1271	if {[info exists var]} {
1272	_fixValue
1273	}
1274	}
1275	}
1276
1277	# ----------------------------------------------------------------------
1278	# CONFIGURE: -offset
1279	# ----------------------------------------------------------------------
1280	itcl::configbody Rappture::Videodial2::offset {
1281	if {![string is integer $itk_option(-offset)] &&
1282	($itk_option(-offset) < 0)} {
1283	error "bad value \"$itk_option(-offset)\": should be >= 1"
1284	}
1285	_fixOffsets
1286	}
1287
1288	# ----------------------------------------------------------------------
1289	# CONFIGURE: -min
1290	# ----------------------------------------------------------------------
1291	itcl::configbody Rappture::Videodial2::min {
1292	if {![string is integer $itk_option(-min)]} {
1293	error "bad value \"$itk_option(-min)\": should be an integer"
1294	}
1295	if {$itk_option(-min) < 0} {
1296	error "bad value \"$itk_option(-min)\": should be >= 0"
1297	}
1298	set _min $itk_option(-min)
1299	_redraw
1300	}
1301
1302	# ----------------------------------------------------------------------
1303	# CONFIGURE: -max
1304	# ----------------------------------------------------------------------
1305	itcl::configbody Rappture::Videodial2::max {
1306	if {![string is integer $itk_option(-max)]} {
1307	error "bad value \"$itk_option(-max)\": should be an integer"
1308	}
1309	if {$itk_option(-max) < 0} {
1310	error "bad value \"$itk_option(-max)\": should be >= 0"
1311	}
1312	set _max $itk_option(-max)
1313	_redraw
1314	}
1315
1316	# ----------------------------------------------------------------------
1317	# CONFIGURE: -minortick
1318	# ----------------------------------------------------------------------
1319	itcl::configbody Rappture::Videodial2::minortick {
1320	if {![string is integer $itk_option(-minortick)]} {
1321	error "bad value \"$itk_option(-minortick)\": should be an integer"
1322	}
1323	if {$itk_option(-minortick) <= 0} {
1324	error "bad value \"$itk_option(-minortick)\": should be > 0"
1325	}
1326	set _minortick $itk_option(-minortick)
1327	_redraw
1328	}
1329
1330	# ----------------------------------------------------------------------
1331	# CONFIGURE: -majortick
1332	# ----------------------------------------------------------------------
1333	itcl::configbody Rappture::Videodial2::majortick {
1334	if {![string is integer $itk_option(-majortick)]} {
1335	error "bad value \"$itk_option(-majortick)\": should be an integer"
1336	}
1337	if {$itk_option(-majortick) <= 0} {
1338	error "bad value \"$itk_option(-majortick)\": should be > 0"
1339	}
1340	set _majortick $itk_option(-majortick)
1341	_redraw
1342	}

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

Download in other formats: