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 / drip.icn < prev    next >
Text File  |  2000-07-29  |  4KB  |  151 lines
  1. ############################################################################
  2. #
  3. #    File:     drip.icn
  4. #
  5. #    Subject:  Program to demonstrate color map animation
  6. #
  7. #    Author:   Gregg M. Townsend
  8. #
  9. #    Date:     May 31, 1994
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  usage:  drip [-n ncolors] [-c correlation] [-d delay] [window options]
  18. #
  19. #     drip uses color map animation to simulate the spread of colored
  20. #  liquid dripping into the center of a pool.
  21. #
  22. #     ncolors is the number of different colors present at one time.
  23. #
  24. #     correlation (0.0 to 1.0) controls the similarity of two consecutive
  25. #  colors.  It probably doesn't meet a statistician's strict definition
  26. #  of the term.
  27. #
  28. #     delay is the delay between drops, in milliseconds.  This may not be
  29. #  needed; speed seems to vary greatly among different X servers, even on
  30. #  the same machine.
  31. #
  32. ############################################################################
  33. #
  34. #  Requires:  Version 9 graphics
  35. #
  36. ############################################################################
  37. #
  38. #  Links: evmux, options, optwindw, random
  39. #
  40. ############################################################################
  41.  
  42.  
  43. link evmux
  44. link options
  45. link optwindw
  46. link random
  47.  
  48. global opttab
  49.  
  50. procedure main(args)
  51.    local win, mono, w, h, m, d
  52.    local a, r, i, xscale, yscale, rad, xctr, yctr, xrad, yrad
  53.    local cindex, cspec, ncolors, bg
  54.  
  55.    # process options
  56.    opttab := options(args, winoptions() || "n+d+c.")
  57.    /opttab["B"] := "black"
  58.    /opttab["W"] := 512
  59.    /opttab["H"] := 512
  60.    /opttab["M"] := -1
  61.    /opttab["d"] := 50
  62.    /opttab["n"] := 32
  63.    /opttab["c"] := 0.8
  64.    win := optwindow(opttab, "cursor=off", "echo=off")
  65.    w := opttab["W"]
  66.    h := opttab["H"]
  67.    m := opttab["M"]
  68.    ncolors := opttab["n"]
  69.    d := opttab["d"]
  70.  
  71.    # calculate radius of circle and limit number of colors to that
  72.    r := h / 2
  73.    r >:= w / 2
  74.    xscale := (w / 2.0) / r
  75.    yscale := (h / 2.0) / r
  76.    ncolors >:= r
  77.  
  78.    # get background color as string of 3 integers (works faster that way)
  79.    bg := ColorValue(win, opttab["B"])
  80.  
  81.    # allocate a set of mutable colors, initialized to the background
  82.    cindex := list()
  83.    every 1 to ncolors do
  84.       put(cindex, NewColor(win, bg))
  85.    if *cindex = 0 then
  86.       stop("can't allocate mutable colors")
  87.    if ncolors >:= *cindex then
  88.       write(&errout, "proceeding with only ", ncolors, " colors")
  89.  
  90.    # make list of radii, with a minimum difference of 1
  91.    # try to equalize the *areas* of the rings, not their widths
  92.    a := &pi * r * r
  93.    rad := list(ncolors)
  94.    every i := 1 to *rad do
  95.       rad[i] := integer(sqrt((a * i) / (ncolors * &pi)) + 0.5)
  96.    every i := 1 to *rad-1 do
  97.       rad[i] >:= rad[i+1] - 1
  98.  
  99.    # draw nested circles (in different mutable colors all set to the background)
  100.    xctr := m + w / 2
  101.    yctr := m + h / 2
  102.    every i := *rad to 1 by -1 do {
  103.       Fg(win, cindex[i])
  104.       xrad := xscale * rad[i]
  105.       yrad := yscale * rad[i]
  106.       FillArc(win, xctr - xrad, yctr - yrad, 2 * xrad, 2 * yrad)
  107.       }
  108.    WFlush(win)
  109.  
  110.    # install a sensor to exit on q or Q
  111.    quitsensor(win)
  112.  
  113.    # drip colors into the center and watch them spread,
  114.    # checking for events each time around
  115.    cspec := list(ncolors, bg)
  116.    repeat {
  117.       while *Pending(win) > 0 do
  118.          evhandle(win)
  119.       if d > 0 then {
  120.          WFlush(win)
  121.          delay(d)
  122.          }
  123.       pull(cspec)
  124.       push(cspec, newcolor())
  125.       every i := 1 to *cspec do
  126.          Color(win, cindex[i], cspec[i])
  127.       }
  128.  
  129. end
  130.  
  131.  
  132. #  newcolor -- return a new color spec somewhat close to the previous color
  133.  
  134. procedure newcolor()
  135.    static r, g, b, c
  136.  
  137.    initial {
  138.       randomize()
  139.       r := ?32767
  140.       g := ?32767
  141.       b := ?32767
  142.       c := integer(32767 - 32767 * opttab["c"])
  143.       c <:= 1
  144.       }
  145.  
  146.    r +:= ?c - c/2 - 1;  r <:= 0;  r >:= 32767
  147.    g +:= ?c - c/2 - 1;  g <:= 0;  g >:= 32767
  148.    b +:= ?c - c/2 - 1;  b <:= 0;  b >:= 32767
  149.    return (r + 32768) || "," || (g + 32768) || "," || (b + 32768)
  150. end
  151.