home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 06 / cgatr / wuerfel.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-01-08  |  4.3 KB  |  139 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      WUERFEL.PAS                       *)
  3. (*  Das Listing »Wuerfel.PAS« zeigt Ihnen, wie man        *)
  4. (*  »CGAPage« zur Programmierung einfacher Animationen    *)
  5. (*  verwenden kann.                                       *)
  6. (*  Es zeichnet einen sich drehenden Würfel in der be-    *)
  7. (*  kannten Rot-Grün-Darstellung auf dem Bildschirm.      *)
  8. (*       (c) 1991 Hanno-Ekkehard Müller & TOOLBOX         *)
  9. (* ------------------------------------------------------ *)
  10. PROGRAM Wuerfel2;
  11.  
  12. USES Crt, Graph, CGAPage;
  13.  
  14. {$IFOPT N+}
  15. TYPE
  16.   REAL = EXTENDED;
  17. {$ENDIF}
  18.  
  19. CONST
  20.   Zeile = 'DDD by HEM';
  21.   Kante : ARRAY [1..12, 1..2] OF BYTE =
  22.                ((1,2),(2,3),(3,4),(4,1),
  23.                 (5,6),(6,7),(7,8),(8,5),
  24.                 (1,5),(2,6),(3,7),(4,8));
  25.   EckeX : ARRAY [1..2, 1..8] OF REAL =
  26.                ((-1, 1, 1,-1,-1, 1, 1,-1),
  27.                 ( 0, 0, 0, 0, 0, 0, 0, 0));
  28.   EckeY : ARRAY [1..2, 1..8] OF REAL =
  29.                (( 1, 1,-1,-1, 1, 1,-1,-1),
  30.                 ( 0, 0, 0, 0, 0, 0, 0, 0));
  31.   EckeZ : ARRAY[1..2, 1..8] OF REAL =
  32.                ((-1,-1,-1,-1, 1, 1, 1, 1),
  33.                 ( 0, 0, 0, 0, 0, 0, 0, 0));
  34. VAR
  35.   gd, gm, i, j,
  36.   Achse,
  37.   Zaehler      : INTEGER;
  38.   Bild         : ARRAY [1..2] OF Pointer;
  39.   x1, y1, z1,
  40.   sind, cosd,
  41.   sina, cosa   : REAL;
  42.   px, py       : ARRAY [1..8] OF INTEGER;
  43.  
  44.   PROCEDURE CGADriverProc; EXTERNAL; {$L CGA}
  45.     { Wird für InitCGAPage benötigt }
  46.   BEGIN
  47.     gd := cga;
  48.     gm := cgac2;  { Grün, Rot & Gelb - ideal... }
  49.  
  50.     i := RegisterBGIdriver(@CGADriverProc);
  51.     InitGraph(gd, gm, '');
  52.  
  53.     InitCGAPage(1, @CGADriverProc);
  54.     UsePage(1);
  55.  
  56.     Randomize;
  57.     Zaehler := 0;
  58.  
  59.     { Winkel einer Drehung: 1.5 Grad }
  60.     sina := Sin(1.5*Pi/180);
  61.     cosa := Cos(1.5*Pi/180);
  62.     { Winkel für Rot-Grün-Drehung: 1 Grad }
  63.     sind := Sin(1*Pi/180);
  64.     cosd := Cos(1*Pi/180);
  65.  
  66.     FOR i := 1 TO 2 DO BEGIN
  67.       { Textzeile in zwei Farben }
  68.       SetColor(i);
  69.       OutTextXY(0, 0, Zeile);
  70.       GetMem(Bild[i], ImageSize(0, 0,
  71.                       TextWidth(Zeile), TextHeight(Zeile)));
  72.       GetImage(0, 0, TextWidth(Zeile),
  73.                      TextHeight(Zeile),Bild[i]^);
  74.     END;
  75.  
  76.   {$IFNDEF VER40}
  77.     SetWriteMode(XORput);
  78.   {$ENDIF}
  79.  
  80.     REPEAT
  81.       ClearPage(1);
  82.       Dec(Zaehler);
  83.       IF Zaehler < 0 THEN BEGIN
  84.         Achse   := Random(3);
  85.         Zaehler := Random(50);
  86.         IF BOOLEAN(Random(2)) THEN
  87.           sina := -sina;
  88.       END;
  89.       CASE Achse OF
  90.         { Drehung des Körpers }
  91.         0 : FOR i := 1 TO 8 DO BEGIN
  92.               x1 := EckeX[1, i] * cosa + EckeY[1, i] * sina;
  93.               y1 := EckeY[1, i] * cosa - EckeX[1, i] * sina;
  94.               EckeX[1, i] := x1;
  95.               EckeY[1, i] := y1;
  96.             END;
  97.         1 : FOR i := 1 TO 8 DO BEGIN
  98.               y1 := EckeY[1, i] * cosa + EckeZ[1, i] * sina;
  99.               z1 := EckeZ[1, i] * cosa - EckeY[1, i] * sina;
  100.               EckeY[1, i] := y1;
  101.               EckeZ[1, i] := z1;
  102.             END;
  103.         2 : FOR i := 1 TO 8 DO BEGIN
  104.               z1 := EckeZ[1, i] * cosa + EckeX[1, i] * sina;
  105.               x1 := EckeX[1, i] * cosa - EckeZ[1, i] * sina;
  106.               EckeZ[1, i] := z1;
  107.               EckeX[1, i] := x1;
  108.             END;
  109.       END;
  110.  
  111.       FOR i := 1 TO 8 DO BEGIN
  112.            { Rot-Grün-Drehung }
  113.         EckeZ[2, i] := 4 + (EckeZ[1, i] - 4) * cosd +
  114.                        EckeX[1, i] * sind;
  115.         EckeX[2, i] := EckeX[1, i] * cosd -
  116.                        (EckeZ[1, i] - 4) * sind;
  117.         EckeY[2, i] := EckeY[1, i];
  118.       END;
  119.  
  120.       FOR i := 1 TO 2 DO BEGIN
  121.         { Darstellung des Körpers }
  122.         SetColor(i);
  123.         PutImage(i*3, 0, Bild[i]^, XORput);
  124.         FOR j := 1 TO 8 DO BEGIN
  125.           px[j] := 160+Round(200*EckeX[i,j]/(EckeZ[i,j]+4));
  126.           py[j] := 100-Round(200*EckeY[i,j]/(EckeZ[i,j]+4));
  127.         END;
  128.         FOR j := 1 TO 12 DO
  129.           Line(px[Kante[j,1]],py[Kante[j,1]],
  130.                px[Kante[j,2]],py[Kante[j,2]]);
  131.       END;
  132.       ShowPage(1);
  133.     UNTIL KeyPressed;
  134.  
  135.   ReInitCGAPage;
  136.   CloseGraph;
  137. END.
  138. (* ------------------------------------------------------ *)
  139. (*                 Ende von WUERFEL.PAS                   *)