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 / spiro.icn < prev    next >
Text File  |  2000-07-29  |  4KB  |  149 lines
  1. ############################################################################
  2. #
  3. #       File:     spiro.icn
  4. #
  5. #    Subject:  Program to display spirograph lines
  6. #
  7. #    Author:   Stephen B. Wampler
  8. #
  9. #    Date:     June 17, 1994
  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 displays spirograph-like output
  23. #    There are two methods of drawing: epitrochoid, where
  24. #    the secondary circle moves around the outside of the
  25. #    primary circle, and hypotrochoid (the default here),
  26. #    where the secondary circle moves around the inside of
  27. #    the primary circle.
  28. #
  29. #    See the procedure 'helpmsg' for command line options
  30. #     (or run as 'spiro -help')
  31. #
  32. #    Waits for a window event before closing window
  33. #
  34. ############################################################################
  35. #
  36. #  Links:  glib, wopen
  37. #
  38. ############################################################################
  39. #
  40. #  Requires:  Version 9 graphics and co-expressions (for glib.icn)
  41. #
  42. ############################################################################
  43.  
  44. link glib        # need the turtle graphic stuff
  45. link wopen
  46.  
  47. global win, mono, h, w
  48. global Window, XMAX, YMAX
  49.  
  50. procedure main (args)
  51.     local a, b, k, t1, t2, N, arg, use_epi, t, alist
  52.  
  53.     XMAX := YMAX := 700                 # physical screen size
  54.     w := h := 350.0
  55.    
  56.     a := 100.0
  57.     b := 5.0
  58.     k := 20.0
  59.     t1 := 0.0
  60.     t2 := 1.0                # only roll around once.
  61.     N := 500
  62.  
  63.     while arg := get(args) do {
  64.        case arg of {
  65.           "-help"|"-h" : helpmsg()
  66.           "-epi" : use_epi := "yes"
  67.           "-a": a := real(get(args))
  68.           "-b": b  := real(get(args))
  69.           "-k": k := real(get(args))
  70.           "-t1": t1 := real(get(args))
  71.           "-t2": t2 := real(get(args))
  72.           "-N" : N := integer(get(args))
  73.           }
  74.        }
  75.  
  76.     win := WOpen("label=Spirograph", "width="||XMAX, "height="||YMAX)
  77.     mono := WAttrib (win, "depth") == "1"
  78.     Window := set_window(win, point(-w,-h), point(w,h),
  79.                   viewport(point(0,0), point(XMAX, YMAX), win))
  80.  
  81.     EraseArea(win)
  82.  
  83.     t := turtle(Window, point(w/2, h/2), 0, create |"red")
  84.  
  85.     # build list of arguments to pass to parametric equations
  86.     #    (same list for both x and y equations here)
  87.     alist := [a,b,k]
  88.  
  89.     if \use_epi then
  90.        draw_curve(t,epi_x,alist,epi_y,alist,t1,t2,N)
  91.     else
  92.        draw_curve(t,hypo_x,alist,hypo_y,alist,t1,t2,N)
  93.         
  94.  
  95.     # sit and wait for an event on the window.
  96.     Event(win)
  97.     close(win)
  98. end
  99.  
  100. procedure epi_x(t,a[])
  101.    static twopi
  102.    local ab
  103.    initial twopi := 2*&pi
  104.  
  105.    ab := a[1]+a[2]
  106.    return (ab)*cos(twopi*t) - a[3]*cos(twopi*((ab)*t)/a[2])
  107. end
  108.  
  109. procedure epi_y(t,a[])
  110.    static twopi
  111.    local ab
  112.    initial twopi := 2*&pi
  113.  
  114.    ab := a[1]+a[2]
  115.    return (ab)*sin(twopi*t) - a[3]*sin(twopi*((ab)*t)/a[2])
  116. end
  117.  
  118. procedure hypo_x(t,a[])
  119.    static twopi
  120.    local ab
  121.    initial twopi := 2*&pi
  122.  
  123.    ab := a[1]-a[2]
  124.     return (ab)*cos(twopi*t) + a[3]*cos(twopi*((ab)*t)/a[2])
  125. end
  126.  
  127. procedure hypo_y(t,a[])
  128.    static twopi
  129.    local ab
  130.    initial twopi := 2*&pi
  131.  
  132.    ab := a[1]-a[2]
  133.     return (ab)*sin(twopi*t) - a[3]*sin(twopi*((ab)*t)/a[2])
  134. end
  135.  
  136. procedure helpmsg()
  137.    write("Usage: Spiro [-a r] [-b r] [-k r] [-t1 r] [-t2 r] [-N n] [-epi]")
  138.    write()
  139.    write("where:")
  140.    write("\t-a r    - radius of center circle {default 100}")
  141.    write("\t-b r    - radius of moving circle {5}")
  142.    write("\t-k r    - distance of pen from center of moving circle {20}")
  143.    write("\t-t1 r    - initial value for parameter {0.0}")
  144.    write("\t-t2 r    - final value for parameter {1.0 (one revolutio)}")
  145.    write("\t-N n    - number of intervals to draw {500}")
  146.    write("\t-epi    - use epitrochoid instead of hypotrochoid")
  147.    stop()
  148. end
  149.