sw/src/pascal/ALTREE.PS

   1 PROGRAM PLOTALLTREES(INPUT,OUTPUT);
   2
   3   VAR   N,TREE: INTEGER;
   4         OX,OY: REAL;
   5         X,Y: ARRAY[1..6] OF REAL;
   6         U,V: ARRAY[1..6] OF INTEGER;
   7
   8       PENXPOS,PENYPOS: INTEGER;
   9
  10 (********** P L O T T E R  PROZEDUREN **********)
  11
  12 PROCEDURE PEN(I:CHAR);
  13     BEGIN WRITE(I) END;
  14
  15 PROCEDURE SEND(IX,IY: INTEGER);
  16     BEGIN
  17       IF IX>=0  THEN WRITE( IX:1,"@")
  18                 ELSE WRITE(-IX:1,"P");
  19       IF IY>=0  THEN WRITE( IY:1,"A")
  20                 ELSE WRITE(-IY:1,"Q")
  21     END;
  22
  23 PROCEDURE MOVE(X,Y: REAL);
  24     BEGIN
  25       PENXPOS:=ROUND(X); PENYPOS:=ROUND(Y);
  26       WRITE("H");
  27       SEND(PENXPOS,PENYPOS);
  28       WRITELN("K")
  29     END;
  30
  31 PROCEDURE LINE(X,Y: REAL);
  32   VAR DX,DY: INTEGER;
  33     BEGIN
  34       DX:=ROUND(X)-PENXPOS;
  35       DY:=ROUND(Y)-PENYPOS;
  36       SEND(DX,DY); WRITELN("J");
  37       PENXPOS:=PENXPOS+DX; PENYPOS:=PENYPOS+DY
  38     END;
  39
  40 PROCEDURE SYSIZE(R,G: INTEGER);
  41     BEGIN
  42       WRITE("C", CHR(G+16*(R+2)))
  43     END;
  44
  45 PROCEDURE BLATTWECHSEL;
  46   BEGIN PEN("H"); WRITELN(" ":384); TREE := 0 END;
  47 (***********************************************)
  48
  49 PROCEDURE INITPOINTS;
  50   CONST R=150.0; RAD=0.0174533;
  51   VAR   I: INTEGER;
  52         P1W: ARRAY[3..6] OF REAL;
  53 BEGIN
  54     P1W[3] := -30.0; P1W[4] := 45.0; P1W[5] := 18.0; P1W[6] := 60.0;
  55     FOR I := 1 TO N DO
  56         BEGIN
  57             X[I] := R*COS( (I*360/N + P1W[N]) * RAD);
  58             Y[I] := R*SIN( (I*360/N + P1W[N]) * RAD)
  59         END
  60 END (* INITPOINTS *);
  61
  62
  63 PROCEDURE DECODE;
  64   VAR   I,K: INTEGER;
  65         Z: ARRAY[1..6] OF INTEGER;
  66 BEGIN
  67     FOR I := 1 TO N DO Z[I] := 0;
  68     FOR K := 1 TO N-1 DO Z[ V[K] ] := Z[ V[K] ] + 1;
  69     FOR K := 1 TO N-1 DO
  70         BEGIN I := 1; WHILE Z[I]<>0 DO I := I + 1;
  71             U[K] := I;
  72             Z[I] := -1  (* FORGET THIS VERTEX *);
  73             Z[ V[K] ] := Z[ V[K] ] - 1
  74         END
  75 END (* DECODE *);
  76
  77
  78 PROCEDURE PLOTTREE;
  79   VAR   K: INTEGER;
  80 BEGIN
  81     DECODE;
  82     OX :=  200 + 400*(TREE MOD 9);
  83     OY := 2600 - 400*(TREE DIV 9);
  84     FOR K := 1 TO N-1 DO
  85         BEGIN
  86             MOVE(OX+X[ U[K] ], OY+Y[ U[K] ]); PEN("I");
  87             LINE(OX+X[ V[K] ], OY+Y[ V[K] ])
  88         END;
  89     TREE := TREE + 1; IF TREE=63 THEN BLATTWECHSEL
  90 END (* PLOTTREE *);
  91
  92 PROCEDURE COMBITREE(N,K: INTEGER);
  93   VAR Z: INTEGER;
  94 BEGIN
  95     IF K>0 THEN
  96         BEGIN   FOR Z := 1 TO N DO
  97                 BEGIN V[K] := Z; COMBITREE(N,K-1) END
  98         END ELSE PLOTTREE
  99 END (* COMBITREE *);
 100
 101
 102
 103 BEGIN
 104         READ(N);
 105         INITPOINTS;
 106         TREE := 0;
 107         V[N-1] := N;  COMBITREE(N,N-2);
 108         BLATTWECHSEL
 109 END.