(*---------------------------------------------------------------------------

    Kleines 3D-Demo


    An einem Sonntag Vor(!)mittag geschrieben.


    (Es ist doch etwas aus meiner 3D-Grafik-Zeit hängengeblieben)


  --- Fridtjof.


  :Program.   Cube
  :Contents.  Kleines 3D-Demo
  :Version.   V1.0, Dezember 89, Fridtjof Siebert
  :Version.   V1.1, Juni     90, Fridtjof Siebert, Now uses Array-Constants
  :Author.    Fridtjof Siebert
  :Address.   Nobileweg 67, D-7000 Suttgart 40
  :CopyRight. PD
  :Language.  OBERON
  :Compiler.  AMOK OBORON Compiler, V0.2 beta

---------------------------------------------------------------------------*)

MODULE Cube;

(* $OvflChk- $RangeChk- $StackChk- $NilChk- $ReturnChk- $CaseChk- *)

IMPORT g:   Graphics,
       I:   Intuition,
       e:   Exec,
       sys:SYSTEM;

CONST
  PointCnt = 8;
  LineCnt  = 12;
  Auge	 = 200;

TYPE
  Point  = ARRAY 3 OF LONGINT;	    (* x, y und z Koordinate      *)
  Point2D= STRUCT x,y: INTEGER;     (* Koordinaten auf Bildschirm *)
		  in:  BOOLEAN;     (* innerhalb des Schirms?     *)
		  dummy: INTEGER;   (* nur, damit size=2^3 (speed)*)
	   END;
  SPoint = ARRAY 3 OF INTEGER;
  Line	 = ARRAY 2 OF INTEGER;	    (* Start- und Endpunkt        *)
  Matrix = ARRAY 3, 3 OF LONGINT;   (* Abbildematrix (Festpunktintegers) *)

  PArray  = ARRAY PointCnt OF Point;
  SPArray = ARRAY PointCnt OF SPoint;
  LArray  = ARRAY LineCnt  OF Line;

  FourMatrices = ARRAY 4 OF Matrix;

VAR
  CurMat: Matrix;

  Points:    PArray;
  AbbPoints: ARRAY PointCnt OF Point2D; (* Abgebildete Punkte *)

  count, c2: INTEGER;		(* Zählt Abbildungen *)

  ns: I.NewScreen;
  nw: I.NewWindow;
  screen: I.ScreenPtr;
  window: I.WindowPtr;
  rp1,rp2: g.RastPortPtr;
  Width  : INTEGER;
  Height : INTEGER;
  MitteX : INTEGER;
  MitteY : INTEGER;

  BitMap: ARRAY 3 OF g.BitMap;	 (* 3-Fach gepuffert (Troublebuffering) *)
  bmsize: LONGINT;		 (* bm.bytesPerRow*bm.rows              *)
  troubleBuf: INTEGER;		 (* aktive BitMap                       *)

  AugeX: INTEGER;		 (* Augenposition                       *)
  AugeY: INTEGER;

CONST

  SPoints = SPArray( -70,-70,-70,   70,-70,-70,
		      70, 70,-70,  -70, 70,-70,
		     -70,-70, 70,   70,-70, 70,
		      70, 70, 70,  -70, 70, 70);

  Lines = LArray(0,1, 1,2, 2,3, 3,0,
		 4,5, 5,6, 6,7, 7,4,
		 0,4, 1,5, 2,6, 3,7);

  mats = FourMatrices(7FFFH,    0,    0,      (* Einheitsmatrix    *)
			  0,7FFFH,    0,
			  0,	0,7FFFH,

		      32642,	0, 2856,      (* Drehung um Y (5°) *)
			  0,7FFFH,    0,
		      -2856,	0,32642,

		      32642, 2856,    0,      (* Drehung um Z (5°) *)
		      -2856,32642,    0,
			  0,	0,7FFFH,

		      7FFFH,	0,    0,      (* Drehung um X (5°) *)
			  0,32642, 2856,
			  0,-2856,32642);


(*-------------------------------------------------------------------------*)


PROCEDURE MulVecMat(VAR E,V: Point; VAR M: Matrix);
(* E := V * M *)

VAR
  i: INTEGER;

BEGIN
  i := 0;
  REPEAT
    E[i] := ASH( M[i,0]*V[0] + M[i,1]*V[1] + M[i,2]*V[2], -15);
    INC(i);
  UNTIL i=3;
END MulVecMat;


PROCEDURE MulMat(VAR M0,M1: Matrix);
(* M0 := M0 * M1 *)

VAR
  i,j: INTEGER;
  M,N: Matrix;

BEGIN

  M := M1; N := M0; i := 0;

  REPEAT
    j := 0;
    REPEAT
      M0[i,j] := ASH( M[0,j]*N[i,0] + M[1,j]*N[i,1] + M[2,j]*N[i,2] ,-15);
      INC(j);
    UNTIL j=3;
    INC(i);
  UNTIL i=3;

END MulMat;


(*-------------------------------------------------------------------------*)


PROCEDURE Abbilden;

VAR
  c: INTEGER;
  a: Point2D;
  AbbPnt: Point;

  PROCEDURE GetAuge(c,mc: INTEGER): INTEGER;

  VAR Auge: INTEGER;

  BEGIN
    Auge := c-mc;
    IF	  Auge<-mc THEN RETURN -mc
    ELSIF Auge> mc THEN RETURN	mc
		   ELSE RETURN Auge END;
  END GetAuge;

BEGIN
  AugeX := GetAuge(screen.mouseX,MitteX);
  AugeY := GetAuge(screen.mouseY,MitteY);
  c := 0;
  WHILE c<PointCnt DO
    MulVecMat(AbbPnt,Points[c],CurMat);
    a.x := SHORT(Auge*(AbbPnt[0]-AugeX) DIV (Auge - AbbPnt[2])) + MitteX + AugeX;
    a.y := SHORT(Auge*(AbbPnt[1]-AugeY) DIV (Auge - AbbPnt[2])) + MitteY + AugeY;
    a.in := (a.x>=0) AND (a.x<Width) AND (a.y>=0) AND (a.y<Height);
    AbbPoints[c] := a;
    INC(c);
  END;
END Abbilden;


PROCEDURE Zeichnen;

VAR
  c,i: INTEGER;
  a,b: Point2D;
  rp: g.RastPortPtr;

BEGIN

  screen.viewPort.rasInfo.bitMap := sys.ADR(BitMap[troubleBuf]);
  INC(troubleBuf); IF troubleBuf=3 THEN troubleBuf := 0 END;
  rp1.bitMap := sys.ADR(BitMap[troubleBuf]);
  rp2.bitMap := sys.ADR(BitMap[troubleBuf]);
  I.MakeScreen(screen);

(* Achtung: Graphics.MrgCop() stürzt, wenn es von verschiedenen Tasks
  gleichzeitig gerufen wird. Deshalb mach ich das so: *)

  e.Forbid();
    g.MrgCop(I.ViewAddress());
  e.Permit();

  g.SetAPen(rp1,0);
  g.RectFill(rp1,0,0,Width-1,Height-1);
  g.SetAPen(rp1,1);
  g.SetAPen(rp2,1);

  c := 0;
  WHILE c<LineCnt DO
    a := AbbPoints[Lines[c,0]];
    b := AbbPoints[Lines[c,1]];
    rp := rp2;
    IF a.in AND b.in THEN rp := rp1 END;
    g.Move(rp,a.x,a.y);
    g.Draw(rp,b.x,b.y);
    INC(c);
  END;

END Zeichnen;


(*-------------------------------------------------------------------------*)


PROCEDURE OpenScreen;

VAR c: INTEGER;

BEGIN

  Width  := sys.VAL(INTEGER,sys.VAL(SET,g.gfx.normalDisplayColumns DIV 2)*{4..15});
  Height := g.gfx.normalDisplayRows;

  MitteX := Width  DIV 2;
  MitteY := Height DIV 2;

  bmsize := Width DIV 8 * Height;
  c := 0;
  WHILE c<3 DO
    g.InitBitMap(BitMap[c],1,Width,Height);
    BitMap[c].planes[0] := e.AllocMem(bmsize,LONGSET{e.chip});
    IF BitMap[c].planes[0]=NIL THEN HALT(0) END;
    INC(c);
  END;
  troubleBuf := 0;

  ns.width	 := Width;
  ns.height	 := Height;
  ns.depth	 := 1;
  ns.type	 := I.customScreen + {I.customBitMap};
  ns.customBitMap:= sys.ADR(BitMap[0]);
  screen := I.OpenScreen(ns);
  IF screen=NIL THEN HALT(0) END;

  nw.width	:= screen.width;
  nw.height	:= screen.height;
  nw.idcmpFlags := LONGSET{I.closeWindow};
  nw.flags	:= LONGSET{I.windowClose};
  nw.screen	:= screen;
  nw.type	:= I.customScreen;
  window := I.OpenWindow(nw);
  IF window=NIL THEN HALT(0) END;

  rp1 := sys.ADR(screen.rastPort);
  rp2 := window.rPort;

END OpenScreen;


(*-------------------------------------------------------------------------*)


BEGIN

  OpenScreen;

  count := 0;
  REPEAT
    c2 := 0;
    REPEAT
      Points[count,c2] := SPoints[count,c2];
      INC(c2);
    UNTIL c2=3;
    INC(count);
  UNTIL count=PointCnt;

  count := 143; c2 := 0;

  REPEAT
    INC(count);

    IF count=144 THEN count := 0;
		      CurMat := mats[0];
		      INC(c2); IF c2=4 THEN c2 := 0 END;
		 ELSE MulMat(CurMat,mats[c2]) END;
    Abbilden;
    Zeichnen;

  UNTIL e.GetMsg(window.userPort)#NIL;

CLOSE

  IF window#NIL THEN I.CloseWindow(window) END;
  IF screen#NIL THEN I.CloseScreen(screen) END;
  g.WaitBlit;
  count := 0;
  REPEAT
    IF BitMap[count].planes[0]#NIL THEN e.FreeMem(BitMap[count].planes[0],bmsize) END;
    INC(count);
  UNTIL count=3;

END Cube.