Category : Modula II Source Code
Archive   : M2GRAPH.ZIP
Filename : TURTLEGR.MOD

 
Output of file : TURTLEGR.MOD contained in archive : M2GRAPH.ZIP
IMPLEMENTATION MODULE TurtleGraphics;
(* Simple Turtle Graphics routines based on BasicGraphics
Pat Terry and Robin Roos, December 1988
For specifications see Definition Module *)

FROM BasicGraphics IMPORT PlotLine, EraseLine, GraphMode, TextMode, XorLine;

CONST
XMax = 600.0; YMax = 200.0; (* Screen Dimensions *)
XHome = 300.0; YHome = 100.0; (* Home Positions *)
TWidth = 4.0; TLength = 8.0;
XScale = 3.0; YScale = 1.5;
TYPE
DEGREES = CARDINAL [0 .. 359];
(* In Collier M-2 this must be INTEGER [0 .. 359] Collier
will not accept integer values as subscripts for an array
declared with a cardinal index type, in contrast with the standard *)
VAR
I : DEGREES (* Counting *);
XPos, YPos : REAL (* Turtle Position *);
FHeading,
PenColor : INTEGER (* 1=Draw; 0=Erase *);
THeading : REAL (* Angle 0 = point right *);
TurtleOn, (* Draw turtle ? Boolean Flag *)
PenIsDown : BOOLEAN (* Draw lines ? *);
Theta, pi : REAL (* Used for Radians conversion *);
Cosine, Sine : ARRAY DEGREES OF REAL (* Arrays are faster *);

PROCEDURE ROUND (a : REAL) : INTEGER;
BEGIN
IF a < 0.0
THEN RETURN -VAL(INTEGER, TRUNC(-a + 0.5))
ELSE RETURN VAL(INTEGER, TRUNC(a + 0.5))
END
END ROUND;

PROCEDURE Normalise (VAR Angle : REAL);
(* Make sure that the given angle is between 0 and 359 degrees *)
BEGIN
WHILE Angle >= 360.0 DO
Angle := Angle - 360.0;
END;
WHILE Angle < 0.0 DO
Angle := Angle + 360.0;
END;
END Normalise;

PROCEDURE NormaliseInt (VAR Angle : INTEGER);
(* Make sure that the given angle is between 0 and 359 degrees *)
BEGIN
WHILE Angle > 359 DO
Angle := Angle - 360;
END;
WHILE Angle < 0 DO
Angle := Angle + 360;
END;
END NormaliseInt;

PROCEDURE DrawTheLine (A1, B1, A2, B2 : REAL);
VAR
X1, Y1, X2, Y2 : INTEGER;
BEGIN
X1 := ROUND(A1);
Y1 := ROUND(B1);
X2 := ROUND(A2);
Y2 := ROUND(B2);
IF PenIsDown THEN
IF PenColor = 1
THEN PlotLine(X1, Y1, X2, Y2);
ELSE EraseLine(X1, Y1, X2, Y2);
END;
END;
END DrawTheLine;

PROCEDURE XorTurtle;
(* Draw/erase the turtle using the XorLine routines *)
(* Check Flag TurtleOn First *)
VAR
LHeading, RHeading : INTEGER;
Ax, Bx, Cx, Ay, By, Cy : REAL;

PROCEDURE XorRealLine(A1, B1, A2, B2 : REAL);
VAR
X1, X2, Y1, Y2 : INTEGER;
BEGIN
X1 := ROUND(A1);
Y1 := ROUND(B1);
X2 := ROUND(A2);
Y2 := ROUND(B2);
XorLine(X1, Y1, X2, Y2);
END XorRealLine;

BEGIN
IF TurtleOn THEN
(* Bx, By = 'Nose' Point of Turtle *)
FHeading := ROUND(THeading);
NormaliseInt (FHeading);
Bx := XPos + (Cosine[FHeading] * XScale * TLength);
By := YPos + (Sine[FHeading] * YScale * TLength);
(* Ax, Ay = Left hand corner *);
LHeading := ROUND(THeading - 120.0);
NormaliseInt(LHeading);
Ax := XPos + (Cosine[LHeading] * XScale * TWidth);
Ay := YPos + (Sine[LHeading] * YScale * TWidth);
(* Cx, Cy = Right hand corner *);
RHeading := ROUND(THeading + 120.0);
NormaliseInt(RHeading);
Cx := XPos + (Cosine[RHeading] * XScale * TWidth);
Cy := YPos + (Sine[RHeading] * YScale * TWidth);
(* Draw Turtle *)
XorRealLine(Ax, Ay, Bx, By);
XorRealLine(Bx, By, Cx, Cy);
XorRealLine(Cx, Cy, Ax, Ay);
END;
END XorTurtle;

PROCEDURE Move (Distance : REAL);
(* Does not check for lines that go off the screen, and so does not
overlap lines. Drawing lines off the screen is "safe" *)
VAR
TempX, TempY : REAL;
BEGIN
XorTurtle;
(* Calculate new position *)
FHeading := ROUND(THeading);
NormaliseInt(FHeading);
TempX := XPos + (Cosine[FHeading] * XScale * Distance);
TempY := YPos + (Sine[FHeading] * YScale * Distance);
(* Draw Line to New Position *)
DrawTheLine(XPos, YPos, TempX, TempY);
(* Turtle has moved to a new position *)
XPos := TempX;
YPos := TempY;
XorTurtle;
END Move;

PROCEDURE MoveLap (Distance : REAL);
VAR
Increment, LastIncrement : REAL;
TempX, TempY, NewX, NewY : REAL;

PROCEDURE OutOfBounds() : BOOLEAN;
BEGIN
RETURN (NewX < 0.0) OR (NewX > XMax) OR (NewY < 0.0) OR (NewY > YMax)
END OutOfBounds;

BEGIN (* MoveLap *);
XorTurtle;
REPEAT
FHeading := ROUND(THeading);
NormaliseInt(FHeading);
NewX := XPos + (Cosine[FHeading] * XScale * Distance);
NewY := YPos + (Sine[FHeading] * YScale * Distance);
IF OutOfBounds()
THEN
LastIncrement := 0.0;
NewX := XPos; NewY := YPos; Increment := 0.0;
WHILE NOT OutOfBounds() DO
LastIncrement := Increment;
Increment := Increment + 5.0;
NewX := XPos + (Cosine[FHeading] * XScale * Increment);
NewY := YPos + (Sine[FHeading] * YScale * Increment);
END;
IF Increment > 5.0 THEN
Increment := Increment - 6.0;
REPEAT
LastIncrement := Increment;
Increment := Increment + 1.0;
NewX := XPos + (Cosine[FHeading] * XScale * Increment);
NewY := YPos + (Sine[FHeading] * YScale * Increment);
UNTIL OutOfBounds();
END; (* IF *)
TempX := XPos + (Cosine[FHeading] * XScale * LastIncrement);
TempY := YPos + (Sine[FHeading] * YScale * LastIncrement);
DrawTheLine(XPos, YPos, TempX, TempY);
Distance := Distance - LastIncrement;
IF NewX < 0.0
THEN XPos := XMax
ELSIF NewX > XMax THEN XPos := 0.0
ELSE XPos := TempX;
END;
IF NewY < 0.0
THEN YPos := YMax;
ELSIF NewY > YMax THEN YPos := 0.0;
ELSE YPos := TempY;
END;
ELSE
DrawTheLine(XPos, YPos, NewX, NewY);
XPos := NewX; YPos := NewY; Distance := 0.0;
END;
UNTIL Distance < 0.2;
XorTurtle;
END MoveLap;

PROCEDURE MoveTo (X, Y : REAL);
VAR
TempX, TempY : REAL;
BEGIN
XorTurtle;
TempX := (X * XScale);
TempY := (Y * YScale);
DrawTheLine(XPos, YPos, TempX, TempY);
(* New turtle position *)
XPos := TempX;
YPos := TempY;
XorTurtle;
END MoveTo;

PROCEDURE TurnRight (Rotation : REAL);
BEGIN
XorTurtle;
THeading := THeading + Rotation;
Normalise(THeading);
XorTurtle;
END TurnRight;

PROCEDURE TurnLeft (Rotation : REAL);
BEGIN
XorTurtle;
THeading := THeading - Rotation (* Negative sign gives left turn *);
Normalise(THeading);
XorTurtle;
END TurnLeft;

PROCEDURE Turn (Rotation : REAL);
BEGIN
TurnRight(Rotation)
END Turn;

PROCEDURE TurnTo (Heading : REAL);
BEGIN
XorTurtle;
Normalise(Heading);
THeading := Heading;
XorTurtle;
END TurnTo;

PROCEDURE SetPenColor (Shade : INTEGER);
BEGIN
IF (Shade = 0) OR (Shade = 1) THEN PenColor := Shade END;
END SetPenColor;

PROCEDURE PenUp;
BEGIN
PenIsDown := FALSE
END PenUp;

PROCEDURE PenDown;
BEGIN
PenIsDown := TRUE
END PenDown;

PROCEDURE Home;
BEGIN
XorTurtle;
DrawTheLine(XPos, YPos, XHome, YHome);
XPos := XHome;
YPos := YHome;
THeading := 0.0;
XorTurtle;
END Home;

PROCEDURE ClearTurtleScreen;
BEGIN
GraphMode;
XPos := XHome;
YPos := YHome;
THeading := 0.0;
IF TurtleOn THEN XorTurtle END;
END ClearTurtleScreen;

PROCEDURE ShowTurtle;
BEGIN
IF NOT TurtleOn THEN XorTurtle END;
TurtleOn := TRUE;
END ShowTurtle;

PROCEDURE HideTurtle;
BEGIN
IF TurtleOn THEN XorTurtle END;
TurtleOn := FALSE;
END HideTurtle;

PROCEDURE InitialiseTurtle;
BEGIN
GraphMode;
TurtleOn := TRUE;
PenColor := 1;
PenIsDown := TRUE;
ClearTurtleScreen;
END InitialiseTurtle;

PROCEDURE KillTurtle;
BEGIN
TextMode;
END KillTurtle;

BEGIN (* Turtle *)
(* Initialise Cosine[] and Sine[] arrays *)
Sine[0] := 0.0; Cosine[0] := 1.0;
Sine[1] := 0.017452406437; (* sin(piBy180) *)
Cosine[1] := 0.99984769516; (* cos(piBy180) *)
FOR I := 2 TO 359 DO (*recurrence relations are fast*)
Sine[I] := Sine[I-1] * Cosine[1] + Cosine[I-1] * Sine[1];
Cosine[I] := Cosine[I-1] * Cosine[1] - Sine[I-1] * Sine[1];
END;
END TurtleGraphics.


  3 Responses to “Category : Modula II Source Code
Archive   : M2GRAPH.ZIP
Filename : TURTLEGR.MOD

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/