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 / gprogs / sensdemo.icn < prev    next >
Text File  |  2001-06-10  |  5KB  |  158 lines
  1. ############################################################################
  2. #
  3. #    File:     sensdemo.icn
  4. #
  5. #    Subject:  Program to demonstrate sensor routines
  6. #
  7. #    Author:   Gregg M. Townsend
  8. #
  9. #    Date:     July 12, 1995
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #     sensdemo illustrates several of the input sensors provided in the
  18. #  program library.  It is written to use mutable colors but will struggle
  19. #  along slowly if they're not available.
  20. #
  21. #     There are four pushbuttons.  Buttons "One", "Two", and "Three" just
  22. #  write a line on standard output.  The "QUIT" button does what you'd
  23. #  expect.
  24. #
  25. #     The three vertically oriented sliders control (from left to right)
  26. #  alter the red, green, and blue components of the color in the large
  27. #  square.  The individual components appear in the small squares, and
  28. #  the hexadecimal form of the color spec is displayed below the square.
  29. #
  30. #     The small horizontal slider below the square adjusts all three
  31. #  color components simultaneously.  Notice how moving it also moves
  32. #  the three vertical sliders.
  33. #
  34. #     The largs square sounds a bell if Return is pressed while it
  35. #  contains the cursor.  The standard "quitsensor" causes the program
  36. #  to exit when q or Q is pressed anywhere in the window.
  37. #
  38. ############################################################################
  39. #
  40. #  Requires:  Version 9 graphics
  41. #
  42. ############################################################################
  43. #
  44. #  Links: button, slider, evmux, graphics
  45. #
  46. ############################################################################
  47.  
  48. link button
  49. link slider
  50. link evmux
  51. link graphics
  52.  
  53. $define BevelWidth 2
  54. $define WindowMargin 10
  55.  
  56. record rgbrec(r, g, b, k)
  57. record boxrec(x, y, w, h, b, i)
  58. global val, colr, sl, win
  59.  
  60. procedure main(args)
  61.    local cwin, h, m, c
  62.  
  63.    # open window
  64.    win := Window("size=400,400", args)
  65.    m := WindowMargin
  66.    h := WAttrib("height") - 2 * m            # usable height
  67.  
  68.    # set up boxes for displaying colors, each with its own binding
  69.    colr := rgbrec(
  70.       boxrec(m, m, 40, 40),
  71.       boxrec(m, m + 55, 40, 40),
  72.       boxrec(m, m + 110, 40, 40),
  73.       boxrec(m + 65, m, 150, 150))
  74.    every c := !colr do {
  75.       c.b := Clone(win)
  76.       Bg(c.b, c.i := NewColor(win))            # fails if b/w screen
  77.       BevelRectangle(win, c.x, c.y, c.w, c.h, -BevelWidth)
  78.       EraseArea(c.b,
  79.          c.x+BevelWidth, c.y+BevelWidth, c.w-2*BevelWidth, c.h-2*BevelWidth)
  80.       }
  81.  
  82.    # set up sliders to control the colors
  83.    val := rgbrec(0.1, 0.8, 1.0, 0.8)            # initial positions
  84.    sl := rgbrec()
  85.    sl.r := slider(win, setrgb, 1, 290, m, 20, h, 0.0, val.r, 1.0)
  86.    sl.g := slider(win, setrgb, 2, 330, m, 20, h, 0.0, val.g, 1.0)
  87.    sl.b := slider(win, setrgb, 3, 370, m, 20, h, 0.0, val.b, 1.0)
  88.    sl.k := slider(win, setgray, 4, m+65, m+160, 150, 14, 0.0, 0.8, 1.0)
  89.    setcolors()                        # download the colors
  90.  
  91.    # set up miscellaneous sensors
  92.    quitsensor(win)                    # quit on q or Q
  93.    sensor(win, '\r', ding, &null, m+65, m, 150, 150)    # \r in box sounds bell
  94.    buttonrow(win, 150, 250, 100, 20, 0, 30,        # vertical button row
  95.       "One", bpress, "one",
  96.       "Two", bpress, "two",
  97.       "Three", bpress, "three",
  98.       )
  99.    button(win, "QUIT", argless, exit, m, m+h-60, 60, 60)  # and a QUIT button
  100.  
  101.    # enter event loop
  102.    evmux(win)
  103. end
  104.  
  105. procedure bpress(win, a)        # echo a button press
  106.    write("button ", a)
  107.    return
  108. end
  109.  
  110. procedure ding(win, a, x, y, k)        # ring the bell
  111.    writes("\^g")
  112.    flush(&output)
  113.    return
  114. end
  115.  
  116. procedure setcolors()            # set the colors in the color map
  117.    colorbox(colr.r, 65535 * val.r, 0, 0)
  118.    colorbox(colr.g, 0, 65535 * val.g, 0)
  119.    colorbox(colr.b, 0, 0, 65535 * val.b)
  120.    colorbox(colr.k, 65535 * val.r, 65535 * val.g, 65535 * val.b)
  121.    GotoXY(win, 100, 200)
  122.    write(win, "color = #", hexv(val.r), hexv(val.g), hexv(val.b))
  123.    return
  124. end
  125.  
  126. procedure colorbox(box, r, g, b)
  127.    r := integer(r)
  128.    g := integer(g)
  129.    b := integer(b)
  130.    if \box.i then
  131.       Color(box.b, box.i, r || "," || g || "," || b)
  132.    else {
  133.       Shade(box.b, r || "," || g || "," || b)
  134.       FillRectangle(box.b, box.x+1, box.y+1, box.w-1, box.h-1)
  135.       }
  136.    return
  137. end
  138.  
  139. procedure hexv(v)            # two-hex-digit specification of v
  140.    static hextab
  141.    initial {
  142.       every put((hextab := []), !"0123456789ABCDEF" || !"0123456789ABCDEF")
  143.       }
  144.    return hextab [integer(255 * v + 1.5)]
  145. end
  146.  
  147. procedure setgray(win, i, v)        # set a grayvalue of v
  148.    every i := 1 to 3 do
  149.       slidervalue(sl[i], val[i] := v)
  150.    setcolors()
  151.    return
  152. end
  153.  
  154. procedure setrgb(win, i, v)        # set color component i to value v
  155.    val[i] := v
  156.    setcolors()
  157. end
  158.