MODULE Cube;

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

         Commodore Amiga rotating solid cube demonstration module

      (c) Copyright 1986 Modula-2 Software Ltd.  All Rights Reserved
      (c) Copyright 1986 TDI Software, Inc.      All Rights Reserved

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


(* VERSION FOR COMMODORE AMIGA

     Original Author : Paul Curtis, Modula-2 Software Ltd.  23-Jan-86

     Version         : 1.01a  05-Dec-86  Martin Fisher, Modula-2 Software Ltd.
                         Compiler 3,00a library modifications.
                       1.00c  10-Jul-86  Paul Curtis, Modula-2 Software Ltd.
                         Compiler 2.20a modifications.
                       1.00b  11-Feb-86  Phil Camp, Modula-2 Software Ltd.
                         Tidied up termination.
                       1.00a  27-Jan-86  Paul Curtis, Modula-2 Software Ltd.
                         Finally gave up on idea of using SetRGB4
                         for double-buffered displays after about
                         two hours hacking. SetRGB4 works for non
                         DB displays; when using DB displays, one
                         frames colour table is changed, but the
                         other frames table isn't. Anyway, the new
                         demo uses two views and two viewports.
                         They are remade on every frame of the
                         display. Pretty impressive stuff this!
                        0.00a  23-Jan-86  Paul Curtis, TDI.
                          Original

  *)


(*$S-,$T-,$A+*)

FROM SYSTEM IMPORT ADR ;
IMPORT SYSTEM, GraphicsLibrary, Views, Areas, Colors, Copper, 
  Rasters, Pens, RandomNumbers, Libraries, MathLib0;

FROM DemoScreen IMPORT InitDemoScreen, EndDemo;

CONST
  width = 320;
  height = 200;
  depth = 2;


  MODULE Rotation;

    FROM MathLib0 IMPORT sin, cos, DegToRad;
    FROM RandomNumbers IMPORT Random;
    IMPORT x, y, z, nrVerticies;

    EXPORT YRotation, angle;

    CONST
      MaxAngle = 20;
      MaxCount = 8;

    VAR
      sinphi, cosphi: ARRAY [0..MaxAngle] OF REAL;
      phi, phidir: INTEGER;  (* how much to rotate, and in which direction *)
      angle: INTEGER;  (* current facial angle of left side *)
      maxAngle: INTEGER;
      maxCount: CARDINAL;

    PROCEDURE YRotation;
      (* rotate cube about y axis by phi degrees. *)

    VAR i: CARDINAL;
      X, Z, sphi, cphi: REAL;

    BEGIN
      (* get next rotation angle *)
      INC(maxCount);
      IF maxCount >= MaxCount THEN
        maxCount := 0;
        INC(phi,phidir);
        (* NOTE: cannot use ABS(phi) >= maxAngle. *)
        IF (phi <= -maxAngle) & (phidir < 0) OR
           (phi >=  maxAngle) & (phidir > 0) THEN
          maxAngle := Random(MaxAngle DIV 2-1)+MaxAngle DIV 2 - 1;
          phidir := -phidir;
        END;
      END;

      INC(angle,phi);
      angle := (angle+90) MOD 90;

      cphi := cosphi[ABS(phi)];
      IF phi < 0 THEN
        sphi := -sinphi[ABS(phi)];
      ELSE
        sphi := sinphi[phi];
      END;
      FOR i := 0 TO nrVerticies-1 DO
        X := x[i]; Z := z[i];
        x[i] := X*cphi - Z*sphi;
        z[i] := Z*cphi + X*sphi;
      END;
    END YRotation;

  VAR i: CARDINAL; s: REAL;

  BEGIN
    maxAngle := Random(MaxAngle DIV 2-1)+MaxAngle DIV 2 - 1;
    phi := 0; phidir := 1;
    angle := 0;
    maxCount := MaxCount;
    FOR i := 0 TO MaxAngle DO
      sinphi[i] := sin(DegToRad(FLOAT(i)));
      cosphi[i] := cos(DegToRad(FLOAT(i)));
    END;
  END Rotation;


  MODULE Initialisation;

  IMPORT width, height, depth, nrVerticies;
  IMPORT GraphicsLibrary, Rasters, Views, Areas, Colors, Libraries, Pens;

  FROM SYSTEM IMPORT BYTE, WORD, ADDRESS, ADR;
  FROM GraphicsLibrary IMPORT GraphicsName, GraphicsBase,
    InitBitMap, BltClear, PlanePtr, BitMap;

  EXPORT initOK, RP, VP, V, ColourTable, FreeMem;

  VAR
    initOK: BOOLEAN;
    areabuffer: ARRAY [0..99] OF WORD;
    V: ARRAY [0..1] OF Views.View;
    VP: ARRAY [0..1] OF Views.ViewPort;
    CM: ARRAY [0..1] OF Colors.ColorMap;
    RP: ARRAY [0..1] OF Rasters.RastPort;
    RI: ARRAY [0..1] OF Rasters.RasInfo;
    BM: ARRAY [0..1] OF BitMap;
    Depth: ARRAY [0..1] OF CARDINAL;
    ColourTable: ARRAY [0..1] OF ARRAY [0..31] OF CARDINAL;
    AI: Areas.AreaInfo;
    AP: LONGINT;
    TR: Rasters.TmpRas;
    TRplane: PlanePtr;


  PROCEDURE InitDemoView(): BOOLEAN;
  VAR i, plane, n: CARDINAL;
  BEGIN
    GraphicsBase := Libraries.OpenLibrary(GraphicsName,0);
    IF GraphicsBase = 0 THEN RETURN FALSE; END;

    FOR i := 0 TO 1 DO
      InitBitMap(BM[i],depth,width,height);
      FOR plane := 0 TO depth-1 DO
        BM[i].Planes[plane] := Rasters.AllocRaster(width,height);
        IF BM[i].Planes[plane] = 0 THEN
          Depth[i] := plane;  (* nr. planes allocated *)
          RETURN FALSE;
        END;
        (* clear bit plane *)
        BltClear(BM[i].Planes[plane],
          LONGCARD(height)*10000H+(LONGCARD(width)+7) DIV 8,{1});
      END;
      Depth[i] := depth;
    END;

    (* initialise the RasInfo structure *)
    FOR i := 0 TO 1 DO
      WITH RI[i] DO
        bitMap := ADR(BM[i]);
        rxOffset := 0;
        ryOffset := 0;
        next := Rasters.RasInfoPtr(0);
      END;
    END;

    (* initialise the RastPort structures *)
    FOR i := 0 TO 1 DO
      Rasters.InitRastPort(ADR(RP[i]));
      RP[i].bitMap := ADR(BM[i]);
    END;

    (* initialise the view *)
    FOR i := 0 TO 1 DO
      Views.InitView(ADR(V[i]));
      V[i].viewPort := ADR(VP[i]);

      (* initialise the viewport *)
      Views.InitVPort(ADR(VP[i]));
      WITH VP[i] DO
        dWidth := width;
        dHeight := height;
        rasInfo := ADR(RI[i]);
        WITH CM[i] DO
          type := BYTE(0);  (* ARRAY xRGB *)
          flags := BYTE(0);
          count := 4;
          colorTable := ADR(ColourTable[i]);
        END;
        colorMap := ADR(CM[i]);
      END;

      Views.MakeVPort(ADR(V[i]),ADR(VP[i]));
      Views.MrgCop(ADR(V[i]));
    END;

    Areas.InitArea(AI,areabuffer,SIZE(areabuffer));
    TRplane := Rasters.AllocRaster(width,height);
    IF TRplane = 0 THEN RETURN FALSE; END;

    Rasters.InitTmpRas(ADR(TR),TRplane,(width+15) DIV 16 * height);
    AP := -1;  (* all bits set *)
    FOR i := 0 TO 1 DO
      Pens.SetDrMd(ADR(RP[i]),GraphicsLibrary.Jam1);
      WITH RP[i] DO
        (* no cross fill in areafilling; not necessary, but makes fill
             run a little faster. *)
        INCL(Flags,Rasters.NoCrossFill);

        (* set area filling info *)
        areaInfo := ADR(AI);
        AreaPtrn := ADR(AP);
        AreaPtSz := BYTE(1);
        tmpRas := ADR(TR);
      END;
    END;

    RETURN TRUE;
  END InitDemoView;


  PROCEDURE FreeMem;
    (* free allocated bitmap space *)
  VAR i, plane: INTEGER;
  BEGIN
    FOR i := 0 TO 1 DO
      FOR plane := 0 TO Depth[i]-1 DO
        Rasters.FreeRaster(BM[i].Planes[plane],width,height);
      END
    END
  END FreeMem;

  BEGIN
    ColourTable[0][3] := 0FH;
    ColourTable[1][3] := 0FH;
    Depth[0] := 0;
    Depth[1] := 0;
    initOK := InitDemoView();
  END Initialisation;


  MODULE Cube;
  
  FROM SYSTEM IMPORT ADR ;
  FROM Pens IMPORT SetAPen;
  FROM Areas IMPORT AreaMove, AreaDraw, AreaEnd;
  IMPORT Copper, Views, Rasters;
  IMPORT V, VP, RP, depth, width, height, distance, ColourTable,
    YRotation, angle;

  EXPORT x, y, z, nrVerticies, Do;

  CONST
    nrVerticies = 4;

  VAR
    x, y, z: ARRAY [0..nrVerticies-1] OF REAL;
    frame: CARDINAL;
    x2D, y2D: ARRAY [0..nrVerticies-1] OF INTEGER;

  PROCEDURE DrawCube;

  CONST
    centerX = width DIV 2;
    centerY = height DIV 2;

  VAR left: INTEGER;
    i, j, k: CARDINAL;
    vertex: CARDINAL;
    rightObscured: BOOLEAN;
    err: INTEGER;

  BEGIN
    frame := 1-frame;  (* draw into non-displayed frame *)

    Rasters.SetRast(ADR(RP[frame]),0);

    (* find leftmost vertex of base plane *)
    left := x2D[0]; i := 0;
    FOR vertex := 1 TO nrVerticies-1 DO
      IF x2D[vertex] < left THEN left := x2D[vertex]; i := vertex; END;
    END;

    j := (i+1) MOD nrVerticies;
    k := (i+2) MOD nrVerticies;

    (* see if right plane is obscured by left plane *)
    rightObscured := x2D[j] >= x2D[k];

    (* draw left visible plane *)
    IF rightObscured THEN SetAPen(ADR(RP[frame]),3) ELSE SetAPen(ADR(RP[frame]),1); END;

    err := AreaMove(ADR(RP[frame]),centerX+x2D[i],centerY+y2D[i]);
    err := AreaDraw(ADR(RP[frame]),centerX+x2D[j],centerY+y2D[j]);
    err := AreaDraw(ADR(RP[frame]),centerX+x2D[j],centerY-y2D[j]);
    err := AreaDraw(ADR(RP[frame]),centerX+x2D[i],centerY-y2D[i]);
    err := AreaDraw(ADR(RP[frame]),centerX+x2D[i],centerY+y2D[i]);
    AreaEnd(ADR(RP[frame]));

    IF NOT rightObscured THEN
      (* draw right visible plane *)
      SetAPen(ADR(RP[frame]),2);
      err := AreaMove(ADR(RP[frame]),centerX+x2D[j],centerY+y2D[j]);
      err := AreaDraw(ADR(RP[frame]),centerX+x2D[k],centerY+y2D[k]);
      err := AreaDraw(ADR(RP[frame]),centerX+x2D[k],centerY-y2D[k]);
      err := AreaDraw(ADR(RP[frame]),centerX+x2D[j],centerY-y2D[j]);
      AreaEnd(ADR(RP[frame]));
    END;

    (* free all old view copper lists. *)
    Views.FreeVPortCopLists(ADR(VP[frame]));
    Copper.FreeCprList(V[frame].LOFCprList^);
    Copper.FreeCprList(V[frame].SHFCprList^);

    (* calculate new colour values *)
    ColourTable[frame][2] := angle DIV 8 + 4;
    ColourTable[frame][1] := (89-angle) DIV 8 + 4;

    (* make a new viewport *)
    V[frame].LOFCprList := Copper.cprlistptr(0);
    V[frame].SHFCprList := Copper.cprlistptr(0);

    Views.MakeVPort(ADR(V[frame]),ADR(VP[frame]));
    Views.MrgCop(ADR(V[frame]));

    (* load the new frame on flyback *)
    Views.LoadView(ADR(V[frame])) ;

    Views.WaitTOF;

  END DrawCube;


  PROCEDURE Convert2D;
    (* project 3D image onto 2D surface. *)

  VAR i: CARDINAL; f: REAL;

    PROCEDURE Transform(x, f: REAL): INTEGER;
      (* this procedure is used as TRUNC expects a positive REAL
           and returns a CARDINAL. This is not an implementation
           restriction: it is defined in the "Report on The
           Programming Language Modula-2" by N. Wirth. *)

    VAR t: REAL;

    BEGIN
      t := x*f;
      IF t < 0.0 THEN
        RETURN -INTEGER(TRUNC(ABS(t)));
      ELSE
        RETURN INTEGER(TRUNC(t));
      END;
    END Transform;

  BEGIN
    FOR i := 0 TO nrVerticies-1 DO
      f := 1000.0 / (distance - z[i]);
      x2D[i] := Transform(x[i],f);
      y2D[i] := Transform(y[i],f);
    END;
  END Convert2D;


  PROCEDURE Do(n: CARDINAL);
  VAR i: CARDINAL;
  BEGIN
    WHILE n > 0 DO
      YRotation; Convert2D; DrawCube;
      DEC(n);
    END;
  END Do;


  BEGIN
    frame := 0;
    x[0] := -150.0; y[0] :=  150.0; z[0] :=  150.0;
    x[1] :=  150.0; y[1] :=  150.0; z[1] :=  150.0;
    x[2] :=  150.0; y[2] :=  150.0; z[2] := -150.0;
    x[3] := -150.0; y[3] :=  150.0; z[3] := -150.0;
  END Cube;


VAR c: CARDINAL;
  distance, dir: REAL;

PROCEDURE NewDir(): REAL;
BEGIN
  RETURN FLOAT(RandomNumbers.Random(60)+40);
END NewDir;

VAR i: CARDINAL;

BEGIN 
  IF initOK THEN

    IF InitDemoScreen(10,10,1,Views.ModeSet{}) THEN END;

    (* just rotate on spot at first *)
    distance := 6500.0; Do(40);
    dir := NewDir();

    FOR i := 0 TO 1000 DO
      Do(1);
      distance := distance + dir;
      IF distance <= 1800.0 THEN
        dir := NewDir(); Do(RandomNumbers.Random(30)+20);
      ELSIF distance >= 6500.0 THEN
        dir := -NewDir(); Do(RandomNumbers.Random(30)+20);
      END;
    END;
    EndDemo;
    FreeMem;
  END;
END Cube.