(**************************************************************************) 
(*                                                                        *) 
(*                        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