Context Navigation

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

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

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

Download in other formats: