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