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 / kaleid.icn < prev    next >
Text File  |  2001-05-02  |  11KB  |  382 lines

  1. ############################################################################
  2. #
  3. #    File:     kaleid.icn
  4. #
  5. #    Subject:  Program to produce kaleidoscope
  6. #
  7. #    Author:   Stephen B. Wampler
  8. #
  9. #    Date:     May 2, 2001
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #    Lots of options, most easily set by with the interface after
  18. #    startup.  The only one that isn't set that way is -wn where 'n' is
  19. #    the size of the kaleidoscope window (default is 600 square).
  20. #
  21. #    Terminology (and options):
  22. #
  23. #    Window_size (-wN): How big of a display window to use.
  24. #        At the current time, this can only be set via a
  25. #        command line argument.
  26. #
  27. #    Density (-dN): How many circles per octant to keep on display
  28. #        at any one time.  There is NO LIMIT to the density.
  29. #
  30. #       Duration (-lN): How long to keep drawing circles (measured in
  31. #        in circles) once the density is reached.  There is NO LIMIT
  32. #        to the duration.
  33. #
  34. #    MaxRadius (-MN): Maximum radius of any circle.
  35. #
  36. #    MinRadius (-mN): Preferred minimum radius.  Circles with centers
  37. #        near the edge have their radii forced down to fit entirely
  38. #        on the display
  39. #
  40. #       MaxOffset (-XN): Maximum offset from center of display (may wrap).
  41. #
  42. #    MinOffset (-xN): Minimum offset
  43. #
  44. #    Skew (-sN): Shift probability of placing a circle at a 'typical'
  45. #        offset.
  46. #
  47. #    Fill (-F): Turns off filling the circles.
  48. #
  49. #    Clear (-C): After the duration, reduces density back to 0 before
  50. #        quitting.
  51. #
  52. #    Random Seed: (-rN): Sets the random number seed.
  53. #
  54. # Thanks to Jon Lipp for help on using vidgets, and to Mary Camaron
  55. #   for her Interface Builder.
  56. #
  57. ############################################################################
  58. #
  59. #  Requires:  Version 9 graphics
  60. #
  61. ############################################################################
  62. #
  63. #  Links:  vidgets, vslider, vtext, vbuttons, vradio, wopen, xcompat
  64. #
  65. ############################################################################
  66.  
  67. link vidgets
  68. link vslider
  69. link vtext
  70. link vbuttons
  71. link vradio
  72. link wopen
  73. link xcompat
  74.  
  75. global Clear, fill, duration, density, maxoff, minoff
  76. global maxradius, minradius, r_seed, skew, win_size, mid_win
  77. global root, check1, mainwin, use_dialog
  78. global draw_circle
  79.  
  80. global du_v, de_v, rs_v, sk_v
  81.  
  82. procedure main (args)
  83.  
  84.    draw_circle := DrawCircle
  85.  
  86.    init_globs()
  87.    process_args(args)
  88.  
  89.    if \use_dialog then {    # have vidgets, so use them for args.
  90.       mainwin := WOpen("label=Kaleidoscope", "width=404", "height=313", 
  91.                        "font=6x12") |
  92.                  stop ("bad mainwin")
  93.       root := ui (mainwin)
  94.       GetEvents (root, quit)
  95.       }
  96.    else {            # just rely on command line arguments
  97.       kaleidoscope(r_seed)
  98.       }
  99.  
  100. end
  101.  
  102. procedure init_globs()
  103.  
  104.    duration := 500                    # set default characteristics
  105.    density := 30
  106.    win_size := 600
  107.    minoff := 1
  108.    maxradius := 150
  109.    minradius := 1
  110.    skew := 1
  111.    fill := "On"
  112.    draw_circle := FillCircle
  113.    Clear := "Off"
  114.    r_seed := map("HhMmYy", "Hh:Mm:Yy", &clock)
  115.    # See if the Vidget library is available or not
  116.    if \VSet then use_dialog := "yes"
  117.             else use_dialog := &null
  118.  
  119. end
  120.  
  121. procedure process_args(args)
  122.    local arg
  123.  
  124.    # really only needed if you don't use the dialog box
  125.    every arg := !args do case arg[1+:2] of {
  126.       "-w" : win_size := integer(arg[3:0])     # window size
  127.       "-d" : density := integer(arg[3:0])        # density of circles
  128.       "-l" : duration := integer(arg[3:0])       # duration
  129.       "-M" : maxradius := integer(arg[3:0])      # maximum radius
  130.       "-m" : minradius := integer(arg[3:0])      # minimum radius
  131.       "-X" : maxoff := integer(arg[3:0])         # maximum offset
  132.       "-x" : minoff := integer(arg[3:0])         # minimum offset
  133.       "-s" : skew := numeric(arg[3:0])           # set skewedness
  134.       "-F" : fill := &null                       # turn off fill
  135.       "-C" : Clear := "yes"                      # turn on clear mode
  136.       "-r" : r_seed := integer(arg[3:0])         # random seed
  137.       "-h" : stop("usage: kal [-wn] [-dn] [-ln] [-Mn] [-mn] [-Xn] [-xn] _
  138.                      [-sn] [-F] [-C] [-rn]")
  139.       }
  140.    # adjust parameters that depend on the window size...
  141.    mid_win := win_size/2
  142.    maxoff := win_size-1
  143. end
  144.  
  145. # Lorraine Callahan's kaleidoscope program, translated into icon.
  146. #  (some of the things she did were too sophisticated for me
  147. #   to spend time to figure out, so the output is square instead of
  148. #   round), and I use 'xor' to draw instead of writing to separate
  149. #   bit planes.
  150.  
  151. global putcircle, clrcircle
  152.  
  153. procedure kaleidoscope(r)
  154.    local colors
  155.  
  156.    # What colors to use?  This can be changed to whatever!
  157.    colors := ["red","green","blue","cyan","magenta","yellow"]
  158.  
  159.    &window := WOpen("label=Kaleidoscope: 'q' quits", "width="||win_size,
  160.                                   "height="||win_size, "bg=black")
  161.    WAttrib("drawop=xor")
  162.  
  163.    # Create two *indentical* sequences of circles, one to use when
  164.    #   when drawing, one for erasing.  (Since 'xor' is used to
  165.    #   place them, these both just draw the circles!)
  166.  
  167.    putcircle := create {                # draws sequence of circles
  168.       &random :=: r
  169.       |{
  170.        Fg(?colors)
  171.        outcircle()
  172.        &random <-> r
  173.        }
  174.       }
  175.  
  176.    clrcircle := create {                # erases sequence of circles
  177.       &random :=: r
  178.       |{
  179.        Fg(?colors)
  180.        outcircle()
  181.        &random <-> r
  182.        }
  183.       }
  184.  
  185.    every 1 to density do @putcircle    # fill screen to density
  186.  
  187.    every 1 to duration do {        # maintain steady state
  188.       @putcircle
  189.       @clrcircle
  190.       if *Pending(&window) > 0 then break
  191.       }
  192.  
  193.    every (Clear == "On") & 1 to density do @clrcircle
  194.  
  195.    close(&window)
  196. end
  197.  
  198.  
  199. procedure outcircle()                   # select a circle at random,
  200. local radius, xoff, yoff                #  draw it in kaleidoscopic form
  201.  
  202.     # get a random center point and radius
  203.    xoff := (?(maxoff - minoff) + minoff) % mid_win
  204.    yoff := (?(maxoff - minoff) + minoff) % mid_win
  205.    radius := ?0 ^ skew
  206.     # force radius to 'fit'
  207.    radius := ((maxradius-minradius) * radius + minradius) %
  208.              (mid_win - ((xoff < yoff)|xoff))
  209.  
  210.     # put into all 8 octants
  211.    draw_circle(mid_win+xoff, mid_win+yoff, radius)
  212.    draw_circle(mid_win+xoff, mid_win-yoff, radius)
  213.    draw_circle(mid_win-xoff, mid_win+yoff, radius)
  214.    draw_circle(mid_win-xoff, mid_win-yoff, radius)
  215.  
  216.    draw_circle(mid_win+yoff, mid_win+xoff, radius)
  217.    draw_circle(mid_win+yoff, mid_win-xoff, radius)
  218.    draw_circle(mid_win-yoff, mid_win+xoff, radius)
  219.    draw_circle(mid_win-yoff, mid_win-xoff, radius)
  220.  
  221.    return
  222. end
  223.  
  224.  
  225. ############################################################################
  226. #
  227. #   Vidget-based user interface -- developed originally using Mary
  228. #    Camaron's XIB program.  Don't expect this to be very readable -
  229. #    you should have to play with it!
  230. #
  231. ############################################################################
  232. procedure ui (win)
  233.    local cv1, cv2, cv3, cv4
  234.    local 
  235.          radio_button2, 
  236.          radio_button1, 
  237.          text_input6, 
  238.          text_input5, 
  239.          slider4, 
  240.          slider3, 
  241.          text_input4, 
  242.          text_input3, 
  243.          slider2, 
  244.          slider1 
  245.  
  246.    /win := WOpen("label=ui", "width=404", "height=313", "font=6x12") | 
  247.            stop ("bad win")
  248.    root := Vroot_frame (win)
  249.  
  250.    VInsert (root, Vmessage(win, win_size/2), 168, 98)
  251.    VInsert (root, Vmessage(win, "1"), 108, 97)
  252.  
  253.    VInsert (root, sk_v := Vtext(win,"Skew:\\=1",get_skew,,6), 280, 39)
  254.  
  255.    VInsert (root, du_v := Vtext(win, "Duration:\\="||duration, get_duration,,9),
  256.                 237, 15)
  257.  
  258.    VInsert (root, Vmessage(win, "Clear at end?"), 232, 145)
  259.    VInsert (root, Vmessage(win, "Fill?"), 105, 142)
  260.    VInsert (root, Vmessage(win,"Quit?"), 267, 259)
  261.    VInsert (root, Vmessage(win,"Display it?"), 26, 260)
  262.  
  263.    VInsert (root, Vcheckbox(win, do_quit, "check2",20), 305, 255, 20, 20)
  264.  
  265.    VInsert (root, check1:=Vcheckbox(win, do_display, "check1",20),
  266.                 106, 258, 20, 20)
  267.  
  268.    radio_button2 := Vradio_buttons (win, ["On", "Off"], get_clear, , V_CIRCLE)
  269.    VSet(radio_button2,Clear)
  270.    VInsert (root, radio_button2, 253, 165)
  271.  
  272.    radio_button1 := Vradio_buttons (win, ["On", "Off"], get_fill, , V_CIRCLE)
  273.    VSet(radio_button1,fill)
  274.    VInsert (root, radio_button1, 99, 165)
  275.  
  276.    cv1 := Vcoupler()
  277.    VAddClient(cv1, get_max_offset)
  278.    text_input6 := Vtext (win, "Max Offset:\\="||(win_size-1), cv1, , 3)
  279.    VAddClient(cv1, text_input6)
  280.    slider4 := Vhoriz_slider (win, cv1, "slider4", 70, 12, 0,
  281.                          win_size-1, win_size-1, )
  282.    VAddClient(cv1, slider4)
  283.    VInsert (root, text_input6, 196, 103)
  284.    VInsert (root, slider4, 306, 106)
  285.  
  286.    cv2 := Vcoupler()
  287.    VAddClient(cv2, get_min_offset)
  288.    text_input5 := Vtext (win, "Min Offset\\=1", cv2, , 3)
  289.    VAddClient(cv2, text_input5)
  290.    slider3 := Vhoriz_slider (win, cv2, "slider3", 70, 12, 1, win_size-1, 1, )
  291.    VAddClient(cv2, slider3)
  292.    VInsert (root, text_input5, 201, 80)
  293.    VInsert (root, slider3, 307, 82)
  294.  
  295.    cv3 := Vcoupler()
  296.    VAddClient(cv3, get_max_radius)
  297.    text_input4 := Vtext (win, "Max Radius\\="||(win_size/4), cv3, , 3)
  298.    VAddClient(cv3, text_input4)
  299.    slider2 := Vhoriz_slider (win, cv3, "slider2", 70, 12, 1, win_size/2,
  300.          win_size/4, )
  301.    VAddClient(cv3, slider2)
  302.    VInsert (root, text_input4, 10, 104)
  303.    VInsert (root, slider2, 110, 108)
  304.  
  305.    cv4 := Vcoupler()
  306.    VAddClient(cv4, get_min_radius)
  307.    text_input3 := Vtext (win, "Min Radius\\=1", cv4, , 3)
  308.    VAddClient(cv4, text_input3)
  309.    slider1 := Vhoriz_slider (win, cv4, "slider1", 70, 12, 1, win_size/2, 1, )
  310.    VAddClient(cv4, slider1)
  311.    VInsert (root, text_input3, 10, 81)
  312.    VInsert (root, slider1, 110, 84)
  313.  
  314.    VInsert (root, rs_v := Vtext(win,"Random Seed:\\="||r_seed, get_random,, 11),
  315.               30, 41)
  316.    VInsert (root, de_v := Vtext(win,"Density:\\="||density, get_density,,8),
  317.               71, 16)
  318.  
  319.    VResize (root)
  320.    return root
  321. end
  322.  
  323. procedure get_skew (wit, value)
  324.    skew := value
  325. end
  326.  
  327. procedure get_duration (wit, value)
  328.    duration := value
  329. end
  330.  
  331. procedure do_quit (wit, value)
  332.    stop()
  333. end
  334.  
  335. procedure do_display (wit, value)
  336.    r_seed   := numeric(rs_v.data)
  337.    duration := integer(du_v.data)
  338.    density  := integer(de_v.data)
  339.    skew     := integer(sk_v.data)
  340.    kaleidoscope(r_seed)
  341.    wit.callback.value := &null
  342.    VDraw(check1)
  343. end
  344.  
  345. procedure get_clear (wit, value)
  346.    Clear := value
  347. end
  348.  
  349. procedure get_fill (wit, value)
  350.    fill := value
  351.    if fill == "Off" then draw_circle := DrawCircle
  352.    else draw_circle := FillCircle
  353. end
  354.  
  355. procedure get_max_offset (wit, value)
  356.    maxoff := value
  357. end
  358.  
  359. procedure get_min_offset (wit, value)
  360.    minoff := value
  361. end
  362.  
  363. procedure get_max_radius (wit, value)
  364.    maxradius := value
  365. end
  366.  
  367. procedure get_min_radius (wit, value)
  368.    minradius := value
  369. end
  370.  
  371. procedure get_random (wit, value)
  372.    r_seed := integer(value)
  373. end
  374.  
  375. procedure get_density (wit, value)
  376.    density := integer(value)
  377. end
  378.  
  379. procedure quit(e)
  380.    if e === "q" then stop ("Exiting Kaleidoscope")
  381. end
  382.