Context Navigation

source: branches/blt4/gui/scripts/videodial.tcl @ 1932

Last change on this file since 1932 was 1932, checked in by gah, 14 years ago

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

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

Download in other formats: