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