home *** CD-ROM | disk | FTP | other *** search
/ The Fred Fish Collection 1.5 / ffcollection-1-5-1992-11.iso / ff_progs / prog_oth / m2amiga.lzh / M2AMIGA / DEMOS / QUEENS.MOD < prev    next >
Encoding:
Text File  |  1991-08-16  |  3.5 KB  |  167 lines
  1. MODULE queens;
  2.  
  3. FROM SYSTEM IMPORT
  4.  ADDRESS,LONGSET,ADR;
  5. FROM Arts IMPORT
  6.  Assert,Terminate,TermProcedure;
  7. FROM Dos IMPORT
  8.  Delay;
  9. FROM Exec IMPORT
  10.  MsgPortPtr,GetMsg;
  11. FROM Graphics IMPORT
  12.  RastPortPtr,RectFill,SetAPen,SetRGB4;
  13. FROM Intuition IMPORT
  14.  NewWindow,IDCMPFlags,IDCMPFlagSet,ScreenFlags,ScreenFlagSet,
  15.  WindowPtr,WindowFlags,WindowFlagSet,OpenWindow,CloseWindow,SetWindowTitles,
  16.  gadgHNone,Gadget,GadgetPtr,GadgetFlags,GadgetFlagSet,AddGadget,
  17.  propGadget,PropInfo,PropInfoPtr,PropInfoFlags,PropInfoFlagSet,
  18.  Image,ActivationFlags,ActivationFlagSet,IntuiMessagePtr;
  19.  
  20. CONST
  21.  WIDTH=260; HEIGHT=148;
  22.  WHITE=1; BLACK=2; GREEN=3; BLUE=0;
  23.  FW=30; FH=15; BW=8*FW; BH=8*FH;
  24.  
  25. VAR
  26.  a: ARRAY [1..8] OF BOOLEAN;
  27.  b: ARRAY [2..16] OF BOOLEAN;
  28.  c: ARRAY [-7..7] OF BOOLEAN;
  29.  upOffset, leftOffset: CARDINAL;
  30.  delay: CARDINAL;
  31.  rp: RastPortPtr;
  32.  wp: WindowPtr;
  33.  up: MsgPortPtr;
  34.  gp: GadgetPtr;
  35.  propInfo: PropInfo;
  36.  gadget: Gadget;
  37.  image: Image;
  38.  
  39. PROCEDURE CreateGadget(): GadgetPtr;
  40. BEGIN
  41.  WITH propInfo DO
  42.   flags:=PropInfoFlagSet{autoKnob,freeHoriz};
  43.   horizPot:=8092; vertPot:=0;
  44.   horizBody:=BW; vertBody:=10;
  45.  END;
  46.  WITH gadget DO
  47.   nextGadget:=NIL;
  48.   leftEdge:=(WIDTH-BW) DIV 2; topEdge:=12; width:=BW; height:=10;
  49.   flags:=GadgetFlagSet{};
  50.   activation:=ActivationFlagSet{relVerify,gadgImmediate};
  51.   gadgetType:=propGadget;
  52.   gadgetRender:=ADR(image);
  53.   selectRender:=NIL; gadgetText:=NIL; mutualExclude:=LONGSET{};
  54.   specialInfo:=ADR(propInfo);
  55.   gadgetID:=0; userData:=NIL
  56.  END;
  57.  RETURN ADR(gadget)
  58. END CreateGadget;
  59.  
  60. PROCEDURE Rect(x,y,color: CARDINAL);
  61. BEGIN
  62.  x:=(x-1)*FW; y:=y*FH;
  63.  INC(x,leftOffset);
  64.  INC(y,upOffset);
  65.  SetAPen(rp,color);
  66.  RectFill(rp,x,y,x+FW-1,y+FH-1);
  67. END Rect;
  68.  
  69. PROCEDURE PlaceQueen(c,r: CARDINAL);
  70. BEGIN
  71.  Rect(c,r,GREEN);
  72. END PlaceQueen;
  73.  
  74. PROCEDURE DrawSquare(c, r: CARDINAL);
  75. BEGIN
  76.  IF ODD(c+r) THEN
  77.   Rect(c,r,WHITE)
  78.  ELSE
  79.   Rect(c,r,BLACK)
  80.  END;
  81. END DrawSquare;
  82.  
  83. PROCEDURE CreateWindow(gp: GadgetPtr): WindowPtr;
  84. VAR
  85.  nw: NewWindow;
  86. BEGIN
  87.  WITH nw DO
  88.   leftEdge:=60; topEdge:=30; width:=WIDTH; height:=HEIGHT;
  89.   detailPen:=0; blockPen:=1;
  90.   idcmpFlags:=IDCMPFlagSet{closeWindow,gadgetUp};
  91.   flags:=WindowFlagSet{windowClose,windowDepth,windowDrag,activate};
  92.   firstGadget:=gp; checkMark:=NIL;
  93.   title:=NIL;
  94.   screen:=NIL; bitMap:=NIL; type:=ScreenFlagSet{wbenchScreen}
  95.  END;
  96.  RETURN OpenWindow(nw)
  97. END CreateWindow;
  98.  
  99. PROCEDURE ClearAndDrawBoard;
  100. VAR
  101.  i,j: INTEGER;
  102. BEGIN
  103.  FOR i:= 1 TO 8  DO a[i]:=TRUE END;
  104.  FOR i:= 2 TO 16 DO b[i]:=TRUE END;
  105.  FOR i:=-7 TO 7  DO c[i]:=TRUE END;
  106.  gp:=CreateGadget();
  107.  wp:=CreateWindow(gp);
  108.  Assert(wp#NIL,ADR("Error Opening Window"));
  109.  SetWindowTitles(wp,ADR("Eight Queens"),
  110.   ADR("Eight Queens, programmed with M2Amiga, 4-Nov-87, © AMSoft"));
  111.  up:=wp^.userPort;
  112.  upOffset:=22+(HEIGHT-BH-22) DIV 2 -FH;
  113.  leftOffset:=(WIDTH-BW) DIV 2;
  114.  rp:=wp^.rPort;
  115.  (* Draw Squares *)
  116.  FOR i:=1 TO 8 DO
  117.   FOR j:=1 TO 8 DO
  118.    DrawSquare(i,j)
  119.   END
  120.  END
  121. END ClearAndDrawBoard;
  122.  
  123. PROCEDURE TryCol(i: INTEGER);
  124. VAR
  125.  j: INTEGER;
  126.  im: IntuiMessagePtr;
  127. BEGIN
  128.  FOR j:=1 TO 8 DO
  129.   LOOP
  130.    im:=GetMsg(up);
  131.    IF im=NIL THEN
  132.     EXIT
  133.    ELSIF closeWindow IN im^.class THEN
  134.     Terminate(0)
  135.    ELSE
  136.     delay:=propInfo.horizPot DIV 256;
  137.    END;
  138.    im:=GetMsg(up)
  139.   END;
  140.   IF a[j] & b[i+j] & c[i-j] THEN
  141.    PlaceQueen(i,j);
  142.    a[j]:=FALSE; b[i+j]:=FALSE; c[i-j]:=FALSE;
  143.    IF i<8 THEN
  144.     TryCol(i+1)
  145.    ELSE
  146.     Delay(delay)
  147.    END;
  148.    a[j]:=TRUE; b[i+j]:=TRUE; c[i-j]:=TRUE;
  149.    DrawSquare(i,j)
  150.   END
  151.  END
  152. END TryCol;
  153.  
  154. PROCEDURE Cleanup;
  155. BEGIN
  156.  CloseWindow(wp)
  157. END Cleanup;
  158.  
  159. BEGIN (* main *)
  160.  ClearAndDrawBoard;
  161.  TermProcedure(Cleanup);
  162.  delay:=32;
  163.  LOOP
  164.   TryCol(1)
  165.  END
  166. END queens.
  167.