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

  :Program.   Demo
  :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
  :CopyRight. PD
  :Language.  OBERON
  :Compiler.  AMOK OBORON Compiler, V0.2 beta

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

MODULE Demo;

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

IMPORT g:   Graphics,
       I:   Intuition,
       e:   Exec,
       d:   Dos,
       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) *)
  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;

  c := 0;
  WHILE c<3 DO
    g.InitBitMap(BitMap[c],1,Width,Height);
    BitMap[c].planes[0] := g.AllocRaster(Width,Height);
    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.OldCloseScreen(screen) END;
  g.WaitBlit;
  count := 0;
  REPEAT
    IF BitMap[count].planes[0]#NIL THEN g.FreeRaster(BitMap[count].planes[0],Width,Height) END;
    INC(count);
  UNTIL count=3;

END Demo.