home *** CD-ROM | disk | FTP | other *** search
/ Fish 'n' More 2 / fishmore-publicdomainlibraryvol.ii1991xetec.iso / fish / languages / oberon / demos / amok.mod < prev    next >
Text File  |  1990-10-11  |  7KB  |  330 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. IMPORT g:   Graphics,
  32.        I:   Intuition,
  33.        e:   Exec,
  34.        sys:SYSTEM;
  35.  
  36. CONST
  37.   PointCnt = 19;
  38.   LineCnt  = 14;
  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( -140,  40, 40, - 90,- 40, 40,
  85.              - 90,  40, 40, -120,  10, 40,
  86.              - 90,  10, 40, - 70,  40, 40,
  87.              - 70,- 40, 40, - 40,   0, 40,
  88.              - 10,- 40, 40, - 10,  40, 40,
  89.                10,  40, 40,   50,  40, 40,
  90.                50,- 40, 40,   10,- 40, 40,
  91.                70,- 40, 40,   70,  40, 40,
  92.               120,- 40, 40,   90,  10, 40,
  93.               120,  40, 40);
  94.  
  95.   Lines = LArray( 0, 1, 1, 2,
  96.           3, 4, 5, 6,
  97.           6, 7, 7, 8,
  98.           8, 9, 10,11,
  99.          11,12, 12,13,
  100.          13,10, 14,15,
  101.          15,16, 17,18);
  102.  
  103.   mats = FourMatrices(7FFFH,    0,    0,      (* Einheitsmatrix    *)
  104.               0,7FFFH,    0,
  105.               0,    0,7FFFH,
  106.  
  107.               32642,    0, 2856,      (* Drehung um Y (5°) *)
  108.               0,7FFFH,    0,
  109.               -2856,    0,32642,
  110.  
  111.               32642, 2856,    0,      (* Drehung um Z (5°) *)
  112.               -2856,32642,    0,
  113.               0,    0,7FFFH,
  114.  
  115.               7FFFH,    0,    0,      (* Drehung um X (5°) *)
  116.               0,32642, 2856,
  117.               0,-2856,32642);
  118.  
  119.  
  120. (*-------------------------------------------------------------------------*)
  121.  
  122.  
  123. PROCEDURE MulVecMat(VAR E,V: Point; VAR M: Matrix);
  124. (* E := V * M *)
  125.  
  126. VAR
  127.   i: INTEGER;
  128.  
  129. BEGIN
  130.   i := 0;
  131.   REPEAT
  132.     E[i] := ASH( M[i,0]*V[0] + M[i,1]*V[1] + M[i,2]*V[2], -15);
  133.     INC(i);
  134.   UNTIL i=3;
  135. END MulVecMat;
  136.  
  137.  
  138. PROCEDURE MulMat(VAR M0,M1: Matrix);
  139. (* M0 := M0 * M1 *)
  140.  
  141. VAR
  142.   i,j: INTEGER;
  143.   M,N: Matrix;
  144.  
  145. BEGIN
  146.  
  147.   M := M1; N := M0; i := 0;
  148.  
  149.   REPEAT
  150.     j := 0;
  151.     REPEAT
  152.       M0[i,j] := ASH( M[0,j]*N[i,0] + M[1,j]*N[i,1] + M[2,j]*N[i,2] ,-15);
  153.       INC(j);
  154.     UNTIL j=3;
  155.     INC(i);
  156.   UNTIL i=3;
  157.  
  158. END MulMat;
  159.  
  160.  
  161. (*-------------------------------------------------------------------------*)
  162.  
  163.  
  164. PROCEDURE Abbilden;
  165.  
  166. VAR
  167.   c: INTEGER;
  168.   a: Point2D;
  169.   AbbPnt: Point;
  170.  
  171.   PROCEDURE GetAuge(c,mc: INTEGER): INTEGER;
  172.  
  173.   VAR Auge: INTEGER;
  174.  
  175.   BEGIN
  176.     Auge := c-mc;
  177.     IF      Auge<-mc THEN RETURN -mc
  178.     ELSIF Auge> mc THEN RETURN    mc
  179.            ELSE RETURN Auge END;
  180.   END GetAuge;
  181.  
  182. BEGIN
  183.   AugeX := GetAuge(screen.mouseX,MitteX);
  184.   AugeY := GetAuge(screen.mouseY,MitteY);
  185.   c := 0;
  186.   WHILE c<PointCnt DO
  187.     MulVecMat(AbbPnt,Points[c],CurMat);
  188.     a.x := SHORT(Auge*(AbbPnt[0]-AugeX) DIV (Auge - AbbPnt[2])) + MitteX + AugeX;
  189.     a.y := SHORT(Auge*(AbbPnt[1]-AugeY) DIV (Auge - AbbPnt[2])) + MitteY + AugeY;
  190.     a.in := (a.x>=0) AND (a.x<Width) AND (a.y>=0) AND (a.y<Height);
  191.     AbbPoints[c] := a;
  192.     INC(c);
  193.   END;
  194. END Abbilden;
  195.  
  196.  
  197. PROCEDURE Zeichnen;
  198.  
  199. VAR
  200.   c,i: INTEGER;
  201.   a,b: Point2D;
  202.   rp: g.RastPortPtr;
  203.  
  204. BEGIN
  205.  
  206.   screen.viewPort.rasInfo.bitMap := sys.ADR(BitMap[troubleBuf]);
  207.   INC(troubleBuf); IF troubleBuf=3 THEN troubleBuf := 0 END;
  208.   rp1.bitMap := sys.ADR(BitMap[troubleBuf]);
  209.   rp2.bitMap := sys.ADR(BitMap[troubleBuf]);
  210.   I.MakeScreen(screen);
  211.  
  212. (* Achtung: Graphics.MrgCop() stürzt, wenn es von verschiedenen Tasks
  213.   gleichzeitig gerufen wird. Deshalb mach ich das so: *)
  214.  
  215.   e.Forbid();
  216.     g.MrgCop(I.ViewAddress());
  217.   e.Permit();
  218.  
  219.   g.SetAPen(rp1,0);
  220.   g.RectFill(rp1,0,0,Width-1,Height-1);
  221.   g.SetAPen(rp1,1);
  222.   g.SetAPen(rp2,1);
  223.  
  224.   c := 0;
  225.   WHILE c<LineCnt DO
  226.     a := AbbPoints[Lines[c,0]];
  227.     b := AbbPoints[Lines[c,1]];
  228.     rp := rp2;
  229.     IF a.in AND b.in THEN rp := rp1 END;
  230.     g.Move(rp,a.x,a.y);
  231.     g.Draw(rp,b.x,b.y);
  232.     INC(c);
  233.   END;
  234.  
  235. END Zeichnen;
  236.  
  237.  
  238. (*-------------------------------------------------------------------------*)
  239.  
  240.  
  241. PROCEDURE OpenScreen;
  242.  
  243. VAR c: INTEGER;
  244.  
  245. BEGIN
  246.  
  247.   Width  := sys.VAL(INTEGER,sys.VAL(SET,g.gfx.normalDisplayColumns DIV 2)*{4..15});
  248.   Height := g.gfx.normalDisplayRows;
  249.  
  250.   MitteX := Width  DIV 2;
  251.   MitteY := Height DIV 2;
  252.  
  253.   bmsize := Width DIV 8 * Height;
  254.   c := 0;
  255.   WHILE c<3 DO
  256.     g.InitBitMap(BitMap[c],1,Width,Height);
  257.     BitMap[c].planes[0] := e.AllocMem(bmsize,LONGSET{e.chip});
  258.     IF BitMap[c].planes[0]=NIL THEN HALT(0) END;
  259.     INC(c);
  260.   END;
  261.   troubleBuf := 0;
  262.  
  263.   ns.width     := Width;
  264.   ns.height     := Height;
  265.   ns.depth     := 1;
  266.   ns.type     := I.customScreen + {I.customBitMap};
  267.   ns.customBitMap:= sys.ADR(BitMap[0]);
  268.   screen := I.OpenScreen(ns);
  269.   IF screen=NIL THEN HALT(0) END;
  270.  
  271.   nw.width    := screen.width;
  272.   nw.height    := screen.height;
  273.   nw.idcmpFlags := LONGSET{I.closeWindow};
  274.   nw.flags    := LONGSET{I.windowClose};
  275.   nw.screen    := screen;
  276.   nw.type    := I.customScreen;
  277.   window := I.OpenWindow(nw);
  278.   IF window=NIL THEN HALT(0) END;
  279.  
  280.   rp1 := sys.ADR(screen.rastPort);
  281.   rp2 := window.rPort;
  282.  
  283. END OpenScreen;
  284.  
  285.  
  286. (*-------------------------------------------------------------------------*)
  287.  
  288.  
  289. BEGIN
  290.  
  291.   OpenScreen;
  292.  
  293.   count := 0;
  294.   REPEAT
  295.     c2 := 0;
  296.     REPEAT
  297.       Points[count,c2] := SPoints[count,c2];
  298.       INC(c2);
  299.     UNTIL c2=3;
  300.     INC(count);
  301.   UNTIL count=PointCnt;
  302.  
  303.   count := 143; c2 := 0;
  304.  
  305.   REPEAT
  306.     INC(count);
  307.  
  308.     IF count=144 THEN count := 0;
  309.               CurMat := mats[0];
  310.               INC(c2); IF c2=4 THEN c2 := 0 END;
  311.          ELSE MulMat(CurMat,mats[c2]) END;
  312.     Abbilden;
  313.     Zeichnen;
  314.  
  315.   UNTIL e.GetMsg(window.userPort)#NIL;
  316.  
  317. CLOSE
  318.  
  319.   IF window#NIL THEN I.CloseWindow(window) END;
  320.   IF screen#NIL THEN I.CloseScreen(screen) END;
  321.   g.WaitBlit;
  322.   count := 0;
  323.   REPEAT
  324.     IF BitMap[count].planes[0]#NIL THEN e.FreeMem(BitMap[count].planes[0],bmsize) END;
  325.     INC(count);
  326.   UNTIL count=3;
  327.  
  328. END Amok.
  329.  
  330.