"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/tltcl/lib/tk8.6/scale.tcl" (17 Mar 2020, 7766 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Tcl/Tk source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 # scale.tcl --
    2 #
    3 # This file defines the default bindings for Tk scale widgets and provides
    4 # procedures that help in implementing the bindings.
    5 #
    6 # Copyright (c) 1994 The Regents of the University of California.
    7 # Copyright (c) 1994-1995 Sun Microsystems, Inc.
    8 #
    9 # See the file "license.terms" for information on usage and redistribution
   10 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
   11 #
   12 
   13 #-------------------------------------------------------------------------
   14 # The code below creates the default class bindings for entries.
   15 #-------------------------------------------------------------------------
   16 
   17 # Standard Motif bindings:
   18 
   19 bind Scale <Enter> {
   20     if {$tk_strictMotif} {
   21     set tk::Priv(activeBg) [%W cget -activebackground]
   22     %W configure -activebackground [%W cget -background]
   23     }
   24     tk::ScaleActivate %W %x %y
   25 }
   26 bind Scale <Motion> {
   27     tk::ScaleActivate %W %x %y
   28 }
   29 bind Scale <Leave> {
   30     if {$tk_strictMotif} {
   31     %W configure -activebackground $tk::Priv(activeBg)
   32     }
   33     if {[%W cget -state] eq "active"} {
   34     %W configure -state normal
   35     }
   36 }
   37 bind Scale <1> {
   38     tk::ScaleButtonDown %W %x %y
   39 }
   40 bind Scale <B1-Motion> {
   41     tk::ScaleDrag %W %x %y
   42 }
   43 bind Scale <B1-Leave> { }
   44 bind Scale <B1-Enter> { }
   45 bind Scale <ButtonRelease-1> {
   46     tk::CancelRepeat
   47     tk::ScaleEndDrag %W
   48     tk::ScaleActivate %W %x %y
   49 }
   50 bind Scale <2> {
   51     tk::ScaleButton2Down %W %x %y
   52 }
   53 bind Scale <B2-Motion> {
   54     tk::ScaleDrag %W %x %y
   55 }
   56 bind Scale <B2-Leave> { }
   57 bind Scale <B2-Enter> { }
   58 bind Scale <ButtonRelease-2> {
   59     tk::CancelRepeat
   60     tk::ScaleEndDrag %W
   61     tk::ScaleActivate %W %x %y
   62 }
   63 if {[tk windowingsystem] eq "win32"} {
   64     # On Windows do the same with button 3, as that is the right mouse button
   65     bind Scale <3>      [bind Scale <2>]
   66     bind Scale <B3-Motion>  [bind Scale <B2-Motion>]
   67     bind Scale <B3-Leave>   [bind Scale <B2-Leave>]
   68     bind Scale <B3-Enter>   [bind Scale <B2-Enter>]
   69     bind Scale <ButtonRelease-3> [bind Scale <ButtonRelease-2>]
   70 }
   71 bind Scale <Control-1> {
   72     tk::ScaleControlPress %W %x %y
   73 }
   74 bind Scale <<PrevLine>> {
   75     tk::ScaleIncrement %W up little noRepeat
   76 }
   77 bind Scale <<NextLine>> {
   78     tk::ScaleIncrement %W down little noRepeat
   79 }
   80 bind Scale <<PrevChar>> {
   81     tk::ScaleIncrement %W up little noRepeat
   82 }
   83 bind Scale <<NextChar>> {
   84     tk::ScaleIncrement %W down little noRepeat
   85 }
   86 bind Scale <<PrevPara>> {
   87     tk::ScaleIncrement %W up big noRepeat
   88 }
   89 bind Scale <<NextPara>> {
   90     tk::ScaleIncrement %W down big noRepeat
   91 }
   92 bind Scale <<PrevWord>> {
   93     tk::ScaleIncrement %W up big noRepeat
   94 }
   95 bind Scale <<NextWord>> {
   96     tk::ScaleIncrement %W down big noRepeat
   97 }
   98 bind Scale <<LineStart>> {
   99     %W set [%W cget -from]
  100 }
  101 bind Scale <<LineEnd>> {
  102     %W set [%W cget -to]
  103 }
  104 
  105 # ::tk::ScaleActivate --
  106 # This procedure is invoked to check a given x-y position in the
  107 # scale and activate the slider if the x-y position falls within
  108 # the slider.
  109 #
  110 # Arguments:
  111 # w -       The scale widget.
  112 # x, y -    Mouse coordinates.
  113 
  114 proc ::tk::ScaleActivate {w x y} {
  115     if {[$w cget -state] eq "disabled"} {
  116     return
  117     }
  118     if {[$w identify $x $y] eq "slider"} {
  119     set state active
  120     } else {
  121     set state normal
  122     }
  123     if {[$w cget -state] ne $state} {
  124     $w configure -state $state
  125     }
  126 }
  127 
  128 # ::tk::ScaleButtonDown --
  129 # This procedure is invoked when a button is pressed in a scale.  It
  130 # takes different actions depending on where the button was pressed.
  131 #
  132 # Arguments:
  133 # w -       The scale widget.
  134 # x, y -    Mouse coordinates of button press.
  135 
  136 proc ::tk::ScaleButtonDown {w x y} {
  137     variable ::tk::Priv
  138     set Priv(dragging) 0
  139     set el [$w identify $x $y]
  140 
  141     # save the relief
  142     set Priv($w,relief) [$w cget -sliderrelief]
  143 
  144     if {$el eq "trough1"} {
  145     ScaleIncrement $w up little initial
  146     } elseif {$el eq "trough2"} {
  147     ScaleIncrement $w down little initial
  148     } elseif {$el eq "slider"} {
  149     set Priv(dragging) 1
  150     set Priv(initValue) [$w get]
  151     set coords [$w coords]
  152     set Priv(deltaX) [expr {$x - [lindex $coords 0]}]
  153     set Priv(deltaY) [expr {$y - [lindex $coords 1]}]
  154         switch -exact -- $Priv($w,relief) {
  155             "raised" { $w configure -sliderrelief sunken }
  156             "ridge"  { $w configure -sliderrelief groove }
  157         }
  158     }
  159 }
  160 
  161 # ::tk::ScaleDrag --
  162 # This procedure is called when the mouse is dragged with
  163 # mouse button 1 down.  If the drag started inside the slider
  164 # (i.e. the scale is active) then the scale's value is adjusted
  165 # to reflect the mouse's position.
  166 #
  167 # Arguments:
  168 # w -       The scale widget.
  169 # x, y -    Mouse coordinates.
  170 
  171 proc ::tk::ScaleDrag {w x y} {
  172     variable ::tk::Priv
  173     if {!$Priv(dragging)} {
  174     return
  175     }
  176     $w set [$w get [expr {$x-$Priv(deltaX)}] [expr {$y-$Priv(deltaY)}]]
  177 }
  178 
  179 # ::tk::ScaleEndDrag --
  180 # This procedure is called to end an interactive drag of the
  181 # slider.  It just marks the drag as over.
  182 #
  183 # Arguments:
  184 # w -       The scale widget.
  185 
  186 proc ::tk::ScaleEndDrag {w} {
  187     variable ::tk::Priv
  188     set Priv(dragging) 0
  189     if {[info exists Priv($w,relief)]} {
  190         $w configure -sliderrelief $Priv($w,relief)
  191         unset Priv($w,relief)
  192     }
  193 }
  194 
  195 # ::tk::ScaleIncrement --
  196 # This procedure is invoked to increment the value of a scale and
  197 # to set up auto-repeating of the action if that is desired.  The
  198 # way the value is incremented depends on the "dir" and "big"
  199 # arguments.
  200 #
  201 # Arguments:
  202 # w -       The scale widget.
  203 # dir -     "up" means move value towards -from, "down" means
  204 #       move towards -to.
  205 # big -     Size of increments: "big" or "little".
  206 # repeat -  Whether and how to auto-repeat the action:  "noRepeat"
  207 #       means don't auto-repeat, "initial" means this is the
  208 #       first action in an auto-repeat sequence, and "again"
  209 #       means this is the second repetition or later.
  210 
  211 proc ::tk::ScaleIncrement {w dir big repeat} {
  212     variable ::tk::Priv
  213     if {![winfo exists $w]} return
  214     if {$big eq "big"} {
  215     set inc [$w cget -bigincrement]
  216     if {$inc == 0} {
  217         set inc [expr {abs([$w cget -to] - [$w cget -from])/10.0}]
  218     }
  219     if {$inc < [$w cget -resolution]} {
  220         set inc [$w cget -resolution]
  221     }
  222     } else {
  223     set inc [$w cget -resolution]
  224     }
  225     if {([$w cget -from] > [$w cget -to]) ^ ($dir eq "up")} {
  226         if {$inc > 0} {
  227             set inc [expr {-$inc}]
  228         }
  229     } else {
  230         if {$inc < 0} {
  231             set inc [expr {-$inc}]
  232         }
  233     }
  234     $w set [expr {[$w get] + $inc}]
  235 
  236     if {$repeat eq "again"} {
  237     set Priv(afterId) [after [$w cget -repeatinterval] \
  238         [list tk::ScaleIncrement $w $dir $big again]]
  239     } elseif {$repeat eq "initial"} {
  240     set delay [$w cget -repeatdelay]
  241     if {$delay > 0} {
  242         set Priv(afterId) [after $delay \
  243             [list tk::ScaleIncrement $w $dir $big again]]
  244     }
  245     }
  246 }
  247 
  248 # ::tk::ScaleControlPress --
  249 # This procedure handles button presses that are made with the Control
  250 # key down.  Depending on the mouse position, it adjusts the scale
  251 # value to one end of the range or the other.
  252 #
  253 # Arguments:
  254 # w -       The scale widget.
  255 # x, y -    Mouse coordinates where the button was pressed.
  256 
  257 proc ::tk::ScaleControlPress {w x y} {
  258     set el [$w identify $x $y]
  259     if {$el eq "trough1"} {
  260     $w set [$w cget -from]
  261     } elseif {$el eq "trough2"} {
  262     $w set [$w cget -to]
  263     }
  264 }
  265 
  266 # ::tk::ScaleButton2Down
  267 # This procedure is invoked when button 2 is pressed over a scale.
  268 # It sets the value to correspond to the mouse position and starts
  269 # a slider drag.
  270 #
  271 # Arguments:
  272 # w -       The scrollbar widget.
  273 # x, y -    Mouse coordinates within the widget.
  274 
  275 proc ::tk::ScaleButton2Down {w x y} {
  276     variable ::tk::Priv
  277 
  278     if {[$w cget -state] eq "disabled"} {
  279     return
  280     }
  281 
  282     $w configure -state active
  283     $w set [$w get $x $y]
  284     set Priv(dragging) 1
  285     set Priv(initValue) [$w get]
  286     set Priv($w,relief) [$w cget -sliderrelief]
  287     set coords "$x $y"
  288     set Priv(deltaX) 0
  289     set Priv(deltaY) 0
  290 }