Initial upstream version 9.4.3upstream/9.4.3

1 files changed, 148 insertions, 0 deletions

diff --git a/ipl/gprogs/spiro.icn b/ipl/gprogs/spiro.icn
new file mode 100644
index 0000000..42ac1b3
--- /dev/null
+++ b/ipl/gprogs/spiro.icn
@@ -0,0 +1,148 @@
+############################################################################
+#
+#       File:     spiro.icn
+#
+#	Subject:  Program to display spirograph lines
+#
+#	Author:   Stephen B. Wampler
+#
+#	Date:     June 17, 1994
+#
+############################################################################
+#
+#   This file is in the public domain.
+#
+############################################################################
+#
+#	Version:  1.0
+#
+############################################################################
+#
+#
+#   Comments: This program displays spirograph-like output
+#	There are two methods of drawing: epitrochoid, where
+#	the secondary circle moves around the outside of the
+#	primary circle, and hypotrochoid (the default here),
+#	where the secondary circle moves around the inside of
+#	the primary circle.
+#
+#	See the procedure 'helpmsg' for command line options
+#	 (or run as 'spiro -help')
+#
+#	Waits for a window event before closing window
+#
+############################################################################
+#
+#  Links:  glib, wopen
+#
+############################################################################
+#
+#  Requires:  Version 9 graphics and co-expressions (for glib.icn)
+#
+############################################################################
+
+link glib		# need the turtle graphic stuff
+link wopen
+
+global win, mono, h, w
+global Window, XMAX, YMAX
+
+procedure main (args)
+    local a, b, k, t1, t2, N, arg, use_epi, t, alist
+
+    XMAX := YMAX := 700                 # physical screen size
+    w := h := 350.0
+   
+    a := 100.0
+    b := 5.0
+    k := 20.0
+    t1 := 0.0
+    t2 := 1.0				# only roll around once.
+    N := 500
+
+    while arg := get(args) do {
+       case arg of {
+          "-help"|"-h" : helpmsg()
+          "-epi" : use_epi := "yes"
+          "-a": a := real(get(args))
+          "-b": b  := real(get(args))
+          "-k": k := real(get(args))
+          "-t1": t1 := real(get(args))
+          "-t2": t2 := real(get(args))
+          "-N" : N := integer(get(args))
+          }
+       }
+
+    win := WOpen("label=Spirograph", "width="||XMAX, "height="||YMAX)
+    mono := WAttrib (win, "depth") == "1"
+    Window := set_window(win, point(-w,-h), point(w,h),
+                  viewport(point(0,0), point(XMAX, YMAX), win))
+
+    EraseArea(win)
+
+    t := turtle(Window, point(w/2, h/2), 0, create |"red")
+
+    # build list of arguments to pass to parametric equations
+    #    (same list for both x and y equations here)
+    alist := [a,b,k]
+
+    if \use_epi then
+       draw_curve(t,epi_x,alist,epi_y,alist,t1,t2,N)
+    else
+       draw_curve(t,hypo_x,alist,hypo_y,alist,t1,t2,N)
+        
+
+    # sit and wait for an event on the window.
+    Event(win)
+    close(win)
+end
+
+procedure epi_x(t,a[])
+   static twopi
+   local ab
+   initial twopi := 2*&pi
+
+   ab := a[1]+a[2]
+   return (ab)*cos(twopi*t) - a[3]*cos(twopi*((ab)*t)/a[2])
+end
+
+procedure epi_y(t,a[])
+   static twopi
+   local ab
+   initial twopi := 2*&pi
+
+   ab := a[1]+a[2]
+   return (ab)*sin(twopi*t) - a[3]*sin(twopi*((ab)*t)/a[2])
+end
+
+procedure hypo_x(t,a[])
+   static twopi
+   local ab
+   initial twopi := 2*&pi
+
+   ab := a[1]-a[2]
+    return (ab)*cos(twopi*t) + a[3]*cos(twopi*((ab)*t)/a[2])
+end
+
+procedure hypo_y(t,a[])
+   static twopi
+   local ab
+   initial twopi := 2*&pi
+
+   ab := a[1]-a[2]
+    return (ab)*sin(twopi*t) - a[3]*sin(twopi*((ab)*t)/a[2])
+end
+
+procedure helpmsg()
+   write("Usage: Spiro [-a r] [-b r] [-k r] [-t1 r] [-t2 r] [-N n] [-epi]")
+   write()
+   write("where:")
+   write("\t-a r	- radius of center circle {default 100}")
+   write("\t-b r	- radius of moving circle {5}")
+   write("\t-k r	- distance of pen from center of moving circle {20}")
+   write("\t-t1 r	- initial value for parameter {0.0}")
+   write("\t-t2 r	- final value for parameter {1.0 (one revolutio)}")
+   write("\t-N n	- number of intervals to draw {500}")
+   write("\t-epi	- use epitrochoid instead of hypotrochoid")
+   stop()
+end