summaryrefslogtreecommitdiff
path: root/ipl/gprocs/subturtl.icn
diff options
context:
space:
mode:
Diffstat (limited to 'ipl/gprocs/subturtl.icn')
-rw-r--r--ipl/gprocs/subturtl.icn275
1 files changed, 275 insertions, 0 deletions
diff --git a/ipl/gprocs/subturtl.icn b/ipl/gprocs/subturtl.icn
new file mode 100644
index 0000000..6464eb1
--- /dev/null
+++ b/ipl/gprocs/subturtl.icn
@@ -0,0 +1,275 @@
+############################################################################
+#
+# File: subturtl.icn
+#
+# Subject: Procedures for turtle-graphics (subset version)
+#
+# Author: Gregg M. Townsend
+#
+# Date: January 30, 1996
+#
+############################################################################
+#
+# This file is in the public domain.
+#
+############################################################################
+#
+# These procedures implement a simplified subset of the turtle.icn
+# package. The main omissions are scaling, TWindow(), THome(), and
+# high-level primitives like TCircle(). Some procedures accept fewer
+# arguments, omit defaults, or omit the return value.
+#
+############################################################################
+#
+# The procedures are as follows:
+#
+# TDraw(n) -- move forward and draw
+# TSkip(n) -- skip forward without drawing
+# The turtle moves forward n units. n can be negative to move
+# backwards.
+#
+# TDrawto(x, y) -- draw to the point (x,y)
+# The turtle turns and draws a line to the point (x,y).
+# The heading is also set as a consequence of this movement.
+#
+# TGoto(x, y) -- set location
+# The turtle moves to the point (x,y) without drawing.
+# The turtle's heading remains unaltered.
+#
+# TRight(d) -- turn right
+# TLeft(d) -- turn left
+# The turtle turns d degrees to the right or left of its current
+# heading. Its location does not change, and nothing is drawn.
+#
+# TFace(x, y) -- set heading
+# The turtle turns to face directly to face the point (x,y).
+# If the turtle is already at (x,y), the heading does not change.
+#
+# TX() -- query current x position
+# TY() -- query current y position
+# The x- or y-coordinate of the turtle's current location is
+# returned.
+#
+# THeading() -- query heading
+# The turtle's heading (in degrees) is returned.
+#
+# TSave() -- save turtle state
+# TRestore() -- restore turtle state
+# TSave saves the current turtle window, location, and heading
+# on an internal stack. TRestore pops the stack and sets
+# those values, or fails if the stack is empty.
+#
+# TReset() -- clear screen and reinitialize
+# The window is cleared, the turtle moves to the center of the
+# screen without drawing, the heading is set to -90 degrees, and
+# the TRestore() stack is cleared. These actions restore the
+# initial conditions.
+#
+############################################################################
+#
+# Links: graphics
+#
+############################################################################
+#
+# Requires: Version 9 graphics
+#
+############################################################################
+#
+# See also: turtle.icn
+#
+############################################################################
+
+link graphics
+
+global T_x, T_y # current location
+global T_deg # current heading
+global T_stack # turtle state stack
+
+
+# TInit() -- initialize turtle system, opening window if needed
+
+procedure TInit() #: initialize turtle system
+
+ initial {
+ if /&window then
+ WOpen("width=500", "height=500") | stop("can't open window")
+ T_stack := []
+ T_x := WAttrib("width") / 2 + 0.5
+ T_y := WAttrib("height") / 2 + 0.5
+ T_deg := -90.0
+ }
+
+ return
+
+end
+
+
+# TReset() -- clear screen and stack, go to center, head -90 degrees
+
+procedure TReset() #: reset turtle system
+ initial TInit()
+
+ EraseArea()
+ T_stack := []
+ T_x := WAttrib("width") / 2 + 0.5
+ T_y := WAttrib("height") / 2 + 0.5
+ T_deg := -90.0
+
+ return
+
+end
+
+
+# TDraw(n) -- move forward n units while drawing a line
+
+procedure TDraw(n) #: draw with turtle
+ local rad, x, y
+ initial TInit()
+
+ rad := dtor(T_deg)
+ x := T_x + n * cos(rad)
+ y := T_y + n * sin(rad)
+ DrawLine(T_x, T_y, x, y)
+ T_x := x
+ T_y := y
+
+ return
+
+end
+
+
+# TDrawto(x, y) -- draw line to (x,y)
+
+procedure TDrawto(x, y) #: draw to with turtle
+ initial TInit()
+
+ TFace(x, y)
+ DrawLine(T_x, T_y, x, y)
+ T_x := x
+ T_y := y
+
+ return
+
+end
+
+
+# TSkip(n) -- move forward n units without drawing
+
+procedure TSkip(n) #: skip with turtle
+ local rad
+ initial TInit()
+
+ rad := dtor(T_deg)
+ T_x +:= n * cos(rad)
+ T_y +:= n * sin(rad)
+
+ return
+
+end
+
+
+# TGoto(x, y) -- move to (x,y) without drawing
+
+procedure TGoto(x, y) #: goto with turtle
+ initial TInit()
+ T_x := x
+ T_y := y
+
+ return
+
+end
+
+
+# TRight(d) -- turn right d degrees
+
+procedure TRight(d) #: turn turtle right
+ initial TInit()
+
+ T_deg +:= d
+ T_deg %:= 360 # normalize
+
+ return
+
+end
+
+
+# TLeft(d) -- turn left d degrees
+
+procedure TLeft(d) #: turn turtle left
+ initial TInit()
+
+ T_deg -:= d
+ T_deg %:= 360 # normalize
+
+ return
+
+end
+
+
+# TFace(x, y) -- turn to face (x,y), unless already there
+
+procedure TFace(x, y) #: turn turtle to face point
+ initial TInit()
+
+ if x ~= T_x | y ~= T_y then
+ T_deg := rtod(atan(y - T_y, x - T_x))
+
+ return
+
+end
+
+
+# TX() -- return current x location
+
+procedure TX(x) #: turtle x coordinate
+ initial TInit()
+
+ return T_x
+
+end
+
+
+# TY() -- return current y location
+
+procedure TY(y) #: turtle y coordinate
+ initial TInit()
+
+ return T_y
+
+end
+
+
+# THeading() -- return current heading
+
+procedure THeading() #: turtle heading
+ initial TInit()
+
+ return T_deg
+
+end
+
+
+# TSave() -- save turtle state
+
+procedure TSave() #: save turtle state
+ initial TInit()
+
+ push(T_stack, T_deg, T_y, T_x)
+
+ return
+
+end
+
+
+# TRestore() -- restore turtle state
+
+procedure TRestore() #: restore turtle state
+ initial TInit()
+
+ T_x := pop(T_stack)
+ T_y := pop(T_stack)
+ T_deg := pop(T_stack)
+
+ return
+
+end