home *** CD-ROM | disk | FTP | other *** search
/ The Best of Windows 95.com 1996 September / WIN95_09962.iso / vrml / cp2b2x.exe / DATA.Z / scale.tcl < prev    next >
Text File  |  1996-04-23  |  7KB  |  265 lines
  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. # @(#) scale.tcl 1.10 95/09/26 16:45:00
  7. #
  8. # Copyright (c) 1994 The Regents of the University of California.
  9. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  10. #
  11. # See the file "license.terms" for information on usage and redistribution
  12. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  13. #
  14.  
  15. #-------------------------------------------------------------------------
  16. # The code below creates the default class bindings for entries.
  17. #-------------------------------------------------------------------------
  18.  
  19. # Standard Motif bindings:
  20.  
  21. bind Scale <Enter> {
  22.     if $tk_strictMotif {
  23.     set tkPriv(activeBg) [%W cget -activebackground]
  24.     %W config -activebackground [%W cget -background]
  25.     }
  26.     tkScaleActivate %W %x %y
  27. }
  28. bind Scale <Motion> {
  29.     tkScaleActivate %W %x %y
  30. }
  31. bind Scale <Leave> {
  32.     if $tk_strictMotif {
  33.     %W config -activebackground $tkPriv(activeBg)
  34.     }
  35.     if {[%W cget -state] == "active"} {
  36.     %W configure -state normal
  37.     }
  38. }
  39. bind Scale <1> {
  40.     tkScaleButtonDown %W %x %y
  41. }
  42. bind Scale <B1-Motion> {
  43.     tkScaleDrag %W %x %y
  44. }
  45. bind Scale <B1-Leave> { }
  46. bind Scale <B1-Enter> { }
  47. bind Scale <ButtonRelease-1> {
  48.     tkCancelRepeat
  49.     tkScaleEndDrag %W
  50.     tkScaleActivate %W %x %y
  51. }
  52. bind Scale <2> {
  53.     tkScaleButton2Down %W %x %y
  54. }
  55. bind Scale <B2-Motion> {
  56.     tkScaleDrag %W %x %y
  57. }
  58. bind Scale <B2-Leave> { }
  59. bind Scale <B2-Enter> { }
  60. bind Scale <ButtonRelease-2> {
  61.     tkCancelRepeat
  62.     tkScaleEndDrag %W
  63.     tkScaleActivate %W %x %y
  64. }
  65. bind Scale <Control-1> {
  66.     tkScaleControlPress %W %x %y
  67. }
  68. bind Scale <Up> {
  69.     tkScaleIncrement %W up little noRepeat
  70. }
  71. bind Scale <Down> {
  72.     tkScaleIncrement %W down little noRepeat
  73. }
  74. bind Scale <Left> {
  75.     tkScaleIncrement %W up little noRepeat
  76. }
  77. bind Scale <Right> {
  78.     tkScaleIncrement %W down little noRepeat
  79. }
  80. bind Scale <Control-Up> {
  81.     tkScaleIncrement %W up big noRepeat
  82. }
  83. bind Scale <Control-Down> {
  84.     tkScaleIncrement %W down big noRepeat
  85. }
  86. bind Scale <Control-Left> {
  87.     tkScaleIncrement %W up big noRepeat
  88. }
  89. bind Scale <Control-Right> {
  90.     tkScaleIncrement %W down big noRepeat
  91. }
  92. bind Scale <Home> {
  93.     %W set [%W cget -from]
  94. }
  95. bind Scale <End> {
  96.     %W set [%W cget -to]
  97. }
  98.  
  99. # tkScaleActivate --
  100. # This procedure is invoked to check a given x-y position in the
  101. # scale and activate the slider if the x-y position falls within
  102. # the slider.
  103. #
  104. # Arguments:
  105. # w -        The scale widget.
  106. # x, y -    Mouse coordinates.
  107.  
  108. proc tkScaleActivate {w x y} {
  109.     global tkPriv
  110.     if {[$w cget -state] == "disabled"} {
  111.     return;
  112.     }
  113.     if {[$w identify $x $y] == "slider"} {
  114.     $w configure -state active
  115.     } else {
  116.     $w configure -state normal
  117.     }
  118. }
  119.  
  120. # tkScaleButtonDown --
  121. # This procedure is invoked when a button is pressed in a scale.  It
  122. # takes different actions depending on where the button was pressed.
  123. #
  124. # Arguments:
  125. # w -        The scale widget.
  126. # x, y -    Mouse coordinates of button press.
  127.  
  128. proc tkScaleButtonDown {w x y} {
  129.     global tkPriv
  130.     set tkPriv(dragging) 0
  131.     set el [$w identify $x $y]
  132.     if {$el == "trough1"} {
  133.     tkScaleIncrement $w up little initial
  134.     } elseif {$el == "trough2"} {
  135.     tkScaleIncrement $w down little initial
  136.     } elseif {$el == "slider"} {
  137.     set tkPriv(dragging) 1
  138.     set tkPriv(initValue) [$w get]
  139.     set coords [$w coords]
  140.     set tkPriv(deltaX) [expr $x - [lindex $coords 0]]
  141.     set tkPriv(deltaY) [expr $y - [lindex $coords 1]]
  142.     $w configure -sliderrelief sunken
  143.     }
  144. }
  145.  
  146. # tkScaleDrag --
  147. # This procedure is called when the mouse is dragged with
  148. # mouse button 1 down.  If the drag started inside the slider
  149. # (i.e. the scale is active) then the scale's value is adjusted
  150. # to reflect the mouse's position.
  151. #
  152. # Arguments:
  153. # w -        The scale widget.
  154. # x, y -    Mouse coordinates.
  155.  
  156. proc tkScaleDrag {w x y} {
  157.     global tkPriv
  158.     if !$tkPriv(dragging) {
  159.     return
  160.     }
  161.     $w set [$w get [expr $x - $tkPriv(deltaX)] \
  162.         [expr $y - $tkPriv(deltaY)]]
  163. }
  164.  
  165. # tkScaleEndDrag --
  166. # This procedure is called to end an interactive drag of the
  167. # slider.  It just marks the drag as over.
  168. #
  169. # Arguments:
  170. # w -        The scale widget.
  171.  
  172. proc tkScaleEndDrag {w} {
  173.     global tkPriv
  174.     set tkPriv(dragging) 0
  175.     $w configure -sliderrelief raised
  176. }
  177.  
  178. # tkScaleIncrement --
  179. # This procedure is invoked to increment the value of a scale and
  180. # to set up auto-repeating of the action if that is desired.  The
  181. # way the value is incremented depends on the "dir" and "big"
  182. # arguments.
  183. #
  184. # Arguments:
  185. # w -        The scale widget.
  186. # dir -        "up" means move value towards -from, "down" means
  187. #        move towards -to.
  188. # big -        Size of increments: "big" or "little".
  189. # repeat -    Whether and how to auto-repeat the action:  "noRepeat"
  190. #        means don't auto-repeat, "initial" means this is the
  191. #        first action in an auto-repeat sequence, and "again"
  192. #        means this is the second repetition or later.
  193.  
  194. proc tkScaleIncrement {w dir big repeat} {
  195.     global tkPriv
  196.     if {$big == "big"} {
  197.     set inc [$w cget -bigincrement]
  198.     if {$inc == 0} {
  199.         set inc [expr abs([$w cget -to] - [$w cget -from])/10.0]
  200.     }
  201.     if {$inc < [$w cget -resolution]} {
  202.         set inc [$w cget -resolution]
  203.     }
  204.     } else {
  205.     set inc [$w cget -resolution]
  206.     }
  207.     if {([$w cget -from] > [$w cget -to]) ^ ($dir == "up")} {
  208.     set inc [expr -$inc]
  209.     }
  210.     $w set [expr [$w get] + $inc]
  211.  
  212.     if {$repeat == "again"} {
  213.     set tkPriv(afterId) [after [$w cget -repeatinterval] \
  214.         tkScaleIncrement $w $dir $big again]
  215.     } elseif {$repeat == "initial"} {
  216.     set delay [$w cget -repeatdelay]
  217.     if {$delay > 0} {
  218.         set tkPriv(afterId) [after $delay \
  219.             tkScaleIncrement $w $dir $big again]
  220.     }
  221.     }
  222. }
  223.  
  224. # tkScaleControlPress --
  225. # This procedure handles button presses that are made with the Control
  226. # key down.  Depending on the mouse position, it adjusts the scale
  227. # value to one end of the range or the other.
  228. #
  229. # Arguments:
  230. # w -        The scale widget.
  231. # x, y -    Mouse coordinates where the button was pressed.
  232.  
  233. proc tkScaleControlPress {w x y} {
  234.     set el [$w identify $x $y]
  235.     if {$el == "trough1"} {
  236.     $w set [$w cget -from]
  237.     } elseif {$el == "trough2"} {
  238.     $w set [$w cget -to]
  239.     }
  240. }
  241.  
  242. # tkScaleButton2Down
  243. # This procedure is invoked when button 2 is pressed over a scale.
  244. # It sets the value to correspond to the mouse position and starts
  245. # a slider drag.
  246. #
  247. # Arguments:
  248. # w -        The scrollbar widget.
  249. # x, y -    Mouse coordinates within the widget.
  250.  
  251. proc tkScaleButton2Down {w x y} {
  252.     global tkPriv
  253.  
  254.     if {[$w cget -state] == "disabled"} {
  255.     return;
  256.     }
  257.     $w configure -state active
  258.     $w set [$w get $x $y]
  259.     set tkPriv(dragging) 1
  260.     set tkPriv(initValue) [$w get]
  261.     set coords "$x $y"
  262.     set tkPriv(deltaX) 0
  263.     set tkPriv(deltaY) 0
  264. }
  265.