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