MODULE RectDemo;

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

            Commodore Amiga colour table 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.  22-Jan-86

     Version         : 0.01a  08-Dec-86  Martin Fisher, Modula-2 Software Ltd.
                         Compiler 3.00a library change modifications.
                       0.00c  10-Jul-86  Paul Curtis, Modula-2 Software Ltd.
                         Compiler 2.20a modifications.
                       0.00b  11-Feb-86  Phil Camp, Modula-2 Software Ltd.
                         Added screens.
                         Tidied up termination.
                       0.00a  22-Jan-86  Paul Curtis, Modula-2 Software Ltd.
                         Original in a idle five minuites.

  *)


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


FROM SYSTEM IMPORT BYTE, WORD, ADR;
FROM GraphicsLibrary IMPORT Jam1, PlanePtr;
FROM Pens IMPORT SetAPen, SetDrMd, RectFill;
FROM Rasters IMPORT RastPortPtr;
FROM RandomNumbers IMPORT Random;
FROM Views IMPORT ModeSet ;
FROM DemoScreen IMPORT InitDemoScreen, EndDemo, DemoScreen, ColourTable;

VAR AP: LONGINT;
  RP: RastPortPtr;

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


PROCEDURE Rect(x,y,w,h: CARDINAL; b: CARDINAL);

CONST
  nrRects = 7;

VAR i: CARDINAL;
  sx, sy: CARDINAL;
  lx, ly: CARDINAL;

BEGIN
  (* calculate inward steps *)
  sx := w DIV (nrRects * 2);
  sy := h DIV (nrRects * 2);

  (* calculate lower right corner *)
  lx := x+w-1;
  ly := y+h-1;

  (* draw decreacing rectangles in different colours *)
  FOR i := 0 TO nrRects-1 DO
    SetAPen(RP,b+i);
    RectFill(RP,x,y,lx,ly);
    INC(x,sx); INC(y,sy);
    DEC(lx,sx); DEC(ly,sy);
  END;
END Rect;


PROCEDURE DoDemo;

CONST
  minw = 40;  minh = 40;
  maxw = 100; maxh = 100;

VAR i: CARDINAL;
  x,y,w,h: CARDINAL;

BEGIN
  FOR i := 0 TO 999 DO

    (* dimensions of the rectangle *)
    w := Random(maxw-minw) + minw;  (* w in range minw..maxw *)
    h := Random(maxh-minh) + minh;  (* h in range minh..maxh *)

    (* upper left corner of rectangle, restricted by dimensions *)
    x := Random(width-w);
    y := Random(height-h);

    (* draw the rectangle *)
    Rect(x,y,w,h,i MOD 4 * 8 + 1);

  END
END DoDemo;

PROCEDURE InitColourTable;
CONST red = 100H; green = 10H; blue = 1H;
VAR i: CARDINAL;
BEGIN
  FOR i := 0 TO 7 DO
    ColourTable[i]    := (8+i)*red + 7*blue;
    ColourTable[i+8]  := 15*red + (8+i)*blue;
    ColourTable[i+16] := (14-i)*red + 15*blue;
    ColourTable[i+24] := 7*red + (14-i)*blue;
  END;
  ColourTable[0] := 0;  (* black for background *)
END InitColourTable;


BEGIN
  InitColourTable;
  IF InitDemoScreen(width,height,depth,ModeSet{}) THEN
    RP := ADR(DemoScreen^.RPort);
    AP := -1;  (* all 1 bits *)
    SetDrMd(RP,Jam1);
    WITH RP^ DO
      AreaPtrn := ADR(AP);
      AreaPtSz := BYTE(1);
    END;
    DoDemo;

  END;
  EndDemo;
END RectDemo.