home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / dreidim.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1979-12-31  |  9.8 KB  |  330 lines
  1. {---------------------------------------------------------------------}
  2. {      Programm zur dreidimensionalen Darstellung von Matrizen        }
  3. {---------------------------------------------------------------------}
  4.  
  5. PROGRAM DREI_DIM;
  6.  
  7. CONST PI = 3.1415926536;
  8.       NN = 36;                 { MAXIMAL (2*NN+1)*(2*NN+1) BILDPUNKTE }
  9.  
  10. TYPE  BILD = ARRAY[-NN..NN,-NN..NN] OF REAL;
  11.      INDEX = 1..NN;
  12.  
  13. VAR N: INDEX;                            { (2*N+1)*(2*N+1) BILDPUNKTE }
  14.     DX: REAL;                            { ACHSENINTERVALL            }
  15.     F: BILD;                             { BILDMATRIX                 }
  16.     ALFA, BETA: REAL;                    { DREH- UND NEIGUNGSWINKEL   }
  17.     DRUCKE: (FETT,NICHT,SCHNELL);        { DRUCKERMODUS               }
  18.  
  19. {=====================================================================}
  20. {                 DRUCKERAUSGABE DES BILDSCHIRMS                      }
  21.  
  22. PROCEDURE BILDSCHIRM;
  23.  
  24. CONST CR = #13; ESC = #27;
  25.       DS = '*';                  { AUSWAHL DES GRAFIKMODUS:           }
  26.       D4 = #4;                   { 640 PUNKTE PRO ZEILE               }
  27.       DZ = 'Z';                  { GRAFIKMODUS: 1920 PUNKTE PRO ZEILE }
  28.       DJ = 'J';                  { PAPIERVORSCHUB IN 1/216 ZOLL       }
  29.  
  30. VAR B, I, J, K, J8: INTEGER;
  31.     IZ: ARRAY[0..639] OF BYTE;
  32.  
  33.   {-------------------------------------------------------------------}
  34.   {                     SCHNELLDRUCK EINER ZEILE                      }
  35.  
  36.   PROCEDURE DRS;
  37.  
  38.   VAR I: INTEGER;
  39.  
  40.   BEGIN
  41.     WRITE(ESC, DS, D4, #128, #2);                   { 2*256+128 = 640 }
  42.     FOR I := 0 TO 639 DO
  43.       WRITE(CHR(IZ[I]));
  44.     WRITE(ESC,DJ,#24,CR);
  45.   END;
  46.  
  47.   {-------------------------------------------------------------------}
  48.   {                      FETTDRUCK EINER ZEILE                        }
  49.  
  50.   PROCEDURE DRF;
  51.  
  52.   VAR I, K: INTEGER;
  53.  
  54.   BEGIN
  55.     FOR K := 1 TO 2 DO
  56.     BEGIN
  57.       WRITE(ESC, DZ, #128, #7);                    { 7*256+128 = 1920 }
  58.       FOR I := 0 TO 639 DO
  59.         WRITE(#0, CHR(IZ[I]), #0);
  60.       WRITE(CR, ESC, DZ, #128, #7);
  61.       FOR I := 0 TO 639 DO
  62.         WRITE(#0, #0, CHR(IZ[I]));
  63.       WRITE(ESC, DJ, #1, CR);
  64.     END;
  65.     WRITE(ESC, DJ, #22, CR);
  66.   END;
  67.  
  68.   {-------------------------------------------------------------------}
  69.  
  70. BEGIN
  71.   REWRITE(OUTPUT, 'PRN:');
  72.   WRITELN;
  73.   FOR J := 0 TO 49 DO
  74.   BEGIN
  75.     J8 := 8*J;
  76.     FOR I := 0 TO 639 DO
  77.     BEGIN
  78.       B := 0;
  79.       FOR K := J8 TO J8+7 DO
  80.         B := B + B + GET_PIXEL(I, K);
  81.       IZ[I] := B;
  82.     END;
  83.     IF DRUCKE = SCHNELL THEN
  84.       DRS;
  85.     IF DRUCKE = FETT THEN
  86.       DRF;
  87.   END;
  88.   WRITELN;
  89.   REWRITE(OUTPUT, 'CON:');
  90. END;
  91.  
  92. {=====================================================================}
  93. { DREIDIMENSIONALE DARSTELLUNG MIT DER PROJEKTIONSFORMEL:
  94.   X' = X * COS(ALFA) - Y * SIN(ALFA)
  95.   Y' = [X * SIN(ALFA) + Y * COS(ALFA)] * COS(BETA) + Z * SIN(BETA)
  96.   ALFA, BETA: DREH- UND NEIGUNGSWINKEL
  97.   DX: INTERVALL, N: MAXIMALINDEX DES FELDES F[-N..N,-N..N]
  98.   I * DX IST DIE X- UND J * DX DIE Y-KOORDINATE DES
  99.   BILDPUNKTES Z=F[I,J]
  100.   AUTO = TRUE: AUTOMATISCHE SKALIERUNG DER Z-ACHSE                    }
  101.  
  102. PROCEDURE DREID (ALFA, BETA, DX: REAL; N: INDEX;
  103.                  VAR F: BILD; AUTO: BOOLEAN);
  104.  
  105. CONST LINKS  =   0;              { = 98/120 FUER QUADRATISCHES        }
  106.       RECHTS = 639;              { =541/519 DRUCKER-/BILDSCHIRMFORMAT }
  107.       UNTEN  = 399;
  108.       OBEN   =   0;
  109.  
  110. VAR I, J, IXMIN, IYMIN, IXMAX, IYMAX: INTEGER;
  111.     SA, CA, SB, CB, CC, SC,
  112.     FX, FY, XMIN, XMAX, YMIN, YMAX, X, Y: REAL;
  113.  
  114.   {-------------------------------------------------------------------}
  115.   {      ZEICHNET EINE ZEILE VON VIERECKEN AUF DEN BILDSCHIRM         }
  116.  
  117.   PROCEDURE VIERECK (NL, NR, DI: INTEGER);
  118.  
  119.   VAR IX, IY, MIN, MAX: INTEGER;
  120.       JSA, JCC: REAL;
  121.       P: ARRAY[0..9] OF INTEGER;              { KOORDINATEN DER ECKEN }
  122.  
  123.   BEGIN
  124.     JSA := J * SA;
  125.     JCC := J * CC;
  126.             { DIE ERSTEN 2 ECKEN DES ERSTEN VIERECKS WERDEN BERECHNET }
  127.     I := NL;
  128.     X := I * CA-JSA;
  129.     P[2] := ROUND(X - XMIN) + IXMIN;
  130.     Y := I * SC + JCC + F[I,J] * SB;
  131.     P[3] := ROUND(Y - YMIN) + IYMIN;
  132.     X := X + SA;
  133.     P[4] := ROUND(X - XMIN) + IXMIN;
  134.     Y := Y - CC + (F[I,J-1] - F[I,J]) * SB;
  135.     P[5] := ROUND(Y - YMIN) + IYMIN;
  136.                  { DAS FOLGENDE VIERECK ERGIBT SICH AUS 2 ECKEN DES
  137.                    VORHERGEHENDEN VIERECKS UND 2 NEUBERECHNETEN ECKEN }
  138.     REPEAT
  139.       I := I + DI;      IX := P[2];      P[0] := IX;
  140.       P[8] := IX;       IX := 0;         IY := P[3];
  141.       P[1] := IY;       P[9] := IY;      MIN := IY;
  142.       MAX := IY;        P[6] := P[4];    IY := P[5];
  143.       P[7] := IY;
  144.       IF IY < MIN THEN
  145.         MIN := IY
  146.       ELSE IF IY > MAX THEN
  147.         MAX := IY;
  148.       X := I * CA - JSA;
  149.       P[2] := ROUND(X - XMIN) + IXMIN;
  150.       Y := I * SC + JCC + F[I,J] * SB;
  151.       IY := ROUND(Y - YMIN) + IYMIN;
  152.       P[3] := IY;
  153.       IF IY < MIN THEN
  154.         MIN := IY
  155.       ELSE IF IY > MAX THEN
  156.         MAX:=IY;
  157.       X := X + SA;
  158.       P[4] := ROUND(X - XMIN) + IXMIN;
  159.       Y := Y - CC + (F[I,J-1] - F[I,J]) * SB;
  160.       IY := ROUND(Y - YMIN) + IYMIN;
  161.       P[5] := IY;
  162.       IF IY < MIN THEN
  163.         MIN := IY
  164.       ELSE IF IY > MAX THEN
  165.         MAX:=IY;
  166.                   { DIE FLAECHE INNERHALB DES VIERECKS WIRD GELOESCHT }
  167.       FOR IY := MIN TO MAX DO
  168.         FILL_POLYGON(P, 4, IY, 1, 0, 0, 0, 0, IX, 0);
  169.                           { DIE KANTEN DES VIERECKS WERDEN GEZEICHNET }
  170.       REPEAT
  171.         LINE(P[IX], P[IX+1], P[IX+2], P[IX+3], 1, 0, 0, 0, $FFFF, 0);
  172.         IX := IX + 2;
  173.       UNTIL IX = 8;
  174.     UNTIL I = NR;
  175.   END;
  176.  
  177.   {-------------------------------------------------------------------}
  178.  
  179. BEGIN
  180.   WHILE KEYPRESS DO
  181.     GET(INPUT);
  182.                             { BILDSCHIRM LOESCHEN, UMRANDUNG ZEICHNEN }
  183.   WRITE(#27, 'f', #27, 'E');
  184.   IXMIN := LINKS + 3;                 IXMAX := RECHTS - 3;
  185.   IYMIN := UNTEN - 3;                 IYMAX := OBEN + 3;
  186.   LINE(LINKS, OBEN, LINKS, UNTEN, 1, 0, 0, 0, $FFFF, 0);
  187.   LINE(LINKS, UNTEN, RECHTS, UNTEN, 1, 0, 0, 0, $FFFF, 0);
  188.   LINE(RECHTS, UNTEN, RECHTS, OBEN, 1, 0, 0, 0, $FFFF, 0);
  189.   LINE(RECHTS, OBEN, LINKS, OBEN, 1, 0, 0, 0, $FFFF, 0);
  190.                         { KONSTANTEN FUER PROJEKTIONSFORMEL BERECHNEN }
  191.   SA := ALFA * PI / 180;  CA := DX * COS(SA);  SA := DX * SIN(SA);
  192.   SB := BETA * PI / 180;  CB := COS(SB);       SB := SIN(SB);
  193.      { AUTOSKALIERUNG: HOEHE AUF SEITENLAENGE DER BILDEBENE NORMIEREN }
  194.   IF AUTO THEN
  195.   BEGIN
  196.     XMIN := F[0,0];     XMAX := XMIN;
  197.     FOR I:= -N TO N DO
  198.       FOR J := -N TO N DO
  199.       BEGIN
  200.         X := F[I,J];
  201.         IF X < XMIN THEN
  202.           XMIN := X
  203.         ELSE IF X > XMAX THEN
  204.           XMAX:=X;
  205.       END;
  206.       IF XMAX <> XMIN THEN
  207.         SB := 2 * N * DX *SB / (XMAX - XMIN);
  208.   END;
  209.                  { MINIMALE UND MAXIMALE X'-KOORDINATE DER PROJEKTION }
  210.   FX := N * CA;        FY := N * SA;
  211.   XMIN := -FX - FY;    XMAX := XMIN;
  212.   X := FX-FY;
  213.   IF X < XMIN THEN XMIN := X;
  214.   IF X > XMAX THEN XMAX := X;
  215.   X := FY - FX;
  216.   IF X < XMIN THEN XMIN := X;
  217.   IF X > XMAX THEN XMAX := X;
  218.   X := FX + FY;
  219.   IF X < XMIN THEN XMIN := X;
  220.   IF X > XMAX THEN XMAX := X;
  221.                  { MINIMALE UND MAXIMALE Y'-KOORDINATE DER PROJEKTION }
  222.   YMIN := F[0,0] * SB;      YMAX := YMIN;
  223.   CC := CA * CB;            SC := SA * CB;
  224.   FOR J := N DOWNTO -N DO
  225.   BEGIN
  226.     FY := J * CC - N * SC;
  227.     FOR I := -N TO N DO
  228.     BEGIN
  229.       Y := FY + F[I,J] * SB;
  230.       FY := FY + SC;
  231.       IF Y < YMIN THEN
  232.         YMIN := Y
  233.       ELSE IF Y > YMAX THEN
  234.         YMAX:=Y;
  235.     END;
  236.   END;
  237.                                { NORMIERUNGSFAKTOREN FUER X- UND Y-
  238.                                 ACHSE BERECHNEN, KONSTANTEN NORMIEREN }
  239.   FX := (IXMAX - IXMIN) / (XMAX - XMIN);
  240.   XMIN := XMIN * FX;
  241.   FY := (IYMAX - IYMIN) / (YMAX - YMIN);
  242.   YMIN := YMIN * FY;
  243.   SA := SA * FX;       CA := CA * FX;       CC := CC * FY;
  244.   SC := SC * FY;       SB := SB * FY;
  245.                                          { 3-D AUSGABE AUF BILDSCHIRM }
  246.   IF CA > 0 THEN
  247.     FOR J := N DOWNTO -N+1 DO
  248.       IF SA > 0 THEN
  249.         VIERECK(N, -N, -1)
  250.       ELSE
  251.         VIERECK(-N, N, 1)
  252.   ELSE
  253.     FOR J := -N + 1 TO N DO
  254.       IF SA > 0 THEN
  255.         VIERECK(N, -N, -1)
  256.       ELSE
  257.         VIERECK( -N, N, 1);
  258. END;
  259.  
  260. {=====================================================================}
  261. {         DRUCKERMODUS EINSTELLEN, BILDSCHIRM AUSGEBEN                }
  262.  
  263. PROCEDURE AUSWAHL;
  264.  
  265. CONST TAB = #9; ESC = #27;
  266.  
  267. VAR CH: CHAR;
  268.  
  269. BEGIN
  270.   REPEAT UNTIL KEYPRESS;
  271.   READ(CH);
  272.   DRUCKE := NICHT;
  273.   IF CH = TAB THEN DRUCKE := FETT;
  274.   IF CH = ESC THEN DRUCKE := SCHNELL;
  275.   IF DRUCKE <> NICHT THEN BILDSCHIRM;
  276.   WRITE(TAB);
  277. END;
  278.  
  279. {=====================================================================}
  280. {       ERZEUGUNG DER AUSGABEDATEN, HIER SIN(X)/X - FUNKTION          }
  281.  
  282. PROCEDURE DATEN (VAR N: INDEX; VAR DX: REAL; VAR F: BILD);
  283.  
  284. VAR I, J: INTEGER;
  285.     X, Y: REAL;
  286.  
  287. BEGIN
  288.   MESSAGE(' BERECHNUNG DER BILDDATEN, BITTE WARTEN!');
  289.   N := 18;
  290.   DX := 0.35;
  291.   FOR I := -N TO N DO
  292.   BEGIN
  293.     X := 1.25 * DX * I;
  294.     IF X = 0 THEN
  295.       X := 1
  296.     ELSE
  297.       X := SIN(X) / X;
  298.     FOR J := -N TO N DO
  299.     BEGIN
  300.       Y := DX * J;
  301.       IF Y = 0 THEN
  302.         Y := 1
  303.       ELSE
  304.         Y := SIN(Y) / Y;
  305.       F[I,J] := X * Y;
  306.     END;
  307.   END;
  308. END;
  309.  
  310. {=====================================================================}
  311.  
  312. BEGIN
  313.   DATEN(N, DX, F);
  314.   HIDE_MOUSE;                                     { NUR FUER ATARI ST }
  315.   REPEAT
  316.     WRITELN(#27,'E',#27,'e');                   { BILDSCHIRM LOESCHEN }
  317.     WRITELN(' DREH- UND NEIGUNGSWINKEL ALFA, BETA EINGEBEN',
  318.             ' (ABBRUCH, WENN BETA = 0)');
  319.     WRITELN; WRITE(' ');
  320.     READ(ALFA, BETA);
  321.     IF BETA <> 0 THEN
  322.     BEGIN
  323.       DREID(ALFA, BETA, DX, N, F, TRUE);
  324.       AUSWAHL;
  325.     END;
  326.   UNTIL BETA = 0;
  327.   SHOW_MOUSE;
  328. END.
  329.  
  330.