home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 05 / t4_grf / dreidim4.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-02-29  |  7.3 KB  |  191 lines
  1. {---------------------------------------------------------}
  2. { Programm zur dreidimensionalen Darstellung von Matrizen }
  3. {    aus PASCAL 2/87, angepaßt an Turbo Pascal 4.0        }
  4. {---------------------------------------------------------}
  5. PROGRAM DREI_DIM;
  6.                      (* Compiler/Linker in den 2 Units   *)
  7. USES Crt, Graph;     (* benötigte Routinen suchen lassen *)
  8.  
  9. CONST NN = 36;     { MAXIMAL (2*NN+1)*(2*NN+1) BILDPUNKTE }
  10.  
  11. TYPE  BILD = ARRAY[-NN..NN,-NN..NN] OF REAL;
  12.       INDEX = 1..NN;
  13.  
  14. VAR N: INDEX;                { (2*N+1)*(2*N+1) BILDPUNKTE }
  15.     DX: REAL;                { ACHSENINTERVALL            }
  16.     F: BILD;                 { BILDMATRIX                 }
  17.     ALFA, BETA: REAL;        { DREH- UND NEIGUNGSWINKEL   }
  18.            (* die für "InitGraph" notwendigen Variablen: *)
  19.     GraphDriver, GraphMode, GraphCode : INTEGER;
  20. {=========================================================}
  21. { DREIDIMENSIONALE DARSTELLUNG MIT DER PROJEKTIONSFORMEL:
  22.   X' = X*COS(ALFA)-Y*SIN(ALFA)
  23.   Y' = [X*SIN(ALFA)+Y*COS(ALFA)]*COS(BETA)+Z*SIN(BETA)
  24.   ALFA, BETA: DREH- UND NEIGUNGSWINKEL
  25.   DX: INTERVALL, N: MAXIMALINDEX DES FELDES F[-N..N,-N..N]
  26.   I * DX IST DIE X- UND J * DX DIE Y-KOORDINATE DES
  27.   BILDPUNKTES Z=F[I,J]
  28.   AUTO = TRUE: AUTOMATISCHE SKALIERUNG DER Z-ACHSE        }
  29.  
  30. PROCEDURE DREID (ALFA, BETA, DX: REAL; N: INDEX;
  31.                  VAR F: BILD; AUTO: BOOLEAN);
  32.  
  33. CONST LINKS = 0;  OBEN = 0; (* RECHST u. UNTEN siehe VAR *)
  34.  
  35. VAR I, J, IXMIN, IYMIN, IXMAX, IYMAX: INTEGER;
  36.     SA, CA, SB, CB, CC, SC,
  37.     FX, FY, XMIN, XMAX, YMIN, YMAX, X, Y: REAL;
  38.    (* um die aktuelle Auflösung nutzen zu können, werden
  39.       später initialisierte Variablen als Grenzen verw.: *)
  40.     RECHTS, UNTEN: INTEGER;
  41.   {-------------------------------------------------------}
  42.   { ZEICHNET EINE ZEILE VON VIERECKEN AUF DEN BILDSCHIRM  }
  43.   PROCEDURE VIERECK (NL, NR, DI: INTEGER);
  44.  
  45.   VAR IX, IY, MIN, MAX: INTEGER;
  46.       JSA, JCC: REAL;
  47.       P: ARRAY[0..9] OF INTEGER;  { KOORDINATEN DER ECKEN }
  48.  
  49.   BEGIN
  50.     JSA := J * SA;  JCC := J * CC;   I := NL;
  51.    { ERSTEN 2 ECKEN DES ERSTEN VIERECKS WERDEN BERECHNEN: }
  52.     X := I*CA-JSA;             P[2] := ROUND(X-XMIN)+IXMIN;
  53.     Y := I*SC+JCC+F[I,J]*SB;   P[3] := ROUND(Y-YMIN)+IYMIN;
  54.     X := X+SA;                 P[4] := ROUND(X-XMIN)+IXMIN;
  55.     Y := Y-CC+(F[I,J-1]-F[I,J])*SB;
  56.     P[5] := ROUND(Y-YMIN)+IYMIN;
  57.      { DAS FOLGENDE VIERECK ERGIBT SICH AUS 2 ECKEN DES
  58.        VORHERGEHENDEN VIERECKS UND 2 NEUBERECHNETEN ECKEN }
  59.     REPEAT
  60.       I := I+DI;  IX := P[2];  P[0] := IX;    P[8] := IX;
  61.       IX := 0;    IY := P[3];  P[1] := IY;    P[9] := IY;
  62.       MIN := IY;  MAX := IY;   P[6] := P[4];  IY := P[5];
  63.       P[7] := IY;
  64.       IF IY < MIN THEN MIN := IY
  65.       ELSE IF IY > MAX THEN MAX := IY;
  66.       X := I*CA-JSA;  P[2] := ROUND(X-XMIN)+IXMIN;
  67.       Y := I*SC+JCC+F[I,J]*SB;  IY := ROUND(Y-YMIN)+IYMIN;
  68.       P[3] := IY;
  69.       IF IY < MIN THEN MIN := IY
  70.       ELSE IF IY > MAX THEN MAX:=IY;
  71.       X := X+SA;  P[4] := ROUND(X-XMIN)+IXMIN;
  72.       Y := Y-CC+(F[I,J-1]-F[I,J])*SB;
  73.       IY := ROUND(Y-YMIN)+IYMIN;  P[5] := IY;
  74.       IF IY < MIN THEN MIN := IY
  75.       ELSE IF IY > MAX THEN MAX:=IY;
  76.       (* das Zeichnen eines Vierecks, gefüllt mit der
  77.          Hintergrundfarbe, ist mit Turbo viel einfacher: *)
  78.       SetFillStyle(SolidFill,0);  FillPoly(5,P);
  79.     UNTIL I = NR;
  80.   END;
  81.   {-------------------------------------------------------}
  82. BEGIN
  83.    (* die aktuelle Auflösung der Grafik-Karte ermitteln: *)
  84.   RECHTS := GetMaxX;   UNTEN := GetMaxY;
  85.                                     { UMRANDUNG ZEICHNEN: }
  86.   IXMIN := LINKS+3;  IXMAX := RECHTS-3;
  87.   IYMIN := UNTEN-3;  IYMAX := OBEN+3;
  88.   LINE(LINKS,OBEN,LINKS,UNTEN);
  89.   LINE(LINKS,UNTEN,RECHTS,UNTEN);
  90.   LINE(RECHTS,UNTEN,RECHTS,OBEN);
  91.   LINE(RECHTS,OBEN,LINKS,OBEN);
  92.             { KONSTANTEN FUER PROJEKTIONSFORMEL BERECHNEN }
  93.   SA := ALFA*PI/180;  CA := DX*COS(SA);  SA := DX*SIN(SA);
  94.   SB := BETA*PI/180;  CB := COS(SB);     SB := SIN(SB);
  95.                  { AUTOSKALIERUNG: HOEHE AUF SEITENLAENGE }
  96.   IF AUTO THEN BEGIN            { DER BILDEBENE NORMIEREN }
  97.     XMIN := F[0,0];     XMAX := XMIN;
  98.     FOR I:= -N TO N DO
  99.       FOR J := -N TO N DO BEGIN
  100.         X := F[I,J];
  101.         IF X < XMIN THEN XMIN := X
  102.         ELSE IF X > XMAX THEN XMAX := X;
  103.       END;
  104.       IF XMAX <> XMIN THEN
  105.         SB := 2 * N * DX *SB / (XMAX - XMIN);
  106.   END;
  107.      { MINIMALE UND MAXIMALE X'-KOORDINATE DER PROJEKTION }
  108.   FX := N*CA;  FY := N*SA;  XMIN := -FX-FY;  XMAX := XMIN;
  109.   X := FX-FY;
  110.   IF X < XMIN THEN XMIN := X;
  111.   IF X > XMAX THEN XMAX := X;
  112.   X := FY-FX;
  113.   IF X < XMIN THEN XMIN := X;
  114.   IF X > XMAX THEN XMAX := X;
  115.   X := FX+FY;
  116.   IF X < XMIN THEN XMIN := X;
  117.   IF X > XMAX THEN XMAX := X;
  118.      { MINIMALE UND MAXIMALE Y'-KOORDINATE DER PROJEKTION }
  119.   YMIN := F[0,0]*SB; YMAX := YMIN; CC := CA*CB; SC:= SA*CB;
  120.   FOR J := N DOWNTO -N DO BEGIN
  121.     FY := J * CC - N * SC;
  122.     FOR I := -N TO N DO BEGIN
  123.       Y := FY + F[I,J] * SB;    FY := FY + SC;
  124.       IF Y < YMIN THEN YMIN := Y
  125.       ELSE IF Y > YMAX THEN YMAX := Y;
  126.     END;
  127.   END;
  128.                   { NORMIERUNGSFAKTOREN FUER X- UND Y-
  129.                     ACHSE BERECHNEN, KONSTANTEN NORMIEREN }
  130.   FX := (IXMAX-IXMIN)/(XMAX-XMIN);   XMIN := XMIN * FX;
  131.   FY := (IYMAX-IYMIN)/(YMAX-YMIN);   YMIN := YMIN * FY;
  132.   SA := SA * FX;       CA := CA * FX;       CC := CC * FY;
  133.   SC := SC * FY;       SB := SB * FY;
  134.                              { 3-D AUSGABE AUF BILDSCHIRM }
  135.   IF CA > 0 THEN
  136.     FOR J := N DOWNTO -N+1 DO
  137.       IF SA > 0 THEN VIERECK(N,-N,-1) ELSE VIERECK(-N,N,1)
  138.   ELSE
  139.     FOR J := -N + 1 TO N DO
  140.       IF SA > 0 THEN VIERECK(N,-N,-1) ELSE VIERECK(-N,N,1);
  141. END;
  142. {=========================================================}
  143. { ERZEUGUNG DER AUSGABEDATEN, HIER SIN(X)/X - FUNKTION    }
  144. PROCEDURE DATEN (VAR N: INDEX; VAR DX: REAL; VAR F: BILD);
  145. VAR I, J: INTEGER;  X, Y: REAL;
  146. BEGIN
  147.   WriteLn;  WriteLn;
  148.   WriteLn(' BERECHNUNG DER BILDDATEN, BITTE WARTEN!');
  149.   N := 18;  DX := 0.35;
  150.   FOR I := -N TO N DO BEGIN
  151.     X := 1.25 * DX * I;
  152.     IF X = 0 THEN X := 1 ELSE  X := SIN(X) / X;
  153.     FOR J := -N TO N DO BEGIN
  154.       Y := DX * J;
  155.       IF Y = 0 THEN Y := 1 ELSE Y := SIN(Y) / Y;
  156.       F[I,J] := X * Y;
  157.     END;
  158.   END;
  159. END;
  160. {=========================================================}
  161. BEGIN
  162.   DATEN(N, DX, F);
  163.   (* Initialisierung der Grafik durch automatische Er-
  164.      kennung der Karte (s. Apfelmännchen):               *)
  165.   GraphDriver := Detect;
  166.   InitGraph(GraphDriver,GraphMode,'');
  167.   GraphCode := GraphResult;
  168.   IF GraphCode <> grOk THEN BEGIN
  169.     WriteLn('Grafik-Fehler Nr. ',GraphCode);
  170.     WriteLn('Programm abgebrochen...');  Halt;
  171.   END;
  172.                        (* Linienart und Farbe festlegen: *)
  173.   SetLineStyle(SolidLn,0,NormWidth);  SetColor(1);
  174.   REPEAT
  175.    (* für folgenden Dialog wieder in den Textmode gehen: *)
  176.     RestoreCrtMode;
  177.     WRITELN('DREH- UND NEIGUNGSWINKEL ALFA, BETA EINGEBEN',
  178.             ' (ABBRUCH, WENN BETA = 0)');
  179.     WRITELN; WRITE(' ');  READ(ALFA, BETA);
  180.     IF BETA <> 0 THEN BEGIN
  181.       (* den von "InitGraph" ermittelten Grafik-Modus
  182.          zum Zeichnen wieder aktivieren:                 *)
  183.       SetGraphMode(GraphMode);
  184.       DREID(ALFA, BETA, DX, N, F, TRUE);
  185.       REPEAT UNTIL KEYPRESSED;
  186.     END;
  187.   UNTIL BETA = 0;
  188.   CloseGraph;            (* ... und die Grafik beenden ! *)
  189. END.
  190.  
  191.