home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / library / scale.tcl < prev    next >
Encoding:
Text File  |  1995-06-08  |  5.9 KB  |  236 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.7 95/05/05 16:56:09
  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.     tkScaleButtonDown %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.     }
  143. }
  144.  
  145. # tkScaleDrag --
  146. # This procedure is called when the mouse is dragged with
  147. # mouse button 1 down.  If the drag started inside the slider
  148. # (i.e. the scale is active) then the scale's value is adjusted
  149. # to reflect the mouse's position.
  150. #
  151. # Arguments:
  152. # w -        The scale widget.
  153. # x, y -    Mouse coordinates.
  154.  
  155. proc tkScaleDrag {w x y} {
  156.     global tkPriv
  157.     if !$tkPriv(dragging) {
  158.     return
  159.     }
  160.     $w set [$w get [expr $x - $tkPriv(deltaX)] \
  161.         [expr $y - $tkPriv(deltaY)]]
  162. }
  163.  
  164. # tkScaleEndDrag --
  165. # This procedure is called to end an interactive drag of the
  166. # slider.  It just marks the drag as over.
  167. #
  168. # Arguments:
  169. # w -        The scale widget.
  170.  
  171. proc tkScaleEndDrag {w} {
  172.     global tkPriv
  173.     set tkPriv(dragging) 0
  174. }
  175.  
  176. # tkScaleIncrement --
  177. # This procedure is invoked to increment the value of a scale and
  178. # to set up auto-repeating of the action if that is desired.  The
  179. # way the value is incremented depends on the "dir" and "big"
  180. # arguments.
  181. #
  182. # Arguments:
  183. # w -        The scale widget.
  184. # dir -        "up" means move value towards -from, "down" means
  185. #        move towards -to.
  186. # big -        Size of increments: "big" or "little".
  187. # repeat -    Whether and how to auto-repeat the action:  "noRepeat"
  188. #        means don't auto-repeat, "initial" means this is the
  189. #        first action in an auto-repeat sequence, and "again"
  190. #        means this is the second repetition or later.
  191.  
  192. proc tkScaleIncrement {w dir big repeat} {
  193.     global tkPriv
  194.     if {$big == "big"} {
  195.     set inc [$w cget -bigincrement]
  196.     if {$inc == 0} {
  197.         set inc [expr abs([$w cget -to] - [$w cget -from])/10.0]
  198.     }
  199.     if {$inc < [$w cget -resolution]} {
  200.         set inc [$w cget -resolution]
  201.     }
  202.     } else {
  203.     set inc [$w cget -resolution]
  204.     }
  205.     if {([$w cget -from] > [$w cget -to]) ^ ($dir == "up")} {
  206.     set inc [expr -$inc]
  207.     }
  208.     $w set [expr [$w get] + $inc]
  209.  
  210.     if {$repeat == "again"} {
  211.     set tkPriv(afterId) [after [$w cget -repeatinterval] \
  212.         tkScaleIncrement $w $dir $big again]
  213.     } elseif {$repeat == "initial"} {
  214.     set tkPriv(afterId) [after [$w cget -repeatdelay] \
  215.         tkScaleIncrement $w $dir $big again]
  216.     }
  217. }
  218.  
  219. # tkScaleControlPress --
  220. # This procedure handles button presses that are made with the Control
  221. # key down.  Depending on the mouse position, it adjusts the scale
  222. # value to one end of the range or the other.
  223. #
  224. # Arguments:
  225. # w -        The scale widget.
  226. # x, y -    Mouse coordinates where the button was pressed.
  227.  
  228. proc tkScaleControlPress {w x y} {
  229.     set el [$w identify $x $y]
  230.     if {$el == "trough1"} {
  231.     $w set [$w cget -from]
  232.     } elseif {$el == "trough2"} {
  233.     $w set [$w cget -to]
  234.     }
  235. }
  236.