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 / vslider.icn < prev    next >
Text File  |  2000-07-29  |  11KB  |  388 lines
  1. ############################################################################
  2. #
  3. #    File:     vslider.icn
  4. #
  5. #    Subject:  Procedures for sliders
  6. #
  7. #    Authors:  Jon Lipp and Gregg M. Townsend
  8. #
  9. #    Date:     April 1, 1997
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  Vidgets defined in this file:
  18. #    Vvslider
  19. #    Vhslider
  20. #
  21. #  Utility procedures in this file:
  22. #    Vvert_slider()
  23. #    Vhoriz_slider()
  24. #
  25. ############################################################################
  26. #
  27. #  Includes: vdefns.icn
  28. #
  29. ############################################################################
  30. #
  31. #  Links:  vidgets
  32. #
  33. ############################################################################
  34.  
  35. link vidgets
  36.  
  37. $include "vdefns.icn"
  38.  
  39. record Vslider_rec (win, callback, id, aw, ah, discont,
  40.    ax, ay, data, pad, ws, cv_range, rev, pos, uid, drawn, P, V)
  41.  
  42. ############################################################################
  43. # Vvslider
  44. ############################################################################
  45.  
  46. procedure procs_Vvslider()
  47.    static procs
  48.    initial procs := Vstd(event_Vvslider, draw_Vvslider, outline_Vslider,
  49.                         resize_Vvslider, inrange_Vpane, init_Vvslider,
  50.                         couplerset_Vvslider,,,,,set_value_Vvslider)
  51.    return procs
  52. end
  53.  
  54. procedure Vvslider(params[])
  55.    local self
  56.  
  57.    self := Vslider_rec ! params[1:7|0]
  58.    Vwin_check(self.win, "Vvert_slider()")
  59.    if (\self.aw, not numeric(self.aw) ) then
  60.       _Vbomb("invalid width parameter to Vvert_slider()")
  61.    if (\self.ah, not numeric(self.ah) ) then
  62.       _Vbomb("invalid length parameter to Vvert_slider()")
  63.    
  64.    self.uid := Vget_uid()
  65.    self.V := procs_Vvslider()
  66.    self.P := Vstd_pos()
  67.  
  68.    self.V.init(self)
  69.    return self
  70. end
  71.  
  72. procedure draw_Vvslider(s)
  73. local val
  74.  
  75.    s.drawn := 1
  76.    s.V.outline(s)
  77.    val := (s.callback.value - s.callback.min) * s.ws / s.cv_range
  78.    if \s.rev then
  79.       val := s.ws - val + s.pad
  80.    else
  81.       val +:= s.pad
  82.    s.pos := val
  83.    draw_Vvslider_bar(s)
  84. end
  85.  
  86. procedure event_Vvslider(s, e)
  87. local value
  88.  
  89.    if \s.callback.locked then fail
  90.    if e === (&lpress|&mpress|&rpress) then
  91.       until e === (&lrelease|&mrelease|&rrelease) do {
  92.          value := ((&y - s.ay - s.pad) / s.ws) * s.cv_range
  93.          if \s.rev then
  94.             s.callback.V.set(s.callback, s, s.callback.max - value, s.discont)
  95.          else
  96.             s.callback.V.set(s.callback, s, s.callback.min + value, s.discont)
  97.          s.data := s.callback.value
  98.          update_Vvslider(s, 1)
  99.          e := Event(s.win)
  100.          }
  101.    else
  102.       fail                # not our event
  103.    if \s.discont then
  104.       s.callback.V.set(s.callback, s, s.callback.value)
  105.    update_Vvslider(s)
  106.    return s.callback.value
  107. end
  108.  
  109. procedure update_Vvslider(s, active)
  110. local val
  111.  
  112.    val := (s.callback.value - s.callback.min) * s.ws / s.cv_range
  113.    if \s.rev then
  114.       val := s.ws - val + s.pad
  115.    else
  116.       val +:= s.pad
  117.    s.pos := val
  118.    draw_Vvslider_bar(s, active)
  119.    return s.callback.value
  120. end
  121.  
  122. procedure draw_Vvslider_bar(s, active)
  123. local ww, d
  124.  
  125.    ww := s.aw - 4
  126.    EraseArea(s.win, s.ax + 2, s.ay + 2, ww, s.ah - 4)
  127.    if \active then {
  128.       d := -1
  129.       FillRectangle(s.win, s.ax + 4, s.ay + s.pos - ww + 2, ww - 4, 2 * ww - 4)
  130.       }
  131.    else
  132.       d := 1
  133.    BevelRectangle(s.win, s.ax + 2, s.ay + s.pos - ww, ww, 2 * ww, d)
  134.    BevelRectangle(s.win, s.ax + 3, s.ay + s.pos, ww - 2, 1 - ww, d)
  135.    BevelRectangle(s.win, s.ax + 3, s.ay + s.pos, ww - 2, ww - 1, d)
  136. end
  137.  
  138. procedure set_value_Vvslider(s, value)
  139.    couplerset_Vvslider(s, , value)
  140.    return
  141. end
  142.  
  143. procedure couplerset_Vvslider(s, caller, value)
  144.  
  145.    value := numeric(value) | s.callback.min
  146.    if s.callback.value === value then fail
  147.    s.callback.V.set(s.callback, caller, value)
  148.    s.data := s.callback.value
  149.    if \s.drawn then
  150.       update_Vvslider(s)
  151. end
  152.  
  153. procedure init_Vvslider(s)
  154.    static type
  155.  
  156.    initial type := proc("type", 0)    # protect attractive name
  157.  
  158.    /s.aw := VSlider_DefWidth
  159.    /s.ah := VSlider_DefLength
  160.    s.aw <:= VSlider_MinWidth
  161.    s.ah <:= VSlider_MinAspect * s.aw
  162.    if /s.callback | type(s.callback) == "procedure" then
  163.       _Vbomb("Vvslider requires a coupler variable callback")
  164.    s.pad := s.aw - 2
  165.    s.ws := real(s.ah - 2 * s.pad)
  166.    s.cv_range := s.callback.max - s.callback.min
  167.    init_Vpane(s)
  168. end
  169.  
  170. procedure resize_Vvslider(s, x, y, w, h)
  171.  
  172.    resize_Vidget(s, x, y, w, h)
  173.    if s.aw > s.ah then {
  174.       s.V := procs_Vhslider()
  175.       return s.V.resize(s, x, y, w, h)
  176.       }
  177.    s.pad := s.aw - 2
  178.    s.ws := real(s.ah - 2 * s.pad)
  179.    s.cv_range := s.callback.max - s.callback.min
  180. end
  181.  
  182.  
  183. ############################################################################
  184. # Vhslider 
  185. ############################################################################
  186.  
  187. procedure procs_Vhslider()
  188.    static procs
  189.  
  190.    initial procs := Vstd(event_Vhslider, draw_Vhslider, outline_Vslider,
  191.                         resize_Vhslider, inrange_Vpane, init_Vhslider,
  192.                         couplerset_Vhslider,,,,,set_value_Vhslider)
  193.    return procs
  194. end
  195.  
  196. procedure Vhslider(params[])
  197.    local self
  198.  
  199.    self := Vslider_rec ! params[1:7|0]
  200.    self.aw :=: self.ah
  201.    Vwin_check(self.win, "Vhoriz_slider()")
  202.    if (\self.ah, not numeric(self.ah) ) then
  203.       _Vbomb("invalid width parameter to Vhoriz_slider()")
  204.    if (\self.aw, not numeric(self.aw) ) then
  205.       _Vbomb("invalid length parameter to Vhoriz_slider()")
  206.  
  207.    self.uid := Vget_uid()
  208.    self.V := procs_Vhslider()
  209.    self.P := Vstd_pos()
  210.  
  211.    self.V.init(self)
  212.    return self
  213. end
  214.  
  215. procedure draw_Vhslider(s)
  216. local val
  217.  
  218.    s.drawn := 1
  219.    s.V.outline(s)
  220.    val := (s.callback.value - s.callback.min) * s.ws / s.cv_range
  221.    if \s.rev then
  222.       val := s.ws - val + s.pad
  223.    else
  224.       val +:= s.pad
  225.    s.pos := val
  226.    draw_Vhslider_bar(s)
  227. end
  228.  
  229. procedure event_Vhslider(s, e)
  230. local value
  231.  
  232.    if \s.callback.locked then fail
  233.    if e === (&lpress|&mpress|&rpress) then
  234.       until e === (&lrelease|&mrelease|&rrelease) do {
  235.          value := ((&x - s.ax - s.pad) / s.ws) * s.cv_range
  236.          if \s.rev then
  237.             s.callback.V.set(s.callback, s, s.callback.max - value, s.discont)
  238.          else
  239.             s.callback.V.set(s.callback, s, s.callback.min + value, s.discont)
  240.          s.data := s.callback.value
  241.          update_Vhslider(s, 1)
  242.          e := Event(s.win)
  243.          }
  244.    else
  245.       fail                # not our event
  246.    if \s.discont then
  247.       s.callback.V.set(s.callback, s, s.callback.value)
  248.    update_Vhslider(s)
  249.    return s.callback.value
  250. end
  251.  
  252. procedure update_Vhslider(s, active)
  253. local val
  254.  
  255.    val := (s.callback.value - s.callback.min) * s.ws / s.cv_range
  256.    if \s.rev then
  257.       val := s.ws - val + s.pad
  258.    else
  259.       val +:= s.pad
  260.    s.pos := val
  261.    draw_Vhslider_bar(s, active)
  262.    return s.callback.value
  263. end
  264.  
  265. procedure draw_Vhslider_bar(s, active)
  266. local hh, d
  267.  
  268.    hh := s.ah - 4
  269.    EraseArea(s.win, s.ax + 2, s.ay + 2, s.aw - 4, hh)
  270.    if \active then {
  271.       d := -1
  272.       FillRectangle(s.win, s.ax + s.pos - hh + 2, s.ay + 4, 2 * hh - 4, hh - 4)
  273.       }
  274.    else
  275.       d := 1
  276.    BevelRectangle(s.win, s.ax + s.pos - hh, s.ay + 2, 2 * hh, hh, d)
  277.    BevelRectangle(s.win, s.ax + s.pos, s.ay + 3, 1 - hh, hh - 2, d)
  278.    BevelRectangle(s.win, s.ax + s.pos, s.ay + 3, hh - 1, hh - 2, d)
  279. end
  280.  
  281. procedure set_value_Vhslider(s, value)
  282.    couplerset_Vhslider(s, , value)
  283.    return
  284. end
  285.  
  286. procedure couplerset_Vhslider(s, caller, value)
  287.  
  288. ## break a cycle in callbacks by checking value.
  289.    value := numeric(value) | s.callback.min
  290.    if s.callback.value === value then fail
  291.    s.callback.V.set(s.callback, caller, value)
  292.    s.data := s.callback.value
  293.    if \s.drawn then
  294.       update_Vhslider(s)
  295. end
  296.  
  297. procedure init_Vhslider(s)
  298.    static type
  299.  
  300.    initial type := proc("type", 0)    # protect attractive name
  301.  
  302.    /s.ah := VSlider_DefWidth
  303.    /s.aw := VSlider_DefLength
  304.    s.ah <:= VSlider_MinWidth
  305.    s.aw <:= VSlider_MinAspect * s.ah
  306.    if /s.callback | type(s.callback) == "procedure" then
  307.       _Vbomb("Vhslider requires a coupler variable callback")
  308.    s.pad := s.ah - 2
  309.    s.ws := real(s.aw - 2 * s.pad)
  310.    s.cv_range := s.callback.max - s.callback.min
  311.    init_Vpane(s)
  312. end
  313.  
  314. procedure resize_Vhslider(s, x, y, w, h)
  315.  
  316.    resize_Vidget(s, x, y, w, h)
  317.    if s.aw < s.ah then {
  318.       s.V := procs_Vvslider()
  319.       return s.V.resize(s, x, y, w, h)
  320.       }
  321.    s.pad := s.ah - 2
  322.    s.ws := real(s.aw - 2 * s.pad)
  323.    s.cv_range := s.callback.max - s.callback.min
  324. end
  325.  
  326. ############################################################################
  327. # Utilities - slider wrapper procedures.
  328. ############################################################################
  329.  
  330. procedure outline_Vslider(s)
  331.    BevelRectangle(s.win, s.ax, s.ay, s.aw, s.ah, -2)    # draw trough
  332. end
  333.  
  334. procedure Vmake_slider(slider_type, w, callback, id, length, width,
  335.                        min, max, init, discontinuous)
  336. local cv, sl, cb, t
  337.    static type
  338.  
  339.    initial type := proc("type", 0)    # protect attractive name
  340.  
  341.    /min := 0
  342.    /max := 1.0
  343.    if not numeric(min) | not numeric(max) | (\init, not numeric(init)) then
  344.       _Vbomb("non-numeric min, max, or init parameter passed to Vxxxxx_slider()")
  345.    if max < min then { min :=: max; t := 1 }
  346.    cv := Vrange_coupler(min, max, init)
  347.    sl := slider_type(w, cv, id, width, length, discontinuous)
  348.    sl.rev := t
  349.    
  350.    add_clients_Vinit(cv, callback, sl)
  351.    return sl
  352. end
  353.  
  354. ############################################################################
  355. # Vvert_slider(w, callback, id, width, length, lower_bound, upper_bound,
  356. #              initial_value) 
  357. ############################################################################
  358. procedure Vvert_slider(params[])
  359. local frame, x, y, ins, t, self
  360.  
  361.    if ins := Vinsert_check(params) then {
  362.       frame := pop(params); x := pop(params); y:= pop(params)
  363.       }
  364.  
  365.    params[6] :=: params[7]
  366.    push(params, Vvslider)
  367.    self :=  Vmake_slider ! params
  368.    if \ins then VInsert(frame, self, x, y)
  369.    return self
  370. end
  371.  
  372. ############################################################################
  373. # Vhoriz_slider(w, callback, id, width, length, left_bound, right_bound,
  374. #              initial_value) 
  375. ############################################################################
  376. procedure Vhoriz_slider(params[])
  377. local frame, x, y, ins, self
  378.  
  379.    if ins := Vinsert_check(params) then {
  380.       frame := pop(params); x := pop(params); y:= pop(params)
  381.       }
  382.  
  383.    push(params, Vhslider)
  384.    self :=  Vmake_slider ! params
  385.    if \ins then VInsert(frame, self, x, y)
  386.    return self
  387. end
  388.