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 / flake.icn < prev    next >
Text File  |  2000-07-29  |  3KB  |  95 lines
  1. ############################################################################
  2. #
  3. #       File:     flake.icn
  4. #
  5. #    Subject:  Program to draw a fractal snowflake
  6. #
  7. #    Author:   Stephen B. Wampler
  8. #
  9. #    Date:     August 14, 1996
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #    Version:  1.0
  18. #
  19. ############################################################################
  20. #
  21. #
  22. #   Comments: This program display a fractal snowflake of specified
  23. #       order.  Options exist to do colors, etc.
  24. #    See the procedure 'helpmsg' for command line options
  25. #
  26. #    An order 4 snowflake is particularly nice.
  27. #
  28. #    Waits for a window event before closing window
  29. #
  30. ############################################################################
  31. #
  32. #    Links: glib, wopen
  33. #
  34. ############################################################################
  35. #
  36. #    Requires:  Version 9 graphics and co-expressions (for glib.icn)
  37. #
  38. ############################################################################
  39.  
  40. link glib
  41. link wopen
  42.  
  43. global win, mono, h, w
  44. global Window, XMAX, YMAX
  45. global nextcolor
  46.  
  47. procedure main (args)
  48.     local nextarg, arg, n, doclip, docolor, Cpoly
  49.  
  50.     XMAX := YMAX := 700                 # physical screen size
  51.     w := h := 1.0
  52.    
  53.     nextarg := create !args
  54.     while arg := @nextarg do {
  55.        if arg == ("-help"|"-h") then stop(helpmsg())
  56.        else if arg == "-n" then n := integer(@nextarg)
  57.        else if arg == "-clip" then doclip := "yes"
  58.        else if arg == "-color" then docolor := "yes"
  59.        }
  60.  
  61.     /n := 3        # default order
  62.  
  63.     if \doclip then {
  64.        Cpoly := [    # a simple convext polygon to clip against
  65.                  [0.3,0.4],[0.5,0.8],[0.7,0.4]
  66.                 ]
  67.        }
  68.  
  69.     win := WOpen("label=Fractal Snowflake", "width="||XMAX, "height="||YMAX)
  70.     mono := WAttrib (win, "depth") == "1"
  71.     Window := set_window(win, point(0,0), point(w,h),
  72.                   viewport(point(0,0), point(XMAX, YMAX), win))
  73.  
  74.     if \docolor then
  75.        nextcolor := create vpara([0,0,65535], [65535,0,0], |((0 to 12)/12.0))
  76.  
  77.     EraseArea(win)
  78.  
  79.     Fg(win, "black")
  80.  
  81.     fract_flake(Window, point(0.20,0.33), point(0.80,0.33), n, 1, Cpoly)
  82.  
  83.     Event(win)
  84.     close(win)
  85. end
  86.  
  87. procedure helpmsg()
  88.    write("Usage: Flake [-n order] [-clip] [-color]")
  89.    write("   where")
  90.    write("     -n order        -- Depth of recursion {3}")
  91.    write("     -clip        -- Clip to a convex polygon")
  92.    write("     -color        -- Color cycle while drawing")
  93.    return
  94. end
  95.