sw/src/pascal/KREUZ.PS

   1 PROGRAM PLOTKREUZKURVE(INPUT,OUTPUT);
   2
   3   CONST H0=640;
   4
   5   VAR   N,H,I,R: INTEGER;
   6
   7   PROCEDURE ANFANG;
   8     BEGIN
   9         WRITELN("H", H DIV 2 + 100 :1, "@", H + H DIV 2 + 100 :1, "AKI")
  10     END (* ANFANG *);
  11
  12   PROCEDURE STRECKE(R: INTEGER);
  13     BEGIN
  14         CASE R MOD 4 OF
  15           0: WRITELN(H:1,"A@J");
  16           1: WRITELN(H:1,"@AJ");
  17           2: WRITELN(H:1,"Q@J");
  18           3: WRITELN(H:1,"PAJ")
  19         END
  20     END (* STRECKE *);
  21
  22   PROCEDURE SCHLUSS;
  23     VAR I: INTEGER;
  24     BEGIN
  25         WRITELN("H3000@100AK");
  26         FOR I := 1 TO 384 DO WRITE(" "); WRITELN
  27     END (* SCHLUSS *);
  28
  29
  30   PROCEDURE KREUZ(I,R: INTEGER);
  31     BEGIN
  32         IF I>0 THEN
  33             BEGIN
  34                 KREUZ(I-1,R);
  35                   STRECKE(R+1); STRECKE(R);
  36                 KREUZ(I-1,R+1);
  37                   STRECKE(R);
  38                 KREUZ(I-1,R-1);
  39                   STRECKE(R); STRECKE(R-1);
  40                 KREUZ(I-1,R)
  41             END ELSE STRECKE(R)
  42     END (* KREUZ *);
  43
  44
  45 BEGIN
  46     WHILE NOT EOF DO
  47     BEGIN READ(N);
  48         H := H0; FOR I := 1 TO N DO H := H DIV 2;
  49         ANFANG;
  50         FOR R := 0 TO 3 DO
  51             BEGIN KREUZ(N,R); STRECKE(R+1); STRECKE(R) END;
  52         SCHLUSS
  53     END
  54 END.