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