summaryrefslogtreecommitdiff
path: root/system/std.graphik/1.8.7/src/graphik editor
blob: 7aa6e3312ba0faaca923bee4690d5224e1877408 (plain)
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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
PACKET graphic editor DEFINES  graphic,           (*Autor: H.Indenbirken *)
                               picfile, picture,  (*Stand: 26.02.1985    *)

                               neu zeichnen,
 
                               UP, DOWN, T,

                               pen, select pen, selected pen, background,
                               extrema pic, extrema picfile:
 

 
LET norm cmd = ""1""27""3""10""9"epb"16"",
    hop cmd = ""2""10""12""1"",
    bell    = ""7"",
    esc     = ""27"";

PICFILE VAR p;
PICTURE VAR pic;
TEXT VAR command :: "", old command :: "", char, headline :: "";
BOOL VAR within edit :: FALSE, new plot :: FALSE;
ROW 3 ROW 2 REAL VAR size;
ROW 2 ROW 2 REAL VAR limits;
ROW 4 REAL VAR angles;
ROW 2 REAL VAR oblique;
ROW 3 REAL VAR perspective;

PROC open graphic (TEXT CONST name, DATASPACE CONST ds):
  p := ds; 
  get values (p, size, limits, angles, oblique, perspective); 
  head line := ""1""15"LEN       ................................ DIM    PEN    .."14" Picture      "15""14"";
  replace (head line, 32-LENGTH name DIV 2, name);
  new plot := TRUE;
  within edit := TRUE
END PROC open graphic;

PROC graphic:
  graphic (last param)
END PROC graphic;

PROC graphic (TEXT CONST name) :
  IF NOT exists (name) 
  THEN IF yes ("Soll ein neuer Picfile eingerichtet werden")
       THEN graphic (new (name), name) FI
  ELSE graphic (old (name), name) FI

END PROC graphic;

PROC graphic (DATASPACE CONST f, TEXT CONST name) :
  open graphic (name, f);
  reset;
  kommandos bearbeiten;
  within edit := FALSE  .

kommandos bearbeiten :
  REP IF new plot
      THEN plot (p);
           new plot := FALSE
      FI;
      read picture (p, pic);
      out head line;
      inchar (command);
      do command
  PER  .
 
out head line:
  replace (headline,  7, text (length (pic), 5));
  replace (headline, 50, text (dim (pic), 1));
  replace (headline, 57, text (pen (pic), 2));
  replace (headline, 72, text (picture no (p), 4));
  out (head line)  .

do command:
  SELECT pos (norm cmd, command) OF 
  CASE  1: hop commands
  CASE  2: escape commands
  CASE  3: position up
  CASE  4: position down
  CASE  5: position direct
  CASE  6: extrema pic
  CASE  7: selected pen (pen (pic));
  CASE  8: out (1, 2, ""15""5"Hintergrundfarbe: " +
           colour of (background (p)) + " "14"")
  CASE  9: identify (pic);
  OTHERWISE out (bell) ENDSELECT .

position up :
  IF is first picture (p)
  THEN out (bell);
  ELSE up (p) FI  .

position down :
  IF eof (p)
  THEN out (bell)
  ELSE down (p) FI  .
 
position direct:
   out (1, 68, "");
   edit get (command, 4, 4);
   to pic (p, int (command))  .

hop commands :
  inchar (command);
  SELECT pos (hop cmd, command) OF 
  CASE 1: to first pic (p)
  CASE 2: to eof (p)
  CASE 3: delete picture (p);
          IF NOT new plot
          THEN erase (pic) FI
  CASE 4: new plot := TRUE
  OTHERWISE out (bell) ENDSELECT  .

escape commands :
  inchar (command);
  IF command = "q"
  THEN LEAVE kommandos bearbeiten
  ELIF command = "f"
  THEN do (old command)
  ELIF command = esc
  THEN kommandomodus
  ELSE do (kommando auf taste (command)) FI  .

END PROC graphic;

PROC kommandomodus:
  command := "";
  disable stop;
  REP get command;
      do (command)
  UNTIL command executed PER;

  IF new values
  THEN get values (size, limits, angles, oblique, perspective); 
       set values (p, size, limits, angles, oblique, perspective); 
       new plot := new plot OR new values
  FI  .

get command:
  REP out (1, 2, ""15"Gib Graphikkommando: ");
      edit get (command, 0, 54, "", "k", char);
      out (""14"");
      out (1, 2, ""5"");

      IF char = ""13""
      THEN LEAVE get command
      ELIF char = ""27"k"
      THEN command := old command FI
  PER  .

command executed:
  IF is error
  THEN out (1, 1, error message);
       clear error;
       FALSE
  ELSE old command := command;
       TRUE
  FI  .

END PROC kommandomodus;

PROC out (INT CONST x, y, TEXT CONST t):
  cursor (x, y);
  out (t)
END PROC out;

TEXT PROC colour of (INT CONST colour):
  SELECT colour OF
  CASE 0: "löschen"
  CASE 1: "std"
  CASE 2: "rot"
  CASE 3: "blau"
  CASE 4: "grün"
  CASE 5: "schwarz"
  CASE 6: "weiß"
  OTHERWISE text (colour) ENDSELECT  .
END PROC colour of;

TEXT PROC linetype of (INT CONST linetype):
  SELECT linetype OF
  CASE 0: "unsichtbar"
  CASE 1: "durchgehend"
  CASE 2: "gepunktet"
  CASE 3: "kurz gestrichelt"
  CASE 4: "lang gestrichelt"
  CASE 5: "strichpunkt"
  OTHERWISE text (linetype) ENDSELECT  .
END PROC linetype of;

PICFILE PROC picfile :
  IF NOT within edit
  THEN errorstop ("Not within editmode") FI;
  p
END PROC picfile;

PICTURE PROC picture :
  IF NOT within edit
  THEN errorstop ("Not within editmode") FI;
  pic
END PROC picture;

PROC neu zeichnen:
  new plot := TRUE
END PROC neu zeichnen;

OP UP (INT CONST distance):
  up (p, distance);
  read picture (p, pic) 
END OP UP;

OP DOWN (INT CONST distance):
  down (p, distance);
  read picture (p, pic) 
END OP DOWN;

OP T (INT CONST n):
  to pic (p, n);
  read picture (p, pic) 
END OP T;
 
PROC pen (INT CONST n):
  IF NOT new plot
  THEN erase (pic) FI;

  pen (pic, n);
  write picture (p, pic);

  IF NOT new plot
  THEN show (pic) FI
END PROC pen;

PROC select pen (INT CONST n, colour, thickness, linetype, BOOL CONST hidden):
  select pen (p, n, colour, thickness, linetype, hidden);
  new plot := TRUE
END PROC select pen;

PROC select pen (INT CONST n, colour, thickness, linetype):
  select pen (p, n, colour, thickness, linetype, FALSE);
  new plot := TRUE
END PROC select pen;

PROC selected pen (INT CONST n, INT VAR colour, thickness, linetype,
                   BOOL VAR hidden):
  selected pen (p, n, colour, thickness, linetype, hidden);
END PROC selected pen;

PROC selected pen (INT CONST n):
  INT VAR colour, thickness, linetype;
  BOOL VAR hidden;
  selected pen (p, n, colour, thickness, linetype, hidden);
  out (1, 2, ""5""15"PEN #" + text (n) + ":  Farbe: " + colour of (colour) +
             ", Dicke " + text (thickness) + ", Linientyp " + linetype of (linetype) +
             hidden text + " "14"")  .

hidden text:
  IF hidden
  THEN ". "
  ELSE ", nicht sichtbare Linien werden unterdrückt." FI  .

END PROC selected pen;

INT PROC background:
  background (p)
END PROC background;

PROC background (INT CONST n):
  new plot := n <> background (p);
  background (p, n)
END PROC background;

PROC extrema pic:
  REAL VAR x min, x max, y min, y max, z min, z max;
  IF dim (pic) = 2
  THEN extrema (pic, x min, x max, y min, y max);
       out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) + 
                  "]  [" + text (y min) + "," + text (y max) + "] "14"")
  ELSE extrema (pic, x min, x max, y min, y max, z min, z max);
       out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) + 
                  "]  [" + text (y min) + "," + text (y max) + 
                  "]  [" + text (z min) + "," + text (z max) +"] "14"") 
  FI
END PROC extrema pic;

PROC extrema picfile:
  REAL VAR x min, x max, y min, y max, z min, z max;
  extrema (p, x min, x max, y min, y max, z min, z max);
  out (1, 2, ""5""15"Extrema: [" + text (x min) + "," + text (x max) + 
             "]  [" + text (y min) + "," + text (y max) + 
             "]  [" + text (z min) + "," + text (z max) +"] "14"") 
END PROC extrema picfile;

PROC identify (PICTURE CONST pic):
  begin plot;
  hidden lines (TRUE);
  pen (background (p), 1, 1, 2);
  plot (pic);
  end plot
END PROC identify;

PROC erase (PICTURE CONST pic):
  INT VAR colour, thickness, linetype;
  BOOL VAR hidden;

  selected pen (p, pen (pic), colour, thickness, linetype, hidden); 
  begin plot;
  hidden lines (TRUE);
  pen (background (p), 0, thickness, linetype);
  plot (pic);
  end plot
END PROC erase;

PROC show (PICTURE CONST pic):
  INT VAR colour, thickness, linetype;
  BOOL VAR hidden;

  selected pen (p, pen (pic), colour, thickness, linetype, hidden); 
  begin plot;
  hidden lines (TRUE);
  pen (background (p), colour, thickness, linetype);
  plot (pic);
  end plot
END PROC show;

END PACKET graphic editor;