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 / mprocs / viewpack.icn < prev   
Text File  |  2001-05-02  |  7KB  |  330 lines
  1. ############################################################################
  2. #
  3. #    File:     viewpack.icn
  4. #
  5. #    Subject:  Procedures to visualize color streams
  6. #
  7. #    Author:   Ralph E. Griswold
  8. #
  9. #    Date:     May 2, 2001
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  These procedures provide various ways of visualizing a stream of colors.
  18. #
  19. ############################################################################
  20. #
  21. #  Requires:  Version 9 graphics
  22. #
  23. ############################################################################
  24.  
  25. $define Hold    300
  26.  
  27. #  blinking light
  28.  
  29. procedure beacon(win, color, value)    #: 1C visualization as blinking light
  30.  
  31.    Fg(win, color)
  32.    FillCircle(win, width / 2, height / 2, width / 2)
  33.    WDelay(win, Hold)
  34.  
  35. end
  36.  
  37. #  random curves
  38.  
  39. procedure curves(win, color, value)    #: 1C visualization as random curves
  40.    local x0, y0
  41.  
  42.    Fg(win, color)
  43.    DrawCurve ! [
  44.       win,
  45.       x0 :=  ?width, y0 := ?height,
  46.       ?width, ?height,
  47.       ?width, ?height,
  48.       ?width, ?height,
  49.       ?width, ?height,
  50.       ?width, ?height,
  51.       ?width, ?height,
  52.       .x0, .y0
  53.       ]
  54.  
  55.    WDelay(win, Hold)
  56.  
  57.    return
  58.  
  59. end
  60.  
  61. # "haystack"
  62.  
  63. procedure haystack(win, color, value)    #: 2CS visualization as "haystack"
  64.    static angle, xcenter, ycenter, xorg, yorg, fullcircle
  65.  
  66.    initial {
  67.       fullcircle := 2 * &pi
  68.       ycenter := height / 2
  69.       xcenter := width / 2
  70.       }
  71.  
  72.    Fg(win, color)
  73.    angle := ?0 * fullcircle    # angle for locating starting point
  74.    xorg := xcenter + ?xcenter * cos(angle)
  75.    yorg := ycenter + ?ycenter * sin(angle)
  76.    angle := ?0 * fullcircle    # angle for locating end point
  77.    DrawLine(win, xorg, yorg, value * cos(angle) +
  78.       xorg, value * sin(angle) + yorg)
  79.  
  80.    return
  81.  
  82. end
  83.  
  84. #  "nova"
  85.  
  86. $define Scale    1.5
  87. $define Rays    360
  88.  
  89. procedure nova(win, color, value)    #: 1C visualization as exploding star
  90.    local clear, xorg, yorg, radius, arc, oldlength, length
  91.    static fullcircle, radians, advance, erase
  92.  
  93.    initial {
  94.       fullcircle := 2 * &pi
  95.       radians := 0
  96.       advance := fullcircle / Rays        # amount to advance
  97.       erase := list(Rays)
  98.       }
  99.  
  100.    Fg(win, color)
  101.    xorg := width / 2
  102.    yorg := height / 2
  103.    radius := ((height < width) | height) / 2.0
  104.  
  105.    length := value * Scale
  106.    put(erase, length)
  107.    oldlength := get(erase)
  108.  
  109. #  The following are to erase old ray at that angle
  110.  
  111. #  DrawLine(Background, xorg, yorg, \oldlength * cos(radians) + xorg,
  112. #     oldlength * sin(radians) + yorg)
  113.  
  114.    DrawLine(win, xorg, yorg, length * cos(radians) +
  115.       xorg, length * sin(radians) + yorg)
  116.    
  117.    radians +:= advance
  118.    radians %:= fullcircle
  119.  
  120.    return
  121.  
  122. end
  123.  
  124. #  "pinwheel"
  125.  
  126. $define Sectors    240
  127.  
  128. procedure pinwheel(win, color, value)    #: 1C visualization as radar sweep
  129.    static clear, xorg, yorg, radius, offset
  130.    static arc, advance, blank, max, xratio, yratio
  131.    static fullcircle, background
  132.  
  133.    initial {
  134.       fullcircle := 2 * &pi
  135.       max := real((width < height) | width)
  136.       xratio := width / max
  137.       yratio := height / max
  138.       offset := 0
  139.       advance := fullcircle / Sectors
  140.       blank := 2 * advance
  141.       xorg := width / 2
  142.       yorg := height / 2
  143.       radius := max / 2
  144.  
  145.       # This belongs elsewhere
  146.  
  147.       background := Clone(win, "bg=" || default_color)
  148.  
  149.       }
  150.  
  151.    Fg(win, color)
  152.    FillArc(background, 0, 0, width, height, offset + advance, blank)
  153.    FillArc(win, 0, 0, width, height, offset, advance)
  154.    DrawLine(background, xorg, yorg, xratio * radius * cos(offset) +
  155.       xorg, yratio * radius * sin(offset) + yorg)
  156.  
  157.    offset +:= advance
  158.    offset %:= fullcircle
  159.  
  160.    return
  161.  
  162. end
  163.  
  164. #  random polygons
  165.  
  166. procedure polygons(win, color, value)    #: 1C visualization as random polygons
  167.    local x0, y0
  168.  
  169.    Fg(win, color)
  170.    FillPolygon ! [
  171.       win,
  172.       x0 :=  ?width, y0 := ?height,
  173.       ?width, ?height,
  174.       ?width, ?height,
  175.       ?width, ?height,
  176.       ?width, ?height,
  177.       ?width, ?height,
  178.       ?width, ?height,
  179.       .x0, .y0
  180.       ]
  181.  
  182.    WDelay(win, Hold)
  183.  
  184.    return
  185.  
  186. end
  187.  
  188. #  random dots
  189.  
  190. procedure splatter(win, color, value)    #: 2CS visualization as random dots
  191.    local radius, xplace, yplace
  192.  
  193.    Fg(win, color)
  194.    radius := sqrt(value)
  195.    xplace := ?width - 1 - (radius / 2)
  196.    yplace := ?height - 1 - (radius / 2)
  197.    FillCircle(win, xplace, yplace, radius)
  198.  
  199.    return
  200.  
  201. end
  202.  
  203. # scrolling strip
  204.  
  205. procedure strip(win, color, value)    #: 2CS visualization as scrolling lines
  206.    local count
  207.  
  208.    Fg(win, color) | "black"
  209.    if /value | (value = 0) then return
  210.    count := log(value, 10) + 1
  211.    every 1 to count do {
  212.       CopyArea(win, 1, 0, width - 1, height, 0, 0)
  213.       EraseArea(win, width - 1, 0, width - 1, height)
  214.       FillRectangle(win, width - 1, 0, 1, height)
  215.       }
  216.  
  217.    return
  218.  
  219. end
  220.  
  221. procedure symdraw(W, mid, x, y, r)
  222.  
  223.    FillCircle(W, mid + x, mid + y, r)
  224.    FillCircle(W, mid + x, mid - y, r)
  225.    FillCircle(W, mid - x, mid + y, r)
  226.    FillCircle(W, mid - x, mid - y, r)
  227.  
  228.    FillCircle(W, mid + y, mid + x, r)
  229.    FillCircle(W, mid + y, mid - x, r)
  230.    FillCircle(W, mid - y, mid + x, r)
  231.    FillCircle(W, mid - y, mid - x, r)
  232.  
  233.    return
  234.  
  235. end
  236.  
  237. #  symmetric random dots
  238.  
  239. procedure symsplat(win, color, value)    #: 2CS visualization as symmetric random dots
  240.    local radius
  241.    static xplace, yplace, oscale
  242.  
  243.    Fg(win, color)
  244.    radius := sqrt(value)
  245.    xplace := ?width - 1
  246.    yplace := ?height - 1
  247.    symdraw(win, width / 2, xplace, yplace, radius)
  248.  
  249.    return
  250.    
  251. end
  252.  
  253. #  evolving vortex
  254.  
  255. procedure vortex(win, color, value)    #: 1C visualization as an aspirating vortex
  256.    local count
  257.    static x1, x2, y1, y2
  258.  
  259.    initial {
  260.       x1 := y1 := 0
  261.       x2 := width
  262.       y2 := height
  263.       }
  264.  
  265.    Fg(win, color)
  266.    if value = 0 then return
  267.    count := log(value, 10) + 1
  268.    every 1 to count do {
  269.       if (x2 | y2) < 0 then {
  270.          x1 := y1 := 0
  271.          x2 := width
  272.          y2 := height
  273.          }
  274.       DrawRectangle(win, x1, y1, x2 - x1, y2 - y1)
  275.       x1 +:= 1
  276.       x2 -:= 1
  277.       y1 +:= 1
  278.       y2 -:= 1
  279.       }
  280.    
  281.    return
  282.  
  283. end
  284.  
  285. #  random walk
  286. #
  287. #  This procedure is suspect -- it seems to wander off the display area.
  288.  
  289. $define Delta    30
  290.  
  291. procedure web(win, color, value)    #: 2CS visualization as a random walk
  292.    static xorg, yorg, x, y, angle, degrees, radians, resid
  293.  
  294.    initial {
  295.       resid := 0
  296.       xorg := ?(width - 1)    # starting point
  297.       yorg := ?(height - 1)
  298.       }
  299.  
  300.    Fg(win, color)
  301.    if resid <= 1 then {
  302.       angle := ?0 * 2 * &pi    # initial direction for new walk
  303.       resid := value
  304.       }
  305.  
  306.    x := xorg + resid * cos(angle)
  307.    y := yorg + resid * sin(angle)
  308.  
  309.    if x > width then {
  310.       x := width
  311.       }
  312.    if y > height then {
  313.       y := height
  314.       }
  315.    if x < 0 then {
  316.       x := 0
  317.       }
  318.    if y < 0 then {
  319.       y := 0
  320.       }
  321.    DrawLine(win, xorg, yorg, x, y)
  322.    resid -:= sqrt((x - xorg) ^ 2 + (y - yorg) ^ 2)
  323.    xorg := x            # move to new point
  324.    yorg := y
  325.    angle := -angle        # reflect
  326.  
  327.    return
  328.  
  329. end
  330.