Liren Large Software Subsidy 9/09.iso/l/l076/1.ddi/MAZE.TRU

Text File | 1988-08-27 | 5.0 KB | 184 lines

!  Maze Maker.
!
!  Makes a maze (recursively) and then solves it.
!  Here's how we make a maze:
!     Start at the first square.
!
!     1.  If a neighboring square hasn't been used yet,
!         kick down the wall to that square, and call (1)
!         recursively.
!
!  Since many squares have more than 1 neighboring unused
!  square, we have to keep a record of a square's unused
!  neighbors and try each in turn.
!
!
RANDOMIZE
SET MODE "ega"
SET COLOR "green"                 !open window onto screen
BOX AREA 0,1,0,1
SET BACK "cyan"
OPEN #1: screen .1,.9,.05,.95

LET bottom = 20                   !size of maze (# squares)
LET right  = 28

ASK MODE m$
IF m$="MEDRES" then LET linewidth = .11 else LET linewidth = .058

DIM sq_used(0,0), sq_rwall(0,0), sq_bwall(0,0)
MAT sq_used = Zer(bottom,right)
MAT sq_rwall = sq_used
MAT sq_bwall = sq_used

SET COLOR "red"
SET WINDOW 0,right,bottom,0       !draw maze walls (just a grid)
BOX LINES 0,right,bottom,0
FOR i=1 to right-1
    PLOT i,0; i,bottom
NEXT i
FOR i=1 to bottom-1
    PLOT 0,i; right,i
NEXT i

DEF Randint(n) = Int(n*rnd) + 1   !random integer 1..n

LET r = 1                         !r,c = starting point
LET c = Randint(right)
SET COLOR 0                       !kick down entry into maze
PLOT c-(1-linewidth),0; c-linewidth,0

CALL Kickdown((r),(c),"")         !now recursively kick down walls

MAT sq_used = 0                   !get ready to solve maze
SET COLOR "yellow"
PLOT c-.5,r-1; c-.5,r-.5          !entry into maze
WHEN error in
     CALL Solve((r),(c))          !recursively solve maze
USE
END WHEN

!
!
!  Recursively create a maze.
!
!  r,c give our current row/column position.  d$ contains the record
!  of where we CAN go from here: for instance "ur" means that the
!  square above us, and the square to the right, are currently unused.
!
!  We worry about hitting the edge of the maze, etc.  Then we pick
!  one of the possible directions, kick down that wall, and call
!  ourselves recursively to handle that new square.
!
!  When we come back, we run through the other possible ways to go.
!  Of course, these ways may no longer be good.
!
!
SUB Kickdown(r,c,d$)

    IF r=bottom and sq_used(r,c)=0 then LET hit_bottom=hit_bottom+1

    LET sq_used(r,c) = 1
    SET COLOR "yellow"
    BOX CIRCLE c-.6,c-.4,r-.6,r-.4
    PAUSE .02

    DO
       LET d$ = ""
       IF r>1 and sq_used(r-1,c)=0 then LET d$ = d$ & "u"

       IF (r<bottom and sq_used(r+1,c)=0) or (r=bottom and hit_bottom=right) then
          LET d$ = d$ & "d"
       END IF

       IF c>1 and sq_used(r,c-1)=0 then LET d$ = d$ & "l"

       IF c<right and sq_used(r,c+1)=0 then LET d$ = d$ & "r"

       SET COLOR 0
       BOX AREA c-.6,c-.4,r-.6,r-.4

       IF d$ = "" then EXIT SUB   !can't go anywhere from here

       LET x = Randint(Len(d$))   !pick a random direction & kick down that wall
       SELECT CASE d$[x:x]
       CASE "u"
            LET sq_bwall(r-1,c) = 1
            PLOT c-linewidth,r-1; c-(1-linewidth),r-1
            LET r = r-1
       CASE "d"
            LET sq_bwall(r,c) = 1
            PLOT c-(1-linewidth),r; c-linewidth,r
            IF r <> bottom then LET r=r+1
            IF hit_bottom = right then LET hit_bottom = hit_bottom+1
       CASE "l"
            LET sq_rwall(r,c-1) = 1
            PLOT c-1,r-linewidth; c-1,r-(1-linewidth)
            LET c = c-1
       CASE "r"
            LET sq_rwall(r,c) = 1
            PLOT c,r-linewidth; c,r-(1-linewidth)
            LET c = c+1
       END SELECT
       PAUSE .03
       CALL Kickdown((r),(c),"")  !call ourselves recursively for new square
    LOOP
END SUB

!
!
!  Recursively solve a maze.
!
!  First, we remember that we've come into this square.  Then we search
!  about trying to move into any unoccupied square neighboring this one.
!  (That's the recursive call.)  If there are no unoccupied squares
!  next to us, we forget that we've come to this square, and return.
!
!  If we hit the bottom exit, we cause an error to indicate that
!  we're all done.
!
!
SUB Solve(r,c)
    LET sq_used(r,c) = 1

    IF sq_rwall(r,c)<>0 then      !try going right
       CALL Try(r,c,r,c+1)
    END IF

    IF sq_bwall(r,c)<>0 then      !try going down
       IF r = bottom then
          SET COLOR "yellow"
          PLOT c-.5,r-.5; c-.5,r
          CAUSE ERROR 1           !hurrah -- hit bottom exit!!
       END IF
       CALL Try(r,c,r+1,c)
    END IF

    IF c>1 and sq_rwall(r,c-1)<>0 then      !try going left
       CALL Try(r,c,r,c-1)
    END IF

    IF r>1 and sq_bwall(r-1,c)<>0 then      !try going up
       CALL Try(r,c,r-1,c)
    END IF

END SUB

!
!  Try
!
!  Subroutine for Solve.  Try moving into a square.  Quit if it's
!  already used.  Otherwise extend the "solving" line, and call Solve
!  for the new square.
!
SUB Try(r,c,nr,nc)
    IF sq_used(nr,nc)=1 then EXIT SUB
    SET COLOR "yellow"
    PLOT c-.5,r-.5; nc-.5,nr-.5
    CALL Solve((nr),(nc))
    SET COLOR 0
    PLOT c-.5,r-.5; nc-.5,nr-.5
END SUB

END