app/mpg/1987/src/BASISPLT.ELA

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
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
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
PACKET basis plot DEFINES                       (* Autor: H. Indenbirken *)
                                                (* Stand: 30.12.84       *)
(**********************  Hardwareunabhängiger Teil  *************************
*                                                                           * 
*                                                                           * 
*        Im Harwareunabhängigen Paket 'transformation' werden folgende      *
*        Prozeduren definiert:                                              * 
*        Procedure       :  Bedeutung                                       * 
*        -------------------------------------------------------------------* 
*        transform     :  Sie Prozedur projeziert einen dreidimensionalen * 
*                           Vektor (x,y,z) auf einen zweidimensionalen (h,v)* 
*        set values    :  Mit dieser Prozedur werden die Projektionspara- * 
*                           meter gesetzt.                                  * 
*                           size:    Weltkoordinatenbereich                 *
*                                    ((xmin,xmax),(ymin,ymax),(zmin,zmax))  *
*                           limits:  Zeichenfläche                          *
*                                    ((h min, h max), (v min, v max))       *
*                                    Bei Werten < 2.0 werden die Werte als  *
*                                    Prozente interpretiert, ansonsten als  *
*                                    cm-Grössen.                            *
*        get values    :  Übergibt die aktuellen Werte                    *
*        new values    :  Vermerkt neue Werte                             *
*                                                                           *
*                                                                           *
*        drawing area  :  Übergibt die aktuelle Zeichengröße in Pixel.    *
*                                                                           *
*        angles        :  a) alpha:      Winkel der Y-Achse in Grad       *
*                           b) (x, y, z):  karth. Projektionswinkel         *
*        oblique       :  Schiefwinklige Projektion mit dem               *
*                           Normalenvektor (a, b).                          *
*        perspective   :  Perspektive mit dem Betrachtungsstandort        *
*                           (x, y, z).                                      *
*        window        :  siehe set values, size                          *
*        viewport      :  siehe set values, limit                         *
*        view          :  siehe set values, angle                         *
*        oblique       :  Schiefwinklige Projektion                       *
*        orthographic  :  Orthografische Projektion                       *
*        perspective   :  Perspektivische Projektion                      *
*                                                                           *
*                                                                           *
*        box           :  Rahmen um die aktuelle Zeichenfläche            *
*        reset         :  Löscht alte verdeckte Linien                    *
*        hidden lines  :  Unterdrückt verdeckte Linien                    *
*                                                                           *
*        move          :  Positioniert auf (x, y, [z]) in Weltkoordinaten *
*        draw          :  Zeichnet eine Linie bis zum Punkt (x, y, [z]).  *
*        move r        :  Positioniert (x, y, [z]) weiter                 *
*        draw r        :  Zeichnet (x, y, [z]) weiter                     *
*        move cm       :  Positioniert auf (x cm, y cm).                  *
*        draw cm       :  Zeichnet eine Linie bis (x cm, y cm)            *
*        move cm r     :  Positioniert (x cm, y cm) weiter                *
*        draw cm r     :  Zeichnet (x cm, y cm) weiter                    *
*                                                                           *
*        bar           :  Balken mit (hight, width, pattern)              *
*        circle        :  Kreis(segment) mit (radius, from, to, pattern)  *
*                                                                           *
*        where         :  Gibt die aktuelle Stiftposition (x, y, [z])     *
*                                                                           *
*        get cursor    :  Graphische Eingabe                              *
*                                                                           *
*                                                                           *
****************************************************************************)

       transform, 
       set values,
       get values,
       new values,
       drawing area,

       window, 
       viewport,
       view, 
       oblique, 
       orthographic, 
       perspective,

       box,
       reset,
       hidden lines,

       move, 
       draw, 
       move r, 
       draw r, 
       move cm, 
       draw cm, 
       move cm r, 
       draw cm r, 
       bar,
       circle,

       where:

BOOL VAR new limits :: TRUE, values new :: TRUE,
         perspective projektion :: FALSE;
INT VAR pixel hor, pixel vert;
REAL VAR display hor, display vert,           (* Anzahl der Pixel        *)
         size hor, size vert;                 (* Groesse des Bildschirms *)
drawing area (size hor, size vert, pixel hor, pixel vert);
display hor := real (pixel hor);  display vert := real (pixel vert);

REAL VAR h min limit :: 0.0, h max limit :: display hor,
         v min limit :: 0.0, v max limit :: display vert,
         h min :: 0.0, h max :: size hor,
         v min :: 0.0, v max :: size vert,
         hor relation :: display hor/size hor,
         vert relation :: display vert/size vert,
         relation :: size hor/size vert;
 
ROW 5 ROW 5 REAL VAR p :: ROW 5 ROW 5 REAL :
                          (ROW 5 REAL : (1.0, 0.0, 0.0, 0.0, 0.0),
                           ROW 5 REAL : (0.0, 1.0, 0.0, 0.0, 0.0),
                           ROW 5 REAL : (0.0, 0.0, 1.0, 0.0, 0.0),
                           ROW 5 REAL : (0.0, 0.0, 0.0, 1.0, 0.0),
                           ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0));

ROW 3 ROW 2 REAL VAR size d :: ROW 3 ROW 2 REAL :
                              (ROW 2 REAL : (0.0, 1.0),
                               ROW 2 REAL : (0.0, 1.0),
                               ROW 2 REAL : (0.0, 1.0)),
                     last size :: size d;
ROW 2 ROW 2 REAL VAR limits d :: ROW 2 ROW 2 REAL :
                                (ROW 2 REAL : (0.0, relation),
                                 ROW 2 REAL : (0.0, 1.0));
ROW 4 REAL VAR angles d :: ROW 4 REAL : (0.0, 0.0, 0.0, 0.0);
ROW 2 REAL VAR oblique d :: ROW 2 REAL : (0.0, 0.0);
ROW 3 REAL VAR perspective d :: ROW 3 REAL : (0.0, 0.0, 0.0);
REAL VAR size hor d := size hor, size vert d := size vert;
INT VAR pixel hor d := pixel hor, pixel vert d := pixel vert;

INT VAR i, j, k;

BOOL OP = (ROW 3 ROW 2 REAL CONST l, r):
  FOR i FROM 1 UPTO 3
  REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2]
      THEN LEAVE = WITH FALSE FI
  PER;
  TRUE
END OP =;

BOOL OP = (ROW 2 ROW 2 REAL CONST l, r):
  FOR i FROM 1 UPTO 2
  REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2]
      THEN LEAVE = WITH FALSE FI
  PER;
  TRUE
END OP =;

BOOL OP = (ROW 2 REAL CONST l, r):
  l [1] = r [1] AND l [2] = r [2]
END OP =;

BOOL OP = (ROW 3 REAL CONST l, r):
  l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3]
END OP =;

BOOL OP = (ROW 4 REAL CONST l, r):
  l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3] AND l [4] = r [4] 
END OP =;

PROC oblique (REAL CONST a, b) :
  set values (size d, limits d, angles d, ROW 2 REAL : (a, b), ROW 3 REAL : (0.0, 0.0, 0.0)) 
END PROC oblique;

PROC orthographic :
  set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (0.0, 0.0, 0.0))
END PROC orthographic;

PROC perspective (REAL CONST cx, cy, cz) :
  set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (cx, cy, cz))
END PROC perspective;

PROC window (BOOL CONST dev) :
  new limits := dev
END PROC window;

PROC window (REAL CONST x min, x max, y min, y max) :
  window (x min, x max, y min, y max, 0.0, 1.0)
END PROC window;

PROC window (REAL CONST x min, x max, y min, y max, z min, z max) :
  set values (ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max),
                                  ROW 2 REAL : (y min, y max),
                                  ROW 2 REAL : (z min, z max)),
              limits d, angles d, oblique d, perspective d)
END PROC window;

PROC viewport (REAL CONST h min, h max, v min, v max) :
  set values (size d, ROW 2 ROW 2 REAL : (ROW 2 REAL : (h min, h max), 
                                          ROW 2 REAL : (v min, v max)),
              angles d, oblique d, perspective d)
END PROC view port;

PROC view (REAL CONST alpha) :
  set values (size d, limits d, ROW 4 REAL : (alpha, angles d(2), angles d (3), angles d (4)),
              oblique d, perspective d)
END PROC view;

PROC view (REAL CONST phi, theta) :
  set values (size d, limits d, ROW 4 REAL : (angles d(1), sind (theta) * cosd (phi),
                                              sind (theta) * sind (phi), cosd (theta)),
              oblique d, perspective d)
END PROC view;

PROC view (REAL CONST x, y, z) :
  set values (size d, limits d, ROW 4 REAL : (angles d (1), x, y, z), oblique d, perspective d)
END PROC view;

set values (size d, limits d, angles d, oblique d, perspective d);

PROC drawing area (REAL VAR min h, max h, min v, max v):
  min h := h min limit;  max h := h max limit;
  min v := v min limit;  max v := v max limit
END PROC drawing area;
 
BOOL PROC new values:
  IF values new
  THEN values new := FALSE;
       TRUE
  ELSE FALSE FI
END PROC new values;

PROC get values (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) : 
  size        := size d;
  limits      := limits d;
  angles      := angles d;
  oblique     := oblique d;
  perspective := perspective d;

END PROC get values;

PROC set values (ROW 3 ROW 2 REAL CONST size, 
                 ROW 2 ROW 2 REAL CONST limits,
                 ROW 4 REAL CONST angles,
                 ROW 2 REAL CONST oblique,
                 ROW 3 REAL CONST perspective) : 
   drawing area (size hor, size vert, pixel hor, pixel vert);
   display hor := real (pixel hor);  display vert := real (pixel vert);
   IF NOT same values
   THEN values new := TRUE;
        copy values;
        set views;
        check perspective projektion; 
        calc limits;
        change projektion
   FI  .

same values:
  size hor d  = size hor  AND size vert d  = size vert AND
  pixel hor d = pixel hor AND pixel vert d = pixel vert AND
  size d = size AND limits d = limits AND angles d = angles AND
  oblique d = oblique AND perspective d = perspective  . 

copy values :
  size hor d := size hor;
  size vert d := size vert;
  pixel hor d := pixel hor;
  pixel vert d := pixel vert;
  size d := size;
  limits d := limits;
  angles d := angles;
  oblique d := oblique;
  perspective d := perspective  .

set views :
  REAL VAR diagonale := sqrt (angles [2] * angles [2] +
                              angles [3] * angles [3] +
                              angles [4] * angles [4]),
           projektion := sqrt (angles [2] * angles [2] +
                               angles [4] * angles [4]),
           sin p, cos p, sin t, cos t, sin a, cos a;

           IF diagonale = 0.0
           THEN sin p :=  0.0;  cos p :=  1.0;
                sin t :=  0.0;  cos t :=  1.0
           ELIF projektion = 0.0
           THEN sin p :=  angles [3] / diagonale;
                cos p :=  projektion / diagonale;
                sin t :=  0.0;  cos t :=  1.0
           ELSE sin p :=  angles [3] / diagonale;
                cos p :=  projektion / diagonale;
                sin t :=  angles [2] / projektion;
                cos t :=  angles [4] / projektion
           FI;

  REAL VAR   sin p sin t := sin p * sin t,
             sin p cos t := sin p * cos t,
             cos p sin t := cos p * sin t,
             cos p cos t := cos p * cos t,

             dx          := size [1][2] - size [1][1],
             dy          := size [2][2] - size [2][1],
             dz          := size [3][2] - size [3][1],
             norm az     := oblique [1] ,
             norm bz     := oblique [2] ,
             norm cx     := perspective [1] / dx,
             norm cy     := perspective [2] / dy,
             norm cz     := perspective [3] / dz,
             xx          := - size [1][1] / dx * cos p sin t -
                              size [2][1] / dy * sin p + 
                              size [3][1] / dz * cos p cos t;

p :=  ROW 5 ROW 5 REAL :
      (ROW 5 REAL : (  cos t       / dx - cos p sin t / dx * norm az ,
                     - sin p sin t / dx - cos p sin t / dx * norm bz,
                       0.0,
                                        - cos p sin t / dx * norm cz,
                       0.0 ),
       ROW 5 REAL : (                   - sin p       / dy * norm az,
                       cos p       / dy - sin p       / dy * norm bz,
                       0.0, 
                                        - sin p       / dy * norm cz,
                       0.0 ),
       ROW 5 REAL : (  sin t       / dz + cos p cos t / dz * norm az,
                     + sin p cos t / dz + cos p cos t / dz * norm bz,
                       0.0,
                                        cos p cos t / dz * norm cz,
                       0.0 ),
       ROW 5 REAL : (- norm cx, - norm cy, 0.0, 1.0, 0.0 ),
       ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0));

  IF angles (1) = 0.0
  THEN set alpha as y vertical
  ELSE sin a := sind (angles (1));
       cos a := cosd (angles (1))
  FI;
 
  FOR j FROM 1 UPTO 5
  REP REAL CONST p  j 1 := p (j)(1);
      p (j)(1) :=  p  j  1  * cos a - p (j)(2) * sin a;
      p (j)(2) :=  p  j  1  * sin a + p (j)(2) * cos a 
  PER  .

set alpha as y vertical :
  REAL VAR r := sqrt (p(2)(1)**2 + p(2)(2)**2);
  IF r = 0.0
  THEN sin a := 0.0;
       cos a := 1.0
  ELSE sin a :=-p(2)(1)/r;
       cos a := p(2)(2)/r
  FI  .

check perspective projektion:
  perspective projektion := perspective [3] <> 0.0  .

calc limits :
  IF new limits
  THEN calc two dim extrema;
       IF all limits smaller than 2
       THEN prozente
       ELSE zentimeter FI
  FI  .

calc two dim extrema :
  h min := max real;  h max :=-max real;
  v min := max real;  v max :=-max real;
 
  extrema (size [1][1], size [2][1], size [3][1], h min, h max, v min, v max); 
  extrema (size [1][2], size [2][1], size [3][1], h min, h max, v min, v max);
  extrema (size [1][2], size [2][2], size [3][1], h min, h max, v min, v max); 
  extrema (size [1][1], size [2][2], size [3][1], h min, h max, v min, v max);
  extrema (size [1][1], size [2][1], size [3][2], h min, h max, v min, v max); 
  extrema (size [1][2], size [2][1], size [3][2], h min, h max, v min, v max);
  extrema (size [1][2], size [2][2], size [3][2], h min, h max, v min, v max); 
  extrema (size [1][1], size [2][2], size [3][2], h min, h max, v min, v max)  .

all limits smaller than 2 :
  limits (1)(2) < 2.0 AND limits (2)(2) < 2.0  .

prozente :
  h min limit := display hor * limits (1)(1)/relation;
  h max limit := display hor * limits (1)(2)/relation;
 
  v min limit := limits (2)(1) * display vert;
  v max limit := limits (2)(2) * display vert  .
 
zentimeter : 
  h min limit := display hor * (limits (1)(1)/size hor);
  h max limit := display hor * (limits (1)(2)/size hor);
 
  v min limit := display vert * (limits (2)(1)/size vert);
  v max limit := display vert * (limits (2)(2)/size vert)  .

change projektion :
  REAL VAR sh := (h max limit - h min limit) / (h max - h min),
           sv := (v max limit - v min limit) / (v max - v min),
           dh := h min limit - h min*sh,
           dv := v min limit - v min*sv;

  FOR j FROM 1 UPTO 5
  REP
     p (j)(1) := p (j)(1) * sh;
     p (j)(2) := p (j)(2) * sv
  PER;
  p (5)(1) := dh;
  p (5)(2) := dv.
END PROC set values;
 
PROC transform (REAL CONST x, y, z, INT VAR h, v) :
  disable stop;
  IF perspective projektion
  THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);
       h := int ((x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (4)(1))*w + p (5)(1));
       v := int ((x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (4)(2))*w + p (5)(2))
  ELSE h := int (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (5)(1));
       v := int (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (5)(2));
  FI;
  IF is error
  THEN h := -1;
       v := -1;
       clear error
  FI
END PROC transform;

PROC extrema (REAL CONST x, y, z, REAL VAR h min, h max, v min, v max):
  REAL VAR h, v;
  IF perspective projektion
  THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0);
       h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) +p (4)(1))*w;
       v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) +p (4)(2))*w
  ELSE h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1));
       v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2))
  FI;
 
 IF h < h min
 THEN h min := h
 ELIF h > h max
 THEN h max := h FI;

 IF v < v min
 THEN v min := v
 ELIF v > v max
 THEN v max := v FI

END PROC extrema;

(**************************** Plot Prozeduren ****************************)
LET empty              = 0,             {Punktmuster} 
    half               = 1,
    full               = 2,
    horizontal         = 3,
    vertical           = 4,
    cross              = 5,
    diagonal right     = 6,
    diagonal left      = 7,
    diagonal both      = 8;

LET POS = STRUCT (REAL x, y, z);
POS VAR pos :: POS : (0.0, 0.0, 0.0);
INT VAR h :: 0, v :: 0, new h :: 0, new v :: 0;
BOOL VAR hidden :: FALSE;
DATASPACE VAR ds :: nilspace;
BOUND STRUCT (ROW 32764 INT akt, last) VAR maxima :: ds;


PROC box :
  move (int (h min limit+0.5), int (v min limit+0.5));
  draw (int (h max limit+0.5), int (v min limit+0.5));
  draw (int (h max limit+0.5), int (v max limit+0.5));
  draw (int (h min limit+0.5), int (v max limit+0.5));
  draw (int (h min limit+0.5), int (v min limit+0.5))
END PROC box;
 
PROC reset:
  forget (ds);
  ds := nilspace;
  maxima := ds
END PROC reset;

PROC move (REAL CONST x, y) :
  IF hidden 
  THEN maxima.last := maxima.akt FI;

  transform (x, y, 0.0, h, v);
  move (h, v);
  pos := POS : (x, y, 0.0)
END PROC move;

PROC move (REAL CONST x, y, z) :
  IF hidden 
  THEN maxima.last := maxima.akt FI;

  transform (x, y, z, h, v);
  move (h, v);
  pos := POS : (x, y, z)
END PROC move;

PROC draw (REAL CONST x, y) :
  IF hidden
  THEN transform (x, y, 0.0, new h, new v);
       vector (new h-h, new v-v)
  ELSE transform (x, y, 0.0, h, v);
       draw (h, v)
  FI;
  pos := POS : (x, y, 0.0)
END PROC draw;

PROC draw (REAL CONST x, y, z) :
  IF hidden
  THEN transform (x, y, z, new h, new v);
       vector (new h-h, new v-v)
  ELSE transform (x, y, z, h, v);
       draw (h, v)
  FI;
  pos := POS : (x, y, z) 
END PROC draw;

PROC move r (REAL CONST x, y) :
  IF hidden 
  THEN maxima.last := maxima.akt FI;

  transform (pos.x+x, pos.y+y, pos.z, h, v);
  move (h, v);
  pos := POS : (pos.x+x, pos.y+y, pos.z)
END PROC move r;

PROC move r (REAL CONST x, y, z) :
  IF hidden 
  THEN maxima.last := maxima.akt FI;

  transform (pos.x+x, pos.y+y, pos.z+z, h, v);
  move (h, v);
  pos := POS : (pos.x+x, pos.y+y, pos.z+z)
END PROC move r;

PROC draw r (REAL CONST x, y) :
  IF hidden
  THEN transform (pos.x+x, pos.y+y, pos.z, h, v); 
       vector (new h-h, new v-v)
  ELSE transform (pos.x+x, pos.y+y, pos.z, h, v); 
       draw (h, v)
  FI;
  pos := POS : (pos.x+x, pos.y+y, pos.z)
END PROC draw r;

PROC draw r (REAL CONST x, y, z) :
  IF hidden
  THEN transform (pos.x+x, pos.y+y, pos.z+z, h, v); 
       vector (new h-h, new v-v)
  ELSE transform (pos.x+x, pos.y+y, pos.z+z, h, v);
       draw (h, v)
  FI;
  pos := POS : (pos.x+x, pos.y+y, pos.z+z)
END PROC draw r;

PROC move cm (REAL CONST x cm, y cm) :
  IF hidden 
  THEN maxima.last := maxima.akt FI;

  h := int (x cm*hor relation+0.5);
  v := int (y cm*vert relation+0.5);
  move (h, v)
END PROC move cm;

PROC draw cm (REAL CONST x cm, y cm) :
  IF hidden
  THEN vector (int (x cm*hor relation+0.5)-h, int (y cm*vert relation+0.5)-v)
  ELSE h := int (x cm*hor relation+0.5);
       v := int (y cm*vert relation+0.5);
       draw (h, v)
  FI
END PROC draw cm;

PROC move cm r (REAL CONST x cm, y cm) :
  IF hidden 
  THEN maxima.last := maxima.akt FI;

  h INCR int (x cm*hor relation+0.5);
  v INCR int (y cm*vert relation+0.5);
  move (h, v)
END PROC move cm r;

PROC draw cm r (REAL CONST x cm, y cm) :
  IF hidden
  THEN vector (int (x cm*hor relation+0.5), int (y cm*vert relation+0.5))
  ELSE h INCR int (x cm*hor relation+0.5);
       v INCR int (y cm*vert relation+0.5);
       draw (h, v)
  FI
END PROC draw cm r;

PROC hidden lines (BOOL CONST dev):
  hidden := NOT dev;
END PROC hidden lines;

PROC vector (INT CONST dx, dy):
  IF dx >= 0
  THEN IF   dy >  dx THEN vector (v, h, dy, dx,  1, 1)
       ELIF dy >   0 THEN vector (h, v, dx, dy,  1, 1)
 
       ELIF dy > -dx THEN vector (h, v, dx, -dy, 1,-1)
       ELSE               vector (v, h, -dy, dx,-1, 1) FI

  ELSE IF   dy > -dx THEN vector (v, h, dy, -dx, 1,-1)
       ELIF dy >   0 THEN vector (h, v, -dx, dy,-1, 1)
 
       ELIF dy >  dx THEN vector (h, v, -dx, -dy,-1,-1)
       ELSE               vector (v, h, -dy, -dx,-1,-1) FI
  FI  .
 
ENDPROC vector ;
 
PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) :
  INT VAR i;
  prepare first step ;
  draw point;
  FOR i FROM 1 UPTO dx
  REP do one step PER;

  IF was visible
  THEN draw (h, v) FI  .


prepare first step :
  INT VAR up right error := dy - dx,
          right error := dy,
          old error := 0,
          last h :: h, last v :: v;
  BOOL VAR was visible :: visible  .


do one step:
  IF right is better
    THEN do right step
    ELSE do up right step
  FI .
 
right is better :
  abs (old error + right error) < abs (old error + up right error)  .
 
do upright step :
  x pos INCR right ;
  y pos INCR up ;
  draw point ;
  old error INCR upright error .
 
do right step :
  x pos INCR right ;
  draw point ;
  old error INCR right error .
 
draw point :
  IF was visible
  THEN IF NOT visible
       THEN draw (last h, last v);
            was visible := FALSE
       FI;
       last h := h;
       last v := v
  ELSE IF visible
       THEN move (h, v);
            was visible := TRUE;
            last h := h;
            last v := v 
       FI
 FI  .

visible:
  IF h < 1 OR h > pixel hor
  THEN FALSE
  ELSE IF maxima.akt [h] < v 
       THEN maxima.akt [h] := v FI; 
       v > maxima.last [h]
  FI
END PROC vector;
 
PROC where (REAL VAR x, y) :
  x := pos.x;  y := pos.y
END PROC where;

PROC where (REAL VAR x, y, z) :
  x := pos.x;  y := pos.y;  z := pos.z
END PROC where;

PROC bar (REAL CONST hight, width, INT CONST pattern):
  INT VAR zero x, zero y, end x, end y;
  transform (0.0, 0.0, 0.0, zero x, zero y);
  transform (width, hight, 0.0, end x, end y);
  bar (h-(end x-zero x) DIV 2, v, end x-zero x, end y-zero y, pattern)
END PROC bar;

PROC bar (INT CONST from x, from y, width, hight, pattern):
  INT CONST to x :: from x+width, to y :: from y+hight;
  INT VAR x, y;
  draw frame;
  SELECT pattern OF
  CASE empty: (* nothing to do *)
  CASE half:           half bar
  CASE full:           full bar
  CASE horizontal:     horizontal bar
  CASE vertical:       vertical bar
  CASE cross:          horizontal bar;
                       vertical bar
  CASE diagonal right: diagonal right bar
  CASE diagonal left:  diagonal left bar
  CASE diagonal both:  diagonal both bar
  OTHERWISE errorstop ("Unknown pattern") ENDSELECT  .

draw frame:
  move (from x, from y);
  draw (from x, to y);
  draw (to x, to y);
  draw (to x, from y)  .

full bar:
  FOR y FROM from y UPTO to y
  REP move (from x, y);
      draw (to x, y) 
  PER  .

half bar:
  FOR y FROM from y UPTO to y
  REP x := from x + 1 + (y AND 1);
      WHILE x < to x 
      REP move (x, y);
          draw (x, y);
          x INCR 2
      PER
  PER  .

horizontal bar:
  y := from y;
  WHILE y < to y
  REP move (from x, y);
      draw (to x, y);
      y INCR 5
  PER  .

vertical bar:
  x := from x + 5;
  WHILE x < to x
  REP move (x, from y);
      draw (x, to y);
      x INCR 5
  PER  .

diagonal right bar:
  y := from y-width+5;
  WHILE y < to y
  REP move (max (from x, to x-y-width+from y), max (from y, y));
      draw (min (to x, from x+to y-y), min (to y, y+width));
      y INCR 5
  PER  .

diagonal left bar:
  y := from y-width+5;
  WHILE y < to y
  REP move (min (to x, to x-from y+y),  max (from y, y));
      draw (max (from x, from x+y+width-to y), min (to y, y+width)); 
      y INCR 5
  PER  .

diagonal both bar:
  y := from y-width+5;
  WHILE y < to y
  REP move (max (from x, to x-y-width+from y), max (from y, y));
      draw (min (to x, from x+to y-y), min (to y, y+width)); 
      move (min (to x, to x-from y+y),  max (from y, y));
      draw (max (from x, from x+y+width-to y), min (to y, y+width));
      y INCR 5
  PER  .

END PROC bar;

PROC circle (REAL CONST r, from, to, INT CONST pattern):
  REAL VAR t :: from;
  WHILE t < to
  REP transform (pos.x + r*cosd (t), pos.y + r*sind (t), 0.0, h, v);
      draw (h, v);
      t INCR 1.0
  PER;
  transform (pos.x, pos.y, 0.0, h, v);
  draw (h, v)  .

END PROC circle;

ENDPACKET basis plot;