home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 108.lha / maze2.mod < prev    next >
Encoding:
Text File  |  1986-11-20  |  7.4 KB  |  263 lines
  1. MODULE maze2;
  2.  
  3. FROM SYSTEM IMPORT
  4.  ADDRESS, LONGSET, ADR;
  5. FROM Arts IMPORT 
  6.  Terminate, TermProcedure;
  7. FROM Exec IMPORT
  8.  MsgPortPtr,WaitPort,ReplyMsg,GetMsg;
  9. FROM Graphics IMPORT
  10.  SetAPen, Move, Draw, Text, WritePixel;
  11. FROM Intuition IMPORT
  12.  NewWindow, IDCMPFlags, IDCMPFlagSet, ScreenFlags, ScreenFlagSet,
  13.  WindowPtr, WindowFlags, WindowFlagSet, OpenWindow, CloseWindow,
  14.  gadgHNone, Gadget, GadgetPtr, GadgetFlags, GadgetFlagSet, AddGadget,
  15.  propGadget, PropInfo, PropInfoPtr, PropInfoFlags, PropInfoFlagSet,
  16.  Image, ActivationFlags, ActivationFlagSet, IntuiMessagePtr;
  17.  
  18. (* $R- $V- $S- $F- *)              
  19.  
  20. CONST
  21.     xArrayMax = 120;
  22.     yArrayMax = 54;
  23.          
  24. VAR 
  25.     myWindow: WindowPtr;
  26.     myMsg: IntuiMessagePtr;
  27.     st : CHAR;
  28.     sv : ARRAY [1..xArrayMax],[1..yArrayMax] OF CARDINAL;
  29.     fx : ARRAY [1..xArrayMax * yArrayMax DIV 2] OF CARDINAL;
  30.     fy : ARRAY [1..xArrayMax * yArrayMax DIV 2] OF CARDINAL;
  31.     w  : ARRAY [1..4] OF CARDINAL;
  32.     t  : [1..4];
  33.     x, y, xc, yc, rand, flcp, pick, n, back, 
  34.     xmax, ymax, ssz, hsz, p1, p2, i, xb, xe :CARDINAL;
  35.     gp : GadgetPtr;
  36.     propInfo: PropInfo;
  37.     gadget: Gadget;
  38.     image: Image;
  39.  
  40. PROCEDURE CreateGadget(): GadgetPtr;
  41. BEGIN
  42.     WITH propInfo DO
  43.         flags:=PropInfoFlagSet{autoKnob,freeHoriz};
  44.         horizPot:= 0; vertPot:=0;
  45.         horizBody:=100; vertBody:=10;
  46.     END;
  47.     WITH gadget DO
  48.         (* nextGadget:=NIL; *)
  49.         leftEdge:=95; topEdge:=12; width:=100; height:=10;
  50.         (* flags:=GadgetFlagSet{}; *)
  51.         (* activation:=ActivationFlagSet{}; *)
  52.         gadgetType:=propGadget;
  53.         gadgetRender:=ADR(image);
  54.         (* selectRender:=NIL; gadgetText:=NIL; mutualExclude:=LONGSET{}; *)
  55.         specialInfo:=ADR(propInfo);
  56.         (* gadgetID:=0; userData:=NIL; *)
  57.     END;
  58.     RETURN ADR(gadget)
  59. END CreateGadget;
  60.  
  61. PROCEDURE CreateWindow(x,y,w,h: INTEGER; t: ADDRESS; gp:GadgetPtr): WindowPtr;
  62. VAR
  63.     nw: NewWindow;
  64. BEGIN
  65.     WITH nw DO
  66.         leftEdge:=x; topEdge:=y; width:=w; height:=h;
  67.         detailPen:=0; blockPen:=1; 
  68.         idcmpFlags:=IDCMPFlagSet{closeWindow,newSize};
  69.         flags:=WindowFlagSet{windowClose,simpleRefresh,activate,windowDepth,
  70.                              windowSizing,windowDrag};
  71.         firstGadget:=gp; checkMark:=NIL;
  72.         title:=t;
  73.      (*   screen:=NIL; bitMap:=NIL; *)
  74.         minWidth:=200; minHeight:=100; maxWidth:=w; maxHeight:=h;
  75.         type:=ScreenFlagSet{wbenchScreen}
  76.     END;
  77.     RETURN OpenWindow(nw)
  78. END CreateWindow;
  79.  
  80. PROCEDURE QSquare ( qx, qy : CARDINAL);
  81. BEGIN
  82.     IF sv[qx,qy] = 0 THEN
  83.        sv[qx,qy] := 128;
  84.        INC(flcp);
  85.        fx[flcp] := qx;
  86.        fy[flcp] := qy;
  87.     END;   
  88. END QSquare;
  89.      
  90. PROCEDURE Line (x1,y1,x2,y2,c:CARDINAL);
  91. BEGIN
  92.     SetAPen(myWindow^.rPort,c);        
  93.     Move (myWindow^.rPort,(x1-1)*hsz+10,(y1-1)*ssz+24);
  94.     Draw (myWindow^.rPort,(x2-1)*hsz+10,(y2-1)*ssz+24);
  95. END Line;
  96.           
  97. PROCEDURE Random ( min,range :CARDINAL ): CARDINAL ;
  98. CONST
  99.     m=1024; a=57; c=6999;
  100. BEGIN
  101.     rand:=(CARDINAL(a)* rand +CARDINAL(c)) MOD CARDINAL (m);
  102.     IF range > 1 THEN
  103.        RETURN ((rand DIV 10)MOD range + min);
  104.     ELSE
  105.        RETURN min;
  106.     END;    
  107. END Random;
  108.  
  109. PROCEDURE ReadMsg();
  110. BEGIN
  111.     LOOP
  112.         myMsg:=GetMsg(myWindow^.userPort);
  113.         IF myMsg=NIL THEN
  114.             EXIT
  115.         ELSIF closeWindow IN myMsg^.class THEN
  116.             Terminate(0)
  117.         ELSE
  118.             hsz:=propInfo.horizPot DIV 1024 + 5;
  119.             ssz:=(hsz * 3) DIV 5;
  120.             xmax:=CARDINAL(myWindow^.width - 40) DIV hsz;
  121.             ymax:=CARDINAL(myWindow^.height- 36) DIV ssz;    
  122.         END;
  123.         ReplyMsg(myMsg);
  124.     END;
  125. END ReadMsg; 
  126.  
  127. PROCEDURE Cleanup;
  128. BEGIN
  129.     CloseWindow(myWindow)
  130. END Cleanup;
  131.  
  132. BEGIN   
  133.     TermProcedure(Cleanup);
  134.     xmax:=120; ymax:=54; ssz:=3; hsz:=5;
  135.     gp:=CreateGadget();
  136.     myWindow:=CreateWindow(0,0,640,200,ADR("Muzz's Maze Maker"),gp);
  137.     rand:=71;
  138.     
  139.     REPEAT
  140.         SetAPen(myWindow^.rPort,1);
  141.         Move(myWindow^.rPort,5,20);
  142.         Text(myWindow^.rPort,ADR("Cell size:"),10);  
  143.  
  144.         flcp:=0;  
  145.         back:=Random(2,14);    
  146.      
  147.      (* choose a starting point randomly *)
  148.         xc := Random (xmax DIV 3 + 1,xmax DIV 3);
  149.         yc := Random (ymax DIV 3 + 1,ymax DIV 3);
  150.         sv[xc,yc] := 64;
  151.  
  152.         REPEAT
  153.          (* add all possible neighbouring squares to queue*)
  154.             IF yc > 1 THEN 
  155.                 QSquare(xc,yc - 1);
  156.             END;
  157.             IF yc < ymax THEN
  158.                 QSquare(xc,yc + 1);
  159.             END;
  160.             IF xc > 1 THEN 
  161.                 QSquare(xc - 1,yc);
  162.             END;
  163.             IF xc < xmax THEN 
  164.                 QSquare(xc + 1,yc);
  165.             END; 
  166.          
  167.          (* pick one to process from the most recent additions *)      
  168.             IF flcp > back THEN 
  169.                 pick := Random(flcp - back,back);
  170.             ELSE   
  171.                 pick := Random(1, flcp);
  172.             END;   
  173.             xc := fx[pick];
  174.             yc := fy[pick];
  175.          
  176.             n:=WritePixel (myWindow^.rPort,(xc-1)*hsz+10,(yc-1)*ssz+24);
  177.          
  178.          (* delete from queue by copying stack top to entry *)      
  179.             fx[pick] := fx[flcp];
  180.             fy[pick] := fy[flcp];
  181.             DEC(flcp);
  182.  
  183.          (* use queue to select random exit from the square *)     
  184.             FOR n := 1 TO 4 DO 
  185.                 w[n] := n
  186.             END;
  187.             n := 4; 
  188.             REPEAT 
  189.              (* search for active path *)
  190.                 x:=xc; y:=yc; p2:=0;
  191.                 pick := Random(1,n);
  192.                 t := w[pick];
  193.                 w[pick] := w[n];
  194.                 DEC(n);
  195.                 CASE t OF
  196.                  (* up *)
  197.                 1 : IF yc > 1 THEN
  198.                         x := xc;
  199.                         y := yc - 1;
  200.                         p2 := 1;
  201.                     END |
  202.                  (* left *)
  203.                 2 : IF xc > 1 THEN 
  204.                         x := xc - 1;
  205.                         y := yc;
  206.                         p2 := 2;
  207.                     END |
  208.                  (* right *)       
  209.                 3 : IF xc < xmax THEN
  210.                         x := xc + 1;
  211.                         y := yc;
  212.                         p2 := 4;
  213.                     END |
  214.                  (* down *)       
  215.                 4 : IF yc < ymax THEN
  216.                         x := xc;
  217.                         y := yc + 1;
  218.                         p2 := 8
  219.                     END 
  220.                 ELSE      
  221.                     Terminate(0)
  222.                 END;       
  223.             UNTIL ((sv[x,y] > 0) AND (sv[x,y] < 128));
  224.  
  225.          (* flag the wall that has to be deleted *)    
  226.             INC(sv[x,y],8 DIV p2);
  227.             sv[xc,yc] := p2; 
  228.         UNTIL flcp <= 0;
  229.             
  230.      (* establish maze exits *)            
  231.         xb := Random(1,xmax);
  232.         y := 1;
  233.         INC(sv[xb,y]);
  234.         xe := Random(1,xmax);
  235.  
  236.      (* draw maze *)      
  237.         FOR y := 1 TO ymax DO
  238.             FOR x := 1 TO xmax DO
  239.                 p1 := sv[x,y]; sv[x,y] := 0;
  240.                 p2 := 0;
  241.                 IF (p1 MOD 2) = 0 THEN 
  242.                     p2 := 3
  243.                 END;    
  244.                 Line(x,y,x+1,y,p2);    
  245.                 p2 := 0;
  246.                 IF (p1 MOD 4) < 2 THEN 
  247.                     p2 := 3
  248.                 END; 
  249.                 Line (x,y,x,y+1,p2);
  250.     
  251.             END;
  252.         END;
  253.         Line(xmax+1,1,xmax+1,ymax+1,3);
  254.         Line(1,ymax+1,xmax+1,ymax+1,0);
  255.         Line(1,ymax+1,xe,ymax+1,3);
  256.         Line(xe+1,ymax+1,xmax+1,ymax+1,3);
  257.  
  258.         WaitPort(myWindow^.userPort);
  259.         ReadMsg();
  260.     UNTIL myMsg^.class = IDCMPFlagSet{closeWindow};   
  261.    
  262. END maze2.
  263.