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

Last change on this file since 5896 was 5659, checked in by ldelgass, 9 years ago

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