(*******************************************************************) (* 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 xxmax 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 xxmax THEN xmax:= x; x:= fy-fx; IF xxmax THEN xmax:= x; x:= fx+fy; IF xxmax 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 yymax 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.