(*******************************************************************)
(* Programm zur dreidimensionalen Darstellung von Matrizen         *)
(*******************************************************************)



PROGRAM DREI_DIM;

CONST
        NN = 27;

TYPE
        BILD  = ARRAY[-NN..NN,-NN..NN] OF REAL;
        INDEX = 1..NN;

VAR
        n           : INDEX;
        dx          : REAL;
        f           : BILD;
        alpha, beta : REAL;
        drucke      : (Fett, Nicht, Schmal, Hoch);

(*$I dreid.inc*)

PROCEDURE bildschirm;

CONST
        ESC = #27;       DZ = 'L';
        TAB = #9;
VAR
        b,i,j,k,j4,j8   : INTEGER;
        iz              : ARRAY[0..719] OF BYTE;


PROCEDURE drf;

VAR
        i : INTEGER;

BEGIN
        WRITE(LST,ESC,DZ,chr(Lo(720)),chr(Hi(720)));
        FOR i:= 0 to 719 DO
                WRITE(LST,CHR(iz[i]));
        WRITE(LST,ESC,chr(51),chr(1));     (* Zeilenvorschub 1/216 Zoll *)
        WRITELN(LST);
        WRITE(LST,ESC,DZ,chr(Lo(720)),chr(Hi(720)));
        FOR i:= 0 to 719 DO
                WRITE(LST,CHR(iz[i]));
        WRITE(LST,ESC,chr(65),chr(8));     (* Zeilenvorschub 8/72 Zoll  *)
        WRITELN(LST);
END;

PROCEDURE drs;

VAR
        i : INTEGER;

BEGIN
        WRITE(LST,ESC,DZ,chr(Lo(720)),chr(Hi(720)));
        FOR i:= 0 to 719 DO
                WRITE(LST,CHR(iz[i]));
        WRITELN(LST);
END;



BEGIN
WRITELN(LST);
WRITE(LST,ESC,chr(65),chr(8));  (* Zeilenabstand 8/72 Zoll *)
IF drucke = Schmal then
BEGIN
FOR j:= 0 TO 39 DO
        BEGIN
        j8:= j*8;
        FOR i:= 0 TO 719 DO
                BEGIN
                b:= 0;
                FOR k:= j8 TO j8+7 DO
                        b:= b+b+GET_PIXEL(i,k);
                iz[i]:= b;
                END;
          drs;
     END;
END
ELSE
BEGIN
FOR j:= 0 TO 62 DO
        BEGIN
        j4:= j*4;
        FOR i:= 0 TO 719 DO
                BEGIN
                b:= 0;
                FOR k:= j4 TO j4+3 DO
                      BEGIN
                        b:= b+b+GET_PIXEL(i,k);
                        b:= b+b+GET_PIXEL(i,k);
                      END;
                iz[i]:= b;
                END;
        IF drucke = Hoch then drs;
        IF drucke = Fett then drf;
     END;
END;
WRITE(LST,ESC,chr(50));         (* Zeilenabstand 1/6 Zoll *)
WRITELN(LST);
END;


PROCEDURE dreid(alpha,beta,dx: REAL; n: INDEX;
                VAR f: BILD; auto: BOOLEAN);

CONST
        LINKS = 0;
        RECHTS = 719;
        UNTEN = 247;
        OBEN = 0;

VAR
        i,j,ixmin,iymin,ixmax,iymax : INTEGER;
        sa,ca,sb,cb,cc,sc,fx,fy,xmin,xmax,ymin,ymax,x,y : REAL;
        ch : char;


PROCEDURE viereck(nl,nr,di: INTEGER);
VAR
        ix,iy   : INTEGER;
        jsa,jcc : REAL;
        p : vierecke;

BEGIN
jsa:= j*sa;
jcc:= j*cc;
i:= nl;
x:= i*ca-jsa;
p[1,0]:= ROUND(x-xmin)+ixmin;
y:= i*sc+jcc+f[i,j]*sb;
p[1,1]:= ROUND(y-ymin) +iymin;
x:= x+sa;
p[2,0]:= ROUND(x-xmin) +ixmin;
y:= y-cc+(f[i,j-1]-f[i,j])*sb;
p[2,1]:= ROUND(y-ymin) +iymin;
REPEAT
        i:= i+di;         ix:= p[1,0];    p[0,0]:= ix;
        p[4,0]:= ix;      ix:= 0;         iy:= p[1,1];
        p[0,1]:= iy;      p[4,1]:= iy;
        p[3,0]:= p[2,0];  iy:= p[2,1];
        p[3,1]:= iy;


        x:= i*ca-jsa;
        p[1,0]:= ROUND(x-xmin)+ixmin;
        y:= i*sc+jcc+f[i,j]*sb;
        iy:= ROUND(y-ymin)+iymin;
        p[1,1]:= iy;
        x:= x+sa;
        p[2,0]:= ROUND(x-xmin)+ixmin;
        y:= y-cc+(f[i,j-1]-f[i,j])*sb;
        iy:= ROUND(y-ymin)+iymin;
        p[2,1]:=iy;

               POLY_FILL(5,p,1);
        REPEAT
               LINE(p[ix,0],p[ix,1],p[ix+1,0],p[ix+1,1],0);
               ix:= ix+1;
       UNTIL ix=4;
UNTIL i=nr;
END;

BEGIN
WHILE keypressed DO
        READ(kbd,ch);

WRITE(#27,'f',#27,'E',#27,'H');
ixmin:= LINKS +3;       ixmax:= RECHTS -3;
iymin:= UNTEN -3;       iymax:= OBEN +3;
LINE(links,oben,links,unten,0);
LINE(links,unten,rechts,unten,0);
LINE(rechts,unten,rechts,oben,0);
LINE(rechts,oben,links,oben,0);
sa:= alpha*PI/180;      ca:= dx*COS(sa);        sa:= dx*SIN(sa);
sb:= beta*PI/180;       cb:= COS(sb);           sb:= SIN(sb);
IF auto THEN
        BEGIN
        xmin:= f[0,0];          xmax:= xmin;
        FOR i:= -N TO N DO
                FOR j:= -N TO N DO
                        BEGIN
                        x:= f[i,j];
                        IF x<xmin THEN
                                xmin:= x
                        ELSE IF x>xmax THEN
                                xmax:= x;
                        END;
        IF xmax<>xmin THEN
                sb:= 2*N*dx*sb/(xmax-xmin);
        END;
fx:= N*ca;              fy:= N*sa;
xmin:= -fx-fy;          xmax:= xmin;
x:= fx-fy;
IF x<xmin THEN xmin:= x;
IF x>xmax THEN xmax:= x;
x:= fy-fx;
IF x<xmin THEN xmin:= x;
IF x>xmax THEN xmax:= x;
x:= fx+fy;
IF x<xmin THEN xmin:= x;
IF x>xmax THEN xmax:= x;
ymin:= f[0,0]*sb;       ymax:= ymin;
cc:= ca*cb;             sc:= sa*cb;
FOR j:= N DOWNTO -N DO
        BEGIN
        fy:= j*cc-N*sc;
        FOR i:= -N TO N DO
                BEGIN
                y:= fy+f[i,j]*sb;
                fy:= fy+sc;
                IF y<ymin THEN
                        ymin:= y
                ELSE IF y>ymax THEN
                        ymax:= y;
                END;
        END;
fx:= (ixmax-ixmin)/(xmax-xmin);
xmin:= xmin*fx;
fy:= (iymax-iymin)/(ymax-Ymin);
ymin:= ymin*fy;
sa:= sa*fx;     ca:= ca*fx;     cc:= cc*fy;
sc:= sc*fy;     sb:= sb*fy;

IF ca>0 THEN
        FOR j:= N DOWNTO -N+1 DO
                IF sa>0 THEN
                        viereck(N,-N,-1)
                ELSE
                        viereck(-N,N,1)
ELSE
        FOR j:= -N+1 TO N DO
                IF sa>0 THEN
                        viereck(N,-N,-1)
                ELSE
                        viereck(-N,N,1);
END;

PROCEDURE auswahl;
CONST
        FORM= #18;
        ESC = #27;
        TAB = #9;
VAR
        ch: CHAR;

BEGIN
drucke:=nicht;
READ(kbd,ch);
IF ch=FORM THEN drucke := schmal;
IF ch=ESC  THEN drucke := fett;
IF ch=TAB  THEN drucke := hoch;
IF drucke <> nicht THEN bildschirm;
WRITE(TAB);
END;

PROCEDURE daten(VAR n: INDEX; VAR dx: REAL; VAR f: BILD);
VAR
        i,j : INTEGER;
        x,y : REAL;

BEGIN
WRITELN(' Berechnung der Bilddaten, bitte warten!');
N:= 27;
dx:= 0.35;
FOR i:= -n TO n DO
        BEGIN
        x:= 1.25*dx*i;
        IF x=0.0 THEN
                x:= 1.0
        ELSE
                x:= SIN(x)/x;
        FOR j:= -n TO n DO
                BEGIN
                y:= dx*j;
                IF y=0.0 THEN
                        y:= 1.0
                ELSE
                        y:= SIN(y)/y;
                f[i,j]:= x*y;
                END;
       END;
END;


BEGIN
GRAPHINIT;
ClrScr;
daten(n,dx,f);
REPEAT
        WRITELN(#27,'E',#27,'H',#27,'e');  (* loescht Bildschirm,
                                              Cursor home, Cursor aus *)
        WRITELN('Dreh- und Neigungwinkel alpha und beta eingeben',
                ' (Abbruch, wenn beta=0)');
        WRITELN; WRITE(' alpha: ');
        READLN(alpha);
        WRITE(' beta:  '); READ(beta);
        IF beta<>0 THEN
                BEGIN
                dreid(alpha,beta,dx,n,f,TRUE);
                REPEAT
                auswahl;
                UNTIL drucke = nicht;
                END;
UNTIL beta=0;
SHOWCURSOR;
END.

