home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
sonderh1
/
dreidim.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1979-12-31
|
10KB
|
330 lines
{---------------------------------------------------------------------}
{ Programm zur dreidimensionalen Darstellung von Matrizen }
{---------------------------------------------------------------------}
PROGRAM DREI_DIM;
CONST PI = 3.1415926536;
NN = 36; { MAXIMAL (2*NN+1)*(2*NN+1) BILDPUNKTE }
TYPE BILD = ARRAY[-NN..NN,-NN..NN] OF REAL;
INDEX = 1..NN;
VAR N: INDEX; { (2*N+1)*(2*N+1) BILDPUNKTE }
DX: REAL; { ACHSENINTERVALL }
F: BILD; { BILDMATRIX }
ALFA, BETA: REAL; { DREH- UND NEIGUNGSWINKEL }
DRUCKE: (FETT,NICHT,SCHNELL); { DRUCKERMODUS }
{=====================================================================}
{ DRUCKERAUSGABE DES BILDSCHIRMS }
PROCEDURE BILDSCHIRM;
CONST CR = #13; ESC = #27;
DS = '*'; { AUSWAHL DES GRAFIKMODUS: }
D4 = #4; { 640 PUNKTE PRO ZEILE }
DZ = 'Z'; { GRAFIKMODUS: 1920 PUNKTE PRO ZEILE }
DJ = 'J'; { PAPIERVORSCHUB IN 1/216 ZOLL }
VAR B, I, J, K, J8: INTEGER;
IZ: ARRAY[0..639] OF BYTE;
{-------------------------------------------------------------------}
{ SCHNELLDRUCK EINER ZEILE }
PROCEDURE DRS;
VAR I: INTEGER;
BEGIN
WRITE(ESC, DS, D4, #128, #2); { 2*256+128 = 640 }
FOR I := 0 TO 639 DO
WRITE(CHR(IZ[I]));
WRITE(ESC,DJ,#24,CR);
END;
{-------------------------------------------------------------------}
{ FETTDRUCK EINER ZEILE }
PROCEDURE DRF;
VAR I, K: INTEGER;
BEGIN
FOR K := 1 TO 2 DO
BEGIN
WRITE(ESC, DZ, #128, #7); { 7*256+128 = 1920 }
FOR I := 0 TO 639 DO
WRITE(#0, CHR(IZ[I]), #0);
WRITE(CR, ESC, DZ, #128, #7);
FOR I := 0 TO 639 DO
WRITE(#0, #0, CHR(IZ[I]));
WRITE(ESC, DJ, #1, CR);
END;
WRITE(ESC, DJ, #22, CR);
END;
{-------------------------------------------------------------------}
BEGIN
REWRITE(OUTPUT, 'PRN:');
WRITELN;
FOR J := 0 TO 49 DO
BEGIN
J8 := 8*J;
FOR I := 0 TO 639 DO
BEGIN
B := 0;
FOR K := J8 TO J8+7 DO
B := B + B + GET_PIXEL(I, K);
IZ[I] := B;
END;
IF DRUCKE = SCHNELL THEN
DRS;
IF DRUCKE = FETT THEN
DRF;
END;
WRITELN;
REWRITE(OUTPUT, 'CON:');
END;
{=====================================================================}
{ DREIDIMENSIONALE DARSTELLUNG MIT DER PROJEKTIONSFORMEL:
X' = X * COS(ALFA) - Y * SIN(ALFA)
Y' = [X * SIN(ALFA) + Y * COS(ALFA)] * COS(BETA) + Z * SIN(BETA)
ALFA, BETA: DREH- UND NEIGUNGSWINKEL
DX: INTERVALL, N: MAXIMALINDEX DES FELDES F[-N..N,-N..N]
I * DX IST DIE X- UND J * DX DIE Y-KOORDINATE DES
BILDPUNKTES Z=F[I,J]
AUTO = TRUE: AUTOMATISCHE SKALIERUNG DER Z-ACHSE }
PROCEDURE DREID (ALFA, BETA, DX: REAL; N: INDEX;
VAR F: BILD; AUTO: BOOLEAN);
CONST LINKS = 0; { = 98/120 FUER QUADRATISCHES }
RECHTS = 639; { =541/519 DRUCKER-/BILDSCHIRMFORMAT }
UNTEN = 399;
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;
{-------------------------------------------------------------------}
{ ZEICHNET EINE ZEILE VON VIERECKEN AUF DEN BILDSCHIRM }
PROCEDURE VIERECK (NL, NR, DI: INTEGER);
VAR IX, IY, MIN, MAX: INTEGER;
JSA, JCC: REAL;
P: ARRAY[0..9] OF INTEGER; { KOORDINATEN DER ECKEN }
BEGIN
JSA := J * SA;
JCC := J * CC;
{ DIE ERSTEN 2 ECKEN DES ERSTEN VIERECKS WERDEN BERECHNET }
I := NL;
X := I * CA-JSA;
P[2] := ROUND(X - XMIN) + IXMIN;
Y := I * SC + JCC + F[I,J] * SB;
P[3] := ROUND(Y - YMIN) + IYMIN;
X := X + SA;
P[4] := ROUND(X - XMIN) + IXMIN;
Y := Y - CC + (F[I,J-1] - F[I,J]) * SB;
P[5] := ROUND(Y - YMIN) + IYMIN;
{ DAS FOLGENDE VIERECK ERGIBT SICH AUS 2 ECKEN DES
VORHERGEHENDEN VIERECKS UND 2 NEUBERECHNETEN ECKEN }
REPEAT
I := I + DI; IX := P[2]; P[0] := IX;
P[8] := IX; IX := 0; IY := P[3];
P[1] := IY; P[9] := IY; MIN := IY;
MAX := IY; P[6] := P[4]; IY := P[5];
P[7] := IY;
IF IY < MIN THEN
MIN := IY
ELSE IF IY > MAX THEN
MAX := IY;
X := I * CA - JSA;
P[2] := ROUND(X - XMIN) + IXMIN;
Y := I * SC + JCC + F[I,J] * SB;
IY := ROUND(Y - YMIN) + IYMIN;
P[3] := IY;
IF IY < MIN THEN
MIN := IY
ELSE IF IY > MAX THEN
MAX:=IY;
X := X + SA;
P[4] := ROUND(X - XMIN) + IXMIN;
Y := Y - CC + (F[I,J-1] - F[I,J]) * SB;
IY := ROUND(Y - YMIN) + IYMIN;
P[5] := IY;
IF IY < MIN THEN
MIN := IY
ELSE IF IY > MAX THEN
MAX:=IY;
{ DIE FLAECHE INNERHALB DES VIERECKS WIRD GELOESCHT }
FOR IY := MIN TO MAX DO
FILL_POLYGON(P, 4, IY, 1, 0, 0, 0, 0, IX, 0);
{ DIE KANTEN DES VIERECKS WERDEN GEZEICHNET }
REPEAT
LINE(P[IX], P[IX+1], P[IX+2], P[IX+3], 1, 0, 0, 0, $FFFF, 0);
IX := IX + 2;
UNTIL IX = 8;
UNTIL I = NR;
END;
{-------------------------------------------------------------------}
BEGIN
WHILE KEYPRESS DO
GET(INPUT);
{ BILDSCHIRM LOESCHEN, UMRANDUNG ZEICHNEN }
WRITE(#27, 'f', #27, 'E');
IXMIN := LINKS + 3; IXMAX := RECHTS - 3;
IYMIN := UNTEN - 3; IYMAX := OBEN + 3;
LINE(LINKS, OBEN, LINKS, UNTEN, 1, 0, 0, 0, $FFFF, 0);
LINE(LINKS, UNTEN, RECHTS, UNTEN, 1, 0, 0, 0, $FFFF, 0);
LINE(RECHTS, UNTEN, RECHTS, OBEN, 1, 0, 0, 0, $FFFF, 0);
LINE(RECHTS, OBEN, LINKS, OBEN, 1, 0, 0, 0, $FFFF, 0);
{ KONSTANTEN FUER PROJEKTIONSFORMEL BERECHNEN }
SA := ALFA * PI / 180; CA := DX * COS(SA); SA := DX * SIN(SA);
SB := BETA * PI / 180; CB := COS(SB); SB := SIN(SB);
{ AUTOSKALIERUNG: HOEHE AUF SEITENLAENGE DER BILDEBENE NORMIEREN }
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;
{ MINIMALE UND MAXIMALE X'-KOORDINATE DER PROJEKTION }
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;
{ MINIMALE UND MAXIMALE Y'-KOORDINATE DER PROJEKTION }
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;
{ NORMIERUNGSFAKTOREN FUER X- UND Y-
ACHSE BERECHNEN, KONSTANTEN NORMIEREN }
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;
{ 3-D AUSGABE AUF BILDSCHIRM }
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;
{=====================================================================}
{ DRUCKERMODUS EINSTELLEN, BILDSCHIRM AUSGEBEN }
PROCEDURE AUSWAHL;
CONST TAB = #9; ESC = #27;
VAR CH: CHAR;
BEGIN
REPEAT UNTIL KEYPRESS;
READ(CH);
DRUCKE := NICHT;
IF CH = TAB THEN DRUCKE := FETT;
IF CH = ESC THEN DRUCKE := SCHNELL;
IF DRUCKE <> NICHT THEN BILDSCHIRM;
WRITE(TAB);
END;
{=====================================================================}
{ ERZEUGUNG DER AUSGABEDATEN, HIER SIN(X)/X - FUNKTION }
PROCEDURE DATEN (VAR N: INDEX; VAR DX: REAL; VAR F: BILD);
VAR I, J: INTEGER;
X, Y: REAL;
BEGIN
MESSAGE(' BERECHNUNG DER BILDDATEN, BITTE WARTEN!');
N := 18;
DX := 0.35;
FOR I := -N TO N DO
BEGIN
X := 1.25 * DX * I;
IF X = 0 THEN
X := 1
ELSE
X := SIN(X) / X;
FOR J := -N TO N DO
BEGIN
Y := DX * J;
IF Y = 0 THEN
Y := 1
ELSE
Y := SIN(Y) / Y;
F[I,J] := X * Y;
END;
END;
END;
{=====================================================================}
BEGIN
DATEN(N, DX, F);
HIDE_MOUSE; { NUR FUER ATARI ST }
REPEAT
WRITELN(#27,'E',#27,'e'); { BILDSCHIRM LOESCHEN }
WRITELN(' DREH- UND NEIGUNGSWINKEL ALFA, BETA EINGEBEN',
' (ABBRUCH, WENN BETA = 0)');
WRITELN; WRITE(' ');
READ(ALFA, BETA);
IF BETA <> 0 THEN
BEGIN
DREID(ALFA, BETA, DX, N, F, TRUE);
AUSWAHL;
END;
UNTIL BETA = 0;
SHOW_MOUSE;
END.