app/mpg/1987/src/GRAPHIK.Turtle

Raw file
Back to index

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
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