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

    Kleines 3D-Demo


    An einem Sonntag Vor(!)mittag geschrieben.


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


  --- Fridtjof.

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

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


DEFINITION Demo;

PROCEDURE PointsData;  (* Keine Exportierten Prozeduren!                    *)
PROCEDURE LinesData;   (* Die Auflistung in Definition zwingt den Compiler, *)
PROCEDURE Mats;        (* hierfür Labels in Objectfile zu schreiben.        *)

END Demo.

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

IMPLEMENTATION Demo;

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

IMPORT g: Graphics,
       I: Intuition,
       e: Exec,
       d: Dos,
       ol:OberonLib;

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

TYPE
  Point  = ARRAY 3 OF LONGINT;      (* x, y und z Koordinate      *)
  Point2D= RECORD x,y: INTEGER;     (* Koordinaten auf Bildschirm *)
                  in:  BOOLEAN;     (* innerhalb des Schirms?     *)
                  dummy: INTEGER;   (* nur, damit size=2^3        *)
           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;

VAR
  SPoints["Demo.PointsData"]: SPArray;  (* Diese Felder sind direkt an der Adresse *)
  Lines ["Demo.LinesData" ]: LArray;    (* der entsprechenden INLINE-Prozeduren *)
  mats["Demo.Mats"]: ARRAY 4 OF Matrix; (* Die Abbildematrizen *)
  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                       *)

  SwapTask: e.Task;              (* Task zum Bildumschalten             *)
  SwapStack: ARRAY 1000 OF CHAR; (* sein Stack (1K muß reichen)         *)
  SwapRunning: BOOLEAN;          (* läuft der Task?                     *)
  mySig: LONGINT;
  swap: BOOLEAN;                 (* TRUE während Umschalten             *)

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

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


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

  REPEAT UNTIL NOT swap OR (mySig IN e.Wait(LONGSET{mySig}));
  screen.viewPort.rasInfo.bitMap := ADR(BitMap[troubleBuf]);
  INC(troubleBuf); IF troubleBuf=3 THEN troubleBuf := 0 END;
  rp1.bitMap := ADR(BitMap[troubleBuf]);
  rp2.bitMap := ADR(BitMap[troubleBuf]);
  swap := TRUE;
  e.Signal(ADR(SwapTask),LONGSET{mySig});
  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 Swap;  (* $StackChk- *)

BEGIN
  LOOP
    IF mySig IN e.Wait(LONGSET{mySig}) THEN
      I.MakeScreen(screen);
      I.RethinkDisplay;
      swap := FALSE;
      e.Signal(ADR(ol.Me.task),LONGSET{mySig});
    END;
  END;
END Swap;  (* $StackChk= *)

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


PROCEDURE OpenScreen;

VAR c: INTEGER;

BEGIN

  Width  := INTEGER(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:= 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 := ADR(screen.rastPort);
  rp2 := window.rPort;

END OpenScreen;


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

PROCEDURE PointsData; (* $EntryExitCode- *)

BEGIN
  INLINE(-70,-70,-70,
          70,-70,-70,
          70, 70,-70,
         -70, 70,-70,
         -70,-70, 70,
          70,-70, 70,
          70, 70, 70,
         -70, 70, 70);
END PointsData;

PROCEDURE LinesData;  (* $EntryExitCode- *)

BEGIN
  INLINE(0,1,1,2,2,3,3,0,
         4,5,5,6,6,7,7,4,
         0,4,1,5,2,6,3,7);
END LinesData;


PROCEDURE Mats; (* $EntryExitCode- *)
BEGIN
  INLINE( 0,7FFFH, 0,    0,0,    0,      (* Einheitsmatrix    *)
          0,    0, 0,7FFFH,0,    0,
          0,    0, 0,    0,0,7FFFH);
  INLINE( 0,32642, 0,    0,0, 2856,      (* Drehung um Y (5°) *)
          0,    0, 0,7FFFH,0,    0,
         -1,-2856, 0,    0,0,32642);
  INLINE( 0,32642, 0, 2856,0,    0,      (* Drehung um Z (5°) *)
         -1,-2856, 0,32642,0,    0,
          0,    0, 0,    0,0,7FFFH);
  INLINE( 0,7FFFH, 0,    0,0,    0,      (* Drehung um X (5°) *)
          0,    0, 0,32642,0, 2856,
          0,    0,-1,-2856,0,32642);
END Mats;

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


BEGIN

  screen := NIL; window := NIL; swap := FALSE;
  BitMap[0].planes[0] := NIL;
  BitMap[1].planes[0] := NIL;
  BitMap[2].planes[0] := NIL;
  SwapRunning := FALSE;
  mySig := -1;

  OpenScreen;

  mySig := e.AllocSignal(-1);
  SwapTask.spLower := ADR(SwapStack);
  SwapTask.spUpper := ADR(SwapStack[996]);
  SwapTask.spReg   := SwapTask.spUpper;
  SwapTask.node.type := e.task;
  SwapTask.node.pri  := ol.Me.task.node.pri+1;

  e.AddTask(ADR(SwapTask),LONGINT(Swap),NIL);
  SwapRunning := TRUE;

  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

  d.Delay(10);

  IF SwapRunning THEN e.RemTask(ADR(SwapTask)) END;

  IF mySig>=0   THEN e.FreeSignal(mySig) END;

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

END Demo.