MODULE Queens;

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

            Commodore Amiga queen problem 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 : Ch. Jacobi, Don Able, ETH.

     Version         : 0.01a  05-Dec-86  Martin Fisher, Modula-2 Software Ltd.
                         Compiler 3.00a library change modifications
                       0.00d  14-Jul-86  Paul Curtis, Modula-2 Software Ltd.
                         Demo may be stopped by Control-c.
                       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.
                         Modified for screens.
                         Tidied up termination.
                       0.00a  16-Jan-86  Paul Curtis, Modula-2 Software Ltd.
                         Spruced up and ported to Amiga.

  *)


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


FROM SYSTEM IMPORT BYTE, WORD, ADR;
FROM GraphicsLibrary IMPORT DrawingModeSet, DrawingModes;
FROM Pens IMPORT SetAPen, SetBPen, SetDrMd, RectFill;
FROM Rasters IMPORT RastPort, RastPortPtr;
FROM Views IMPORT ModeSet ;
FROM DemoScreen IMPORT InitDemoScreen, EndDemo, ColourTable, DemoScreen;

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

CONST
  black  = 0;
  white  = 1;
  dkgrey = 2;
  red    = 3;
  ltgrey = 4;

CONST
  FW = 23;
  BW = 8*FW+2;

VAR
  i, j: INTEGER;
  upOffset, leftOffset: CARDINAL;
  fill: LONGINT;

  RP: RastPortPtr;

  PROCEDURE Delay;
  VAR x: CARDINAL;
  BEGIN
    FOR x := 0 TO 50000 DO END;
  END Delay;

  PROCEDURE Shade(x,y,w,h: CARDINAL; colour: CARDINAL);
    (* shade a square of width w and height h at x,y *)
  BEGIN
    INC(x,leftOffset); INC(y,upOffset);
    RP^.AreaPtrn := ADR(fill);
    RP^.AreaPtSz := BYTE(1);
    SetAPen(RP,colour);
    RectFill(RP,x,y,x+w-1,y+h-1);
  END Shade;

  PROCEDURE DrawQueen(c, r: CARDINAL);
  VAR x,y: CARDINAL;
  BEGIN
    DEC(c); DEC(r);
    x := c*FW+2+leftOffset;
    y := r*FW+2+upOffset;
    RP^.AreaPtrn := ADR(fill);
    RP^.AreaPtSz := BYTE(1);
    SetAPen(RP,red);
    RectFill(RP,x,y,x+FW-3,y+FW-3);
  END DrawQueen;

  PROCEDURE DrawBorder(c, r: CARDINAL);
  BEGIN
    SetAPen(RP,3);
    DEC(c); DEC(r);
    IF ODD(c+r) THEN Shade(c*FW+2, r*FW+2, FW-2, FW-2, white)
    ELSE Shade(c*FW+2, r*FW+2, FW-2, FW-2, dkgrey)
    END;
  END DrawBorder;

  VAR a: ARRAY [1..8] OF BOOLEAN;
    b: ARRAY [2..16] OF BOOLEAN;
    c: ARRAY [-7..7] OF BOOLEAN;

  PROCEDURE Try(i: INTEGER);
  VAR j: INTEGER;
  BEGIN
    FOR j := 1 TO 8 DO
      IF a[j] & b[i+j] & c[i-j] THEN
        DrawQueen(i, j);
        a[j] := FALSE; b[i+j] := FALSE; c[i-j] := FALSE;
        IF i<8 THEN Try(i+1)
        ELSE Delay
        END;
        a[j] := TRUE; b[i+j] := TRUE; c[i-j] := TRUE;
        DrawBorder(i, j)
      END
    END
  END Try;

BEGIN
  ColourTable[black] := 0;
  ColourTable[white] := 0FFFH;
  ColourTable[dkgrey] := 0777H;
  ColourTable[red] := 0F00H;
  ColourTable[ltgrey] := 0CCCH;

  fill := -1;  (* 32 bits all set to 1 *)

  IF InitDemoScreen(width,height,depth,ModeSet{}) THEN

    RP := ADR(DemoScreen^.RPort) ;

    leftOffset := (width-BW) DIV 2;
    upOffset   := (height-BW) DIV 2;

    SetBPen(RP,0);
    SetDrMd(RP,DrawingModeSet{Jam2});
    FOR i :=  1 TO 8  DO a[i] := TRUE END;
    FOR i :=  2 TO 16 DO b[i] := TRUE END;
    FOR i := -7 TO 7  DO c[i] := TRUE END;

    (* draw board *)
    i := 0;
    REPEAT
      Shade(i, 0, 2, BW, ltgrey);
      INC(i,FW);
    UNTIL i > BW;
    j := 0; (* horizontal lines *)
    REPEAT
      Shade(0, j, BW, 2, ltgrey);
      INC(j,FW);
    UNTIL j > BW;
    FOR i := 1 TO 8 DO
      FOR j := 1 TO 8 DO
        DrawBorder(i, j)
      END;
    END;

    Try(1);

  END;
  EndDemo;
END Queens.