Context Navigation

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

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

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

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

Download in other formats: