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