diff options
Diffstat (limited to 'app/mpg/1987/src/GRAPHIK.Turtle')
| -rw-r--r-- | app/mpg/1987/src/GRAPHIK.Turtle | 138 |
1 files changed, 138 insertions, 0 deletions
diff --git a/app/mpg/1987/src/GRAPHIK.Turtle b/app/mpg/1987/src/GRAPHIK.Turtle new file mode 100644 index 0000000..7dcfff1 --- /dev/null +++ b/app/mpg/1987/src/GRAPHIK.Turtle @@ -0,0 +1,138 @@ +(**************************************************************************)
+(* *)
+(* MPG - Graphik - System *)
+(* *)
+(* Version 2.1 vom 10.09.1987 *)
+(* *)
+(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *)
+(* unter Verwendung der Standard-Graphik *)
+(* "Turtle-Graphik" geschrieben von B.Jegerlehner *)
+(* *)
+(**************************************************************************)
+(* *)
+(* Dieses Paket stellt eine LOGO-aehnliche *)
+(* 'Schildkroetengraphik' zur Verfuegung *)
+(* *)
+(**************************************************************************)
+PACKET turtle graphics DEFINES begin turtle,
+ end turtle,
+ forward ,
+ forward to ,
+ turn ,
+ turn to ,
+ pen up ,
+ pen down ,
+ pen ,
+ angle ,
+ get turtle :
+
+REAL VAR x pos,
+ y pos,
+ winkel;
+
+PICFILE VAR bild;
+PICTURE VAR pic;
+
+BOOL VAR direct,
+ pen status;
+
+PROC begin turtle:
+ direct := TRUE;
+ x pos := 0.0;
+ y pos := 0.0;
+ winkel := 0.0;
+ begin plot;
+ clear;
+ viewport (0.0, 1.0, 0.0, 1.0);
+ window (-500.0, 500.0, -500.0, 500.0);
+ pen up;
+ forward to (0.0, 0.0)
+END PROC begin turtle;
+
+PROC begin turtle (TEXT CONST picfile):
+ direct := FALSE;
+ bild := picture file (picfile);
+ pic := nilpicture;
+ x pos := 0.0;
+ y pos := 0.0;
+ winkel := 0.0;
+ pen up;
+ forward to (0.0,0.0)
+END PROC begin turtle;
+
+PROC end turtle:
+ IF direct
+ THEN end plot
+ ELSE ausgabe
+ FI.
+
+ ausgabe:
+ REAL VAR x cm,y cm;
+ INT VAR dummy;
+ put picture (bild,pic);
+ drawing area (x cm,y cm,dummy,dummy);
+ viewport (bild, 0.0, 1.0, 0.0, 1.0);
+ window (bild, -500.0,500.0,-500.0,500.0);
+ plot(bild)
+END PROC end turtle;
+
+PROC turn (REAL CONST w):
+ winkel := (winkel + w) MOD 360.0
+END PROC turn;
+
+PROC turn to (REAL CONST w):
+ winkel := w MOD 360.0
+END PROC turn to;
+
+REAL PROC angle:
+ winkel
+END PROC angle;
+
+PROC forward (REAL CONST len):
+ forward to (x pos + cosd (winkel) * len,
+ y pos + sind (winkel) * len)
+END PROC forward;
+
+PROC pen up:
+ pen status := FALSE
+END PROC pen up;
+
+PROC pen down:
+ pen status := TRUE
+END PROC pen down;
+
+BOOL PROC pen:
+ pen status
+END PROC pen;
+
+PROC forward to (REAL CONST x,y):
+ IF direct
+ THEN dir plot
+ ELSE pic plot
+ FI;
+ x pos := x;
+ y pos := y.
+
+ dir plot:
+ IF pen status
+ THEN draw (x,y)
+ ELSE move (x,y)
+ FI.
+
+ pic plot:
+ IF length (pic) > 1923
+ THEN put picture (bild,pic);
+ pic := nilpicture
+ FI;
+ IF pen status
+ THEN draw (pic,x,y)
+ ELSE move (pic,x,y)
+ FI
+END PROC forward to;
+
+PROC get turtle (REAL VAR x,y):
+ x := x pos;
+ y := y pos
+END PROC get turtle
+
+END PACKET turtle graphics
|