Context Navigation

source: branches/1.3/gui/scripts/videodial2.tcl @ 4918

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

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

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

Download in other formats: