~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

Open Mash Cross Reference
mash/tcl/applications/collaborator/ui-rover.tcl

Component: ~ [ mash ] ~ [ apps ] ~ [ gsm ] ~ [ lib ] ~ [ otcl ] ~ [ srm ] ~ [ tcl8.3 ] ~ [ tclcl ] ~ [ tk8.3 ] ~ [ tutorials ] ~

  1 # ui-rover.tcl --
  2 #
  3 #       FIXME: This file needs a description here.
  4 #
  5 # Copyright (c) 1998-2002 The Regents of the University of California.
  6 # All rights reserved.
  7 #
  8 # Redistribution and use in source and binary forms, with or without
  9 # modification, are permitted provided that the following conditions are met:
 10 #
 11 # A. Redistributions of source code must retain the above copyright notice,
 12 #    this list of conditions and the following disclaimer.
 13 # B. Redistributions in binary form must reproduce the above copyright notice,
 14 #    this list of conditions and the following disclaimer in the documentation
 15 #    and/or other materials provided with the distribution.
 16 # C. Neither the names of the copyright holders nor the names of its
 17 #    contributors may be used to endorse or promote products derived from this
 18 #    software without specific prior written permission.
 19 #
 20 # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
 21 # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 22 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 23 # ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE FOR
 24 # ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 25 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 26 # SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 27 # CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 28 # OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 29 # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 30 #
 31 #  @(#) $Header: /usr/mash/src/repository/mash/mash-1/tcl/applications/collaborator/ui-rover.tcl,v 1.5 2002/02/03 04:21:46 lim Exp $
 32 
 33 
 34 WidgetClass RoverPanel -default {
 35         { *borderWidth 1 }
 36 }
 37 
 38 
 39 RoverPanel public destroy { } {
 40         $self instvar timer_id_
 41         if [info exists timer_id_] {
 42                 after cancel $timer_id_
 43         }
 44 }
 45 
 46 
 47 RoverPanel public build_widget { w } {
 48         set f [$self get_option helv10o]
 49         menubutton $w.bookmarks -image CollaboratorIcons(bookmark) \
 50                         -relief raised -bd 2 -menu $w.bookmarks.menu \
 51                         -state disabled
 52         set bm_menu [menu $w.bookmarks.menu]
 53         $bm_menu add command -label "Add bookmark" -state disabled
 54         $bm_menu add command -label "Edit bookmarks" -state disabled
 55         $bm_menu add separator
 56         $self set_subwidget bm_menu $bm_menu
 57 
 58         button $w.play_pause -image VcrIcons(play) -highlightthickness 0 \
 59                         -state disabled -command "\[$self set client_\] \
 60                         play_or_pause \[set \[$self tkvarname offset_\]\]"
 61         scale $w.slider -state disabled -orient horizontal \
 62                         -from 0 -to 100 -font $f -showvalue true \
 63                         -variable [$self tkvarname offset_] \
 64                         -command "$self slider_moved_interactively"
 65         pack $w.bookmarks $w.play_pause -side left -anchor n -padx 1 -pady 1
 66         pack $w.slider -side left -fill both -expand 1
 67 }
 68 
 69 
 70 RoverPanel public ssac_client { c } {
 71         $self set client_ $c
 72 }
 73 
 74 
 75 RoverPanel public slider_moved_interactively { offset } {
 76         $self instvar client_
 77         if { [$self subwidget play_pause cget -image] == "VcrIcons(pause)" } {
 78                 # the button displays PAUSE, i.e. we are currently in PLAY mode
 79                 $client_ send PLAY [expr int($offset)] 1
 80         }
 81 }
 82 
 83 
 84 RoverPanel public move_slider { offset } {
 85         $self instvar timer_id_
 86         if { [$self subwidget play_pause cget -image] == "VcrIcons(pause)" } {
 87                 # the button displays PAUSE, i.e. we are currently in PLAY mode
 88                 $self tkvar offset_
 89                 set offset_ $offset
 90         }
 91         if [info exists timer_id_] { after cancel $timer_id_ }
 92         set timer_id_ [after 2000 "$self update_slider"]
 93 }
 94 
 95 
 96 RoverPanel public update_slider { } {
 97         $self instvar timer_id_
 98         if { [$self subwidget play_pause cget -image] == "VcrIcons(pause)" } {
 99                 # the button displays PAUSE, i.e. we are currently in PLAY mode
100                 $self tkvar offset_
101                 set offset_ [expr $offset_ + 2]
102         }
103         set timer_id_ [after 2000 "$self update_slider"]
104 }
105 
106 
107 RoverPanel public activate_slider { start end } {
108         set path [$self info path]
109         set mf [$self get_option medfont]
110         $path.slider configure -state normal -font $mf \
111                         -from 0 -to [expr int($end -$start)] \
112                         -tickinterval [expr int(0.49 * ($end - $start))]
113         $path.play_pause configure -state normal
114         $path.bookmarks configure -state normal
115 
116         $self instvar timer_id_
117         set timer_id_ [after 2000 "$self update_slider"]
118 }
119 
120 
121 RoverPanel public play_update { state } {
122         $self subwidget play_pause configure -image \
123                         VcrIcons([string tolower $state])
124 }
125 
126 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~ [ freetext search ] ~ [ file search ] ~

This page was automatically generated by the LXR engine.
Visit the LXR main site for more information.