home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D2.DMS / in.adf / Demos / Amok.mod < prev    next >
Encoding:
Text File  |  1992-11-02  |  7.5 KB  |  334 lines
  1. (*---------------------------------------------------------------------------
  2.  
  3.     Kleines 3D-Demo
  4.  
  5.  
  6.     An einem Sonntag Vor(!)mittag geschrieben.
  7.  
  8.  
  9.     (Es ist doch etwas aus meiner 3D-Grafik-Zeit hängengeblieben)
  10.  
  11.  
  12.   --- Fridtjof.
  13.  
  14.  
  15.   :Program.   Amok
  16.   :Contents.  Kleines 3D-Demo
  17.   :Version.   V1.0, Dezember 89, Fridtjof Siebert
  18.   :Version.   V1.1, Juni     90, Fridtjof Siebert, Now uses Array-Constants
  19.   :Author.    Fridtjof Siebert
  20.   :Address.   Nobileweg 67, D-7000 Suttgart 40
  21.   :CopyRight. PD
  22.   :Language.  OBERON
  23.   :Compiler.  AMOK OBORON Compiler, V0.2 beta
  24.  
  25. ---------------------------------------------------------------------------*)
  26.  
  27. MODULE Amok;
  28.  
  29. (* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)
  30.  
  31.  
  32. IMPORT g   := Graphics,
  33.        I   := Intuition,
  34.        e   := Exec,
  35.        d   := Dos,
  36.        sys := SYSTEM;
  37.  
  38. CONST
  39.   PointCnt = 19;
  40.   LineCnt  = 14;
  41.   Auge   = 200;
  42.  
  43. TYPE
  44.   Point  = ARRAY 3 OF LONGINT;      (* x, y und z Koordinate      *)
  45.   Point2D= STRUCT x,y: INTEGER;     (* Koordinaten auf Bildschirm *)
  46.                   in:  BOOLEAN;     (* innerhalb des Schirms?     *)
  47.                   dummy: INTEGER;   (* nur, damit size=2^3 (speed)*)
  48.            END;
  49.   SPoint = ARRAY 3 OF INTEGER;
  50.   Line   = ARRAY 2 OF INTEGER;      (* Start- und Endpunkt        *)
  51.   Matrix = ARRAY 3, 3 OF LONGINT;   (* Abbildematrix (Festpunktintegers) *)
  52.  
  53.   PArray  = ARRAY PointCnt OF Point;
  54.   SPArray = ARRAY PointCnt OF SPoint;
  55.   LArray  = ARRAY LineCnt  OF Line;
  56.  
  57.   FourMatrices = ARRAY 4 OF Matrix;
  58.  
  59. VAR
  60.   CurMat: Matrix;
  61.  
  62.   Points:    PArray;
  63.   AbbPoints: ARRAY PointCnt OF Point2D; (* Abgebildete Punkte *)
  64.  
  65.   count, c2: INTEGER;           (* Zählt Abbildungen *)
  66.  
  67.   ns: I.NewScreen;
  68.   nw: I.NewWindow;
  69.   screen: I.ScreenPtr;
  70.   window: I.WindowPtr;
  71.   rp1,rp2: g.RastPortPtr;
  72.   Width  : INTEGER;
  73.   Height : INTEGER;
  74.   MitteX : INTEGER;
  75.   MitteY : INTEGER;
  76.  
  77.   BitMap: ARRAY 3 OF g.BitMap;   (* 3-Fach gepuffert (Troublebuffering) *)
  78.   troubleBuf: INTEGER;           (* aktive BitMap                       *)
  79.  
  80.   AugeX: INTEGER;                (* Augenposition                       *)
  81.   AugeY: INTEGER;
  82.  
  83. CONST
  84.  
  85.   SPoints = SPArray( -140,  40, 40, - 90,- 40, 40,
  86.                      - 90,  40, 40, -120,  10, 40,
  87.                      - 90,  10, 40, - 70,  40, 40,
  88.                      - 70,- 40, 40, - 40,   0, 40,
  89.                      - 10,- 40, 40, - 10,  40, 40,
  90.                        10,  40, 40,   50,  40, 40,
  91.                        50,- 40, 40,   10,- 40, 40,
  92.                        70,- 40, 40,   70,  40, 40,
  93.                       120,- 40, 40,   90,  10, 40,
  94.                       120,  40, 40);
  95.  
  96.   Lines = LArray( 0, 1, 1, 2,
  97.                   3, 4, 5, 6,
  98.                   6, 7, 7, 8,
  99.                   8, 9, 10,11,
  100.                  11,12, 12,13,
  101.                  13,10, 14,15,
  102.                  15,16, 17,18);
  103.  
  104.   mats = FourMatrices(7FFFH,    0,    0,      (* Einheitsmatrix    *)
  105.                           0,7FFFH,    0,
  106.                           0,    0,7FFFH,
  107.  
  108.                       32642,    0, 2856,      (* Drehung um Y (5°) *)
  109.                           0,7FFFH,    0,
  110.                       -2856,    0,32642,
  111.  
  112.                       32642, 2856,    0,      (* Drehung um Z (5°) *)
  113.                       -2856,32642,    0,
  114.                           0,    0,7FFFH,
  115.  
  116.                       7FFFH,    0,    0,      (* Drehung um X (5°) *)
  117.                           0,32642, 2856,
  118.                           0,-2856,32642);
  119.  
  120.  
  121. (*-------------------------------------------------------------------------*)
  122.  
  123.  
  124. PROCEDURE MulVecMat(VAR E,V: Point; VAR M: Matrix);
  125. (* E := V * M *)
  126.  
  127. VAR
  128.   i: INTEGER;
  129.  
  130. BEGIN
  131.   i := 0;
  132.   REPEAT
  133.     E[i] := ASH( M[i,0]*V[0] + M[i,1]*V[1] + M[i,2]*V[2], -15);
  134.     INC(i);
  135.   UNTIL i=3;
  136. END MulVecMat;
  137.  
  138.  
  139.  
  140. PROCEDURE MulMat(VAR M0,M1: Matrix);
  141. (* M0 := M0 * M1 *)
  142.  
  143. VAR
  144.   i,j: INTEGER;
  145.   M,N: Matrix;
  146.  
  147. BEGIN
  148.  
  149.   M := M1; N := M0; i := 0;
  150.  
  151.   REPEAT
  152.     j := 0;
  153.     REPEAT
  154.       M0[i,j] := ASH( M[0,j]*N[i,0] + M[1,j]*N[i,1] + M[2,j]*N[i,2] ,-15);
  155.       INC(j);
  156.     UNTIL j=3;
  157.     INC(i);
  158.   UNTIL i=3;
  159.  
  160. END MulMat;
  161.  
  162.  
  163. (*-------------------------------------------------------------------------*)
  164.  
  165.  
  166.  
  167. PROCEDURE Abbilden;
  168.  
  169. VAR
  170.   c: INTEGER;
  171.   a: Point2D;
  172.   AbbPnt: Point;
  173.  
  174.   PROCEDURE GetAuge(c,mc: INTEGER): INTEGER;
  175.  
  176.   VAR Auge: INTEGER;
  177.  
  178.   BEGIN
  179.     Auge := c-mc;
  180.     IF    Auge<-mc THEN RETURN -mc
  181.     ELSIF Auge> mc THEN RETURN  mc
  182.                    ELSE RETURN Auge END;
  183.   END GetAuge;
  184.  
  185. BEGIN
  186.   AugeX := GetAuge(screen.mouseX,MitteX);
  187.   AugeY := GetAuge(screen.mouseY,MitteY);
  188.   c := 0;
  189.   WHILE c<PointCnt DO
  190.     MulVecMat(AbbPnt,Points[c],CurMat);
  191.     a.x := SHORT(Auge*(AbbPnt[0]-AugeX) DIV (Auge - AbbPnt[2])) + MitteX + AugeX;
  192.     a.y := SHORT(Auge*(AbbPnt[1]-AugeY) DIV (Auge - AbbPnt[2])) + MitteY + AugeY;
  193.     a.in := (a.x>=0) AND (a.x<Width) AND (a.y>=0) AND (a.y<Height);
  194.     AbbPoints[c] := a;
  195.     INC(c);
  196.   END;
  197. END Abbilden;
  198.  
  199.  
  200. PROCEDURE Zeichnen;
  201.  
  202. VAR
  203.   c,i: INTEGER;
  204.   a,b: Point2D;
  205.   rp: g.RastPortPtr;
  206.  
  207. BEGIN
  208.  
  209.   screen.viewPort.rasInfo.bitMap := sys.ADR(BitMap[troubleBuf]);
  210.   INC(troubleBuf); IF troubleBuf=3 THEN troubleBuf := 0 END;
  211.   rp1.bitMap := sys.ADR(BitMap[troubleBuf]);
  212.   rp2.bitMap := sys.ADR(BitMap[troubleBuf]);
  213.   I.MakeScreen(screen);
  214.  
  215. (* Achtung: Graphics.MrgCop() stürzt, wenn es von verschiedenen Tasks
  216.   gleichzeitig gerufen wird. Deshalb mach ich das so: *)
  217.  
  218.   e.Forbid();
  219.     g.MrgCop(I.ViewAddress());
  220.   e.Permit();
  221.  
  222.   g.SetAPen(rp1,0);
  223.   g.RectFill(rp1,0,0,Width-1,Height-1);
  224.   g.SetAPen(rp1,1);
  225.   g.SetAPen(rp2,1);
  226.  
  227.   c := 0;
  228.   WHILE c<LineCnt DO
  229.     a := AbbPoints[Lines[c,0]];
  230.     b := AbbPoints[Lines[c,1]];
  231.     rp := rp2;
  232.     IF a.in AND b.in THEN rp := rp1 END;
  233.     g.Move(rp,a.x,a.y);
  234.     g.Draw(rp,b.x,b.y);
  235.     INC(c);
  236.   END;
  237.  
  238. END Zeichnen;
  239.  
  240.  
  241. (*-------------------------------------------------------------------------*)
  242.  
  243.  
  244. PROCEDURE OpenScreen;
  245.  
  246. VAR c: INTEGER;
  247.  
  248. BEGIN
  249.  
  250.   Width  := sys.VAL(INTEGER,sys.VAL(SET,g.gfx.normalDisplayColumns DIV 2)*{4..15});
  251.   Height := g.gfx.normalDisplayRows;
  252.  
  253.   MitteX := Width  DIV 2;
  254.   MitteY := Height DIV 2;
  255.  
  256.   c := 0;
  257.   WHILE c<3 DO
  258.     g.InitBitMap(BitMap[c],1,Width,Height);
  259.     BitMap[c].planes[0] := g.AllocRaster(Width,Height);
  260.     IF BitMap[c].planes[0]=NIL THEN HALT(0) END;
  261.     INC(c);
  262.   END;
  263.   troubleBuf := 0;
  264.  
  265.   ns.width       := Width;
  266.   ns.height      := Height;
  267.   ns.depth       := 1;
  268.   ns.type        := I.customScreen + {I.customBitMap};
  269.   ns.customBitMap:= sys.ADR(BitMap[0]);
  270.   screen := I.OpenScreen(ns);
  271.   IF screen=NIL THEN HALT(0) END;
  272.  
  273.   nw.width      := screen.width;
  274.   nw.height     := screen.height;
  275.   nw.idcmpFlags := LONGSET{I.closeWindow};
  276.   nw.flags      := LONGSET{I.windowClose};
  277.   nw.screen     := screen;
  278.   nw.type       := I.customScreen;
  279.   window := I.OpenWindow(nw);
  280.   IF window=NIL THEN HALT(0) END;
  281.  
  282.   rp1 := sys.ADR(screen.rastPort);
  283.   rp2 := window.rPort;
  284.  
  285. END OpenScreen;
  286.  
  287.  
  288. (*-------------------------------------------------------------------------*)
  289.  
  290.  
  291. BEGIN
  292.  
  293.   OpenScreen;
  294.  
  295.   count := 0;
  296.   REPEAT
  297.     c2 := 0;
  298.     REPEAT
  299.       Points[count,c2] := SPoints[count,c2];
  300.       INC(c2);
  301.     UNTIL c2=3;
  302.     INC(count);
  303.   UNTIL count=PointCnt;
  304.  
  305.   count := 143; c2 := 0;
  306.  
  307.   REPEAT
  308.     INC(count);
  309.  
  310.     IF count=144 THEN count := 0;
  311.                       CurMat := mats[0];
  312.                       INC(c2); IF c2=4 THEN c2 := 0 END;
  313.                  ELSE MulMat(CurMat,mats[c2]) END;
  314.     Abbilden;
  315.     Zeichnen;
  316.  
  317.   UNTIL e.GetMsg(window.userPort)#NIL;
  318.  
  319. CLOSE
  320.  
  321.   IF window#NIL THEN I.CloseWindow(window) END;
  322.   IF screen#NIL THEN I.OldCloseScreen(screen) END;
  323.   g.WaitBlit;
  324.   count := 0;
  325.   REPEAT
  326.     IF BitMap[count].planes[0]#NIL THEN g.FreeRaster(BitMap[count].planes[0],Width,Height) END;
  327.     INC(count);
  328.   UNTIL count=3;
  329.  
  330. END Amok.
  331.  
  332.  
  333.  
  334.