home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / gprocs / slider.icn < prev    next >
Text File  |  2000-07-29  |  6KB  |  211 lines
  1. ############################################################################
  2. #
  3. #    File:     slider.icn
  4. #
  5. #    Subject:  Procedures for slider sensors
  6. #
  7. #    Author:   Gregg M. Townsend
  8. #
  9. #    Date:     August 14, 1996
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #    These procedures implement slider using the "evmux" event
  18. #    multiplexor instead of the usual vidget library.
  19. #
  20. #    slider(win, proc, arg, x, y, w, h, lb, iv, ub)  creates a slider.
  21. #
  22. #    slidervalue(h, v)            modifies a slider's value.
  23. #
  24. ############################################################################
  25. #
  26. #  slider(win, proc, arg, x, y, w, h, lb, iv, ub)
  27. #
  28. #    establishes a slider and returns a handle for use with slidervalue().
  29. #
  30. #    x,y,w,h give the dimensions of the slider.  The slider runs vertically
  31. #    or horizontally depending on which of w and h is larger.  20 makes a
  32. #    nice width (or height).
  33. #
  34. #    lb and ub give the range of real values represented by the slider;
  35. #    lb is the left or bottom end.  iv is the initial value.
  36. #    proc(win, arg, value) is called as the slider is dragged to different
  37. #    positions.
  38. #
  39. #  slidervalue(h, v)
  40. #
  41. #    changes the position of the slider h to reflect value v.
  42. #    The underlying action procedure is not called.
  43. #
  44. ############################################################################
  45. #
  46. #  Example:  A simple color picker
  47. #
  48. #    record color(red, green, blue)
  49. #    global win, spot
  50. #
  51. #        ...
  52. #        Fg(win, spot := NewColor(win))
  53. #        Color(win, spot, "gray50")
  54. #        FillArc(win, 10, 10, 100, 100)
  55. #        Fg(win, "black")
  56. #        h1 := slider(win, setcolor, 1, 110, 10, 20, 100, 0, 32767, 65535)
  57. #        h2 := slider(win, setcolor, 2, 140, 10, 20, 100, 0, 32767, 65535)
  58. #        h3 := slider(win, setcolor, 3, 170, 10, 20, 100, 0, 32767, 65535)
  59. #        ...
  60. #
  61. #    procedure setcolor(win, n, v)
  62. #        static fg
  63. #        initial fg := color(32767, 32767, 32767)
  64. #        fg[n] := v
  65. #        Color(win, spot, fg.red || "," || fg.green || "," || fg.blue)
  66. #    end
  67. #
  68. #    Draw a filled circle in a mutable color that is initially gray.
  69. #    Draw three parallel, vertical sliders of size 20 x 100.  Their values
  70. #    run from 0 to 65535 and they are each initialized at the midpoint.
  71. #    (The values are only used internally; the sliders are unlabeled.)
  72. #
  73. #    When one of the sliders is moved, call setcolor(win, n, v).
  74. #    n, from the "arg" value when it was built, identifies the slider.
  75. #    v is the new value of the slider.   Setcolor uses the resulting
  76. #    color triple to set the color of the mutable color "spot".
  77. #
  78. #    Additional calls
  79. #        every slidervalue(h1 | h2 | h3, 32767)
  80. #        every setcolor(win, 1 to 3, 32767)
  81. #    would reset the original gray color.  Note that explicit calls to
  82. #     setcolor are needed because slidervalue does not call it.
  83. #
  84. ############################################################################
  85. #
  86. #  Links: evmux, graphics
  87. #
  88. ############################################################################
  89. #
  90. #  Requires:  Version 9 graphics
  91. #
  92. ############################################################################
  93. #
  94. #  See also:  evmux.icn
  95. #
  96. ############################################################################
  97.  
  98. link evmux
  99. link graphics
  100.  
  101. $define MARGIN 10
  102.  
  103. record Slider_Rec(win, proc, arg, x, y, w, h, lb, ub, n)
  104.  
  105. procedure slider(win, proc, arg, x, y, w, h, lb, iv, ub)
  106.    local r
  107.  
  108.    r := Slider_Rec(win, proc, arg, x, y, w, h, lb, ub)
  109.    slidervalue(r, iv)
  110.    if h > w then     # vertical slider
  111.       sensor(win, &lpress, Exec_Vert_Slider, r, x, y - MARGIN, w, h + 2*MARGIN)
  112.    else            # horizontal slider
  113.       sensor(win, &lpress, Exec_Horiz_Slider, r, x - MARGIN, y, w + 2*MARGIN, h)
  114.    return r
  115. end
  116.  
  117. procedure slidervalue(r, v)
  118.    local n
  119.  
  120.    Erase_Slider_Bar(r)            # erase old handle
  121.    if r.lb ~= r.ub then
  122.       v := real(v - r.lb) / (r.ub - r.lb)
  123.    else
  124.       v := 0.0
  125.    v <:= 0.0
  126.    v >:= 1.0
  127.    if r.h > r.w then            # if vertical
  128.       n := r.y + integer((1.0 - v) * (r.h - 1) + 0.5)
  129.    else
  130.       n := r.x + integer(v * (r.w - 1) + 0.5)
  131.    Set_Slider_Posn(r, n)        # redraw track and handle
  132.    return
  133. end
  134.  
  135. procedure Set_Slider_Posn(r, n)
  136.    local c
  137.  
  138.    r.n := n
  139.    if r.h > r.w then {
  140.       c := r.x + r.w / 2
  141.       BevelRectangle(r.win, c - 2, r.y, 4, r.h, -2)    # vertical track
  142.       BevelRectangle(r.win, r.x, r.n - 3, r.w, 6)    # horizontal bar
  143.       FillRectangle(r.win, r.x + 2, r.n - 1, r.w - 4, 2)
  144.       }
  145.    else {
  146.       c := r.y + r.h / 2
  147.       BevelRectangle(r.win, r.x, c - 2, r.w, 4, -2)    # horizontal track
  148.       BevelRectangle(r.win, r.n - 3, r.y, 6, r.h)    # vertical bar
  149.       FillRectangle(r.win, r.n - 1, r.y + 2, 2, r.h - 4)
  150.       }
  151.    return
  152. end
  153.  
  154. procedure Erase_Slider_Bar(r)
  155.    if r.h > r.w then
  156.       EraseArea(r.win, r.x, \r.n - 3, r.w, 6)    # horizontal bar on vert. track
  157.    else
  158.       EraseArea(r.win, \r.n - 3, r.y, 6, r.h)    # vertical bar on horiz. track
  159.    return
  160. end
  161.  
  162. procedure Exec_Vert_Slider(win, r, x, y)
  163.    local e, h, u, args, a, v
  164.  
  165.    e := &lpress
  166.    repeat {
  167.       if type(e) == "integer" then {    # if a mouse event
  168.          y <:= r.y
  169.          y >:= r.y + r.h - 1
  170.          if y ~= r.n then {
  171.             Erase_Slider_Bar(r)
  172.             Set_Slider_Posn(r, y)
  173.             flush(r.win)
  174.             v := real(r.y + r.h - y - 1) / real(r.h - 1)    # 0.0 to 1.0
  175.             v := v * (r.ub - r.lb) + r.lb            # user range
  176.             r.proc(win, r.arg, v)
  177.             }
  178.          if e = &lrelease then
  179.             return
  180.          }
  181.       e := Event(win)
  182.       y := &y
  183.       }
  184.    return
  185. end
  186.  
  187. procedure Exec_Horiz_Slider(win, r, x, y)
  188.    local e, h, u, args, a, v
  189.  
  190.    e := &lpress
  191.    repeat {
  192.       if type(e) == "integer" then {    # if a mouse event
  193.          x <:= r.x
  194.          x >:= r.x + r.w - 1
  195.          if x ~= r.n then {
  196.             Erase_Slider_Bar(r)
  197.             Set_Slider_Posn(r, x)
  198.             flush(r.win)
  199.             v := real(x - r.x) / real(r.w - 1)        # 0.0 to 1.0
  200.             v := v * (r.ub - r.lb) + r.lb        # user range
  201.             r.proc(win, r.arg, v)
  202.             }
  203.          if e = &lrelease then
  204.             return
  205.          }
  206.       e := Event(win)
  207.       x := &x
  208.       }
  209.    return
  210. end
  211.