' Random Maze Generator
' Implementation of Eller's Algorithm
' Written by Vegipete (vegipete@gmail.com)
' June 2020
'
' Eller's algorithm generates pure simply connected mazes
' of arbitrary length.
' By introducing a deliberate 'bug', mazes with loops can
' be generated.

dim integer WIDTH,LENGTH

cls

text 400,20, "Maze Maker", "CT",5,2,&HFFAF1F
text 400,70, "by vegipete, June 2020", "CT",2,1,&HFFAF1F

font 1
colour rgb(white)

'WIDTH = 100
do
 print @(10,100) "                           ";
 print @(10,100) " ";
 input "Enter width: (4-100) ", WIDTH
 if WIDTH > 4 and WIDTH < 101 then exit do
loop
'LENGTH = 100
do
 print @(10,120) "                           ";
 print @(10,120) " ";
 input "Enter length: (4-100) ", LENGTH
 if LENGTH > 4 and LENGTH < 101 then exit do
loop

' Horizontal/Vertical bias: .5 = even, lower = more horizontal
'BIAS = 0.5
print @(10,140) "The maze can be biased horizontally or vertically. 50=even bias, lower=more horizontal.";
do
 print @(10,160) "                           ";
 print @(10,160) " ";
 input "Enter bias: (1-99) ", BIAS
 if BIAS > 0 and BIAS < 100 then exit do
loop
BIAS = BIAS / 100

' Allow loops. 0 = NO loops, 1 = loops permited
print @(10,180) "Loops can be allowed in the maze, although not guaranteed."
LOOPS = 0
do
 print @(10,200) "                           ";
 print @(10,200) " ";
 input "Allow loops: (y/n) "; loopyn$
 if loopyn$="Y" or loopyn$="y" or loopyn$="N" or loopyn$="n" then exit do
loop
if loopyn$="Y" or loopyn$="y" then LOOPS = 1

Cls
colour rgb(white), rgb(black)
Print : Print

Dim m$(2*LENGTH+1) length 2*WIDTH+1

Dim w(WIDTH)
Dim p(WIDTH)
Dim cnt(WIDTH)

DoSameAgain:

m$(1) = "#"
m$(2) = "#"
For i = 1 To WIDTH
 m$(1) = m$(1) + "##"
 m$(2) = m$(2) + " #"
Next i
m$(3) = m$(1)
For i = 4 To LENGTH*2 Step 2
 m$(i) = m$(2)
 m$(i+1) = m$(3)
Next i

show_m  'display initial all wall maze

row = 2

For i = 1 To WIDTH : w(i) = i : Next i

Do
 ' do horizontal cell joining
 For i = 1 To WIDTH : p(i) = 0 : Next i

 ' Uncomment the following for an interesting variable bias effect
 'BIAS = row / LENGTH / 2

 For i = 2 To WIDTH
   If Rnd(1) > BIAS Then
     If w(i) <> w(i-1) Then
       ' change set
       If LOOPS Then
         w(i) = w(i-1)
       Else
         rc = w(i)
         For j = 1 To WIDTH
           If w(j) = rc Then w(j) = w(i-1)
         Next j
       EndIf

       ' update maze
       lp$ = Left$(m$(row),2*(i-1))
       rp$ = Right$(m$(row),2*WIDTH-2*(i-1))
       m$(row) = lp$ + " " + rp$
     EndIf
   EndIf
 Next i

 show_mline(row)

 ' reorder set ids and count
 For i = 1 To WIDTH : cnt(i) = 0 : w(i) = w(i) + WIDTH : Next i
 rc = 1
 For i = 1 To WIDTH
   If w(i) > WIDTH Then
     sn = w(i)
     w(i) = rc
     For j = i To WIDTH
       If w(j) = sn Then w(j) = rc
     Next j
     rc = rc + 1
   EndIf
   cnt(w(i)) = cnt(w(i)) + 1
 Next i

 row = row + 1

 ' do vertical cell joining
 For i = 1 To WIDTH : p(i) = 0 : Next i

 For i = 1 To WIDTH
   dd = 0
   If cnt(w(i)) = 1 Then
     ' set with single element MUST open downward
     p(i) = w(i)
     dd = 1
   ElseIf cnt(w(i)) > 1 Then
     ' set with multi elements randomly opens downward
     If Rnd(1) < BIAS Then
       p(i) = w(i)
       dd = 1
     Else
       ' each set MUST have at least one downward opening
       cnt(w(i)) = cnt(w(i)) - 1
     EndIf
   EndIf
   If dd Then
     ' update maze - make vertical passages
     lp$ = Left$(m$(row),2*i-1)
     rp$ = Right$(m$(row),2*(WIDTH-i)+1)
     m$(row) = lp$ + " " + rp$
   EndIf
 Next i

 show_mline(row)

 row = row + 1

 ' build new row from downward passages
 For i = 1 To WIDTH : w(i) = p(i) : Next i

 ' fill in new sets
 rc = WIDTH
 For i = 1 To WIDTH
   If w(i) = 0 Then
     w(i) = rc
     rc = rc - 1
   EndIf
 Next i

Loop While row < 2*LENGTH

' do final horizontal joining
For i = 2 To WIDTH
 If w(i) <> 0 Then
   If w(i) <> w(i-1) Then
     ' change set
     For j = i + 1 To WIDTH
       If w(j) = w(i) Then w(j) = 0
     Next j
     w(i) = w(i-1)
     ' update maze
     lp$ = Left$(m$(row),2*(i-1))
     rp$ = Right$(m$(row),2*WIDTH-2*(i-1))
     m$(row) = lp$ + " " + rp$
   EndIf
 EndIf
Next i

show_mline(row)

print @(10,530) "Width:" WIDTH "  Length:" LENGTH "  Bias:" BIAS "  Loops allowed: ";
if LOOPS then print "Yes" else print "No"

do
 print @(10,545) "                           ";
 print @(10,545) " ";
 input "Same again: (y/n) "; loopyn$
 if loopyn$="Y" or loopyn$="y" or loopyn$="N" or loopyn$="n" then exit do
loop
if loopyn$="Y" or loopyn$="y" then goto DoSameAgain

End

' Print the whole maze
Sub show_m
 Local y

 For y = 1 To LENGTH*2+1
   show_mline(y)
 Next y
End Sub

' Print just a particular line of the maze
Sub show_mline(y)
 Local integer x,cx,cy,px,py

 cx = MM.HRes/(WIDTH*3)
 cy = MM.VRes/(LENGTH*2.8)
 py = y * cy + 0
 
 For x = 1 To WIDTH*2+1
   px = x * cx + 20
   If Mid$(m$(y),x,1) = " " Then
     box px,py,cx,cy,1,rgb(black),rgb(black)
   Else
     box px,py,cx,cy,1,rgb(white),rgb(white)
   EndIf
 Next x
End Sub

SUB SetEndpoints
 Local integer cx,cy,px,py
 
 cx = MM.HRes/(WIDTH*3)
 cy = MM.VRes/(LENGTH*2.8)

 ' Door on right side
 px = (WIDTH * 2 + 1) * cx + 20
 py = RND() * LENGTH
 py = py * 2
 mid$(m$(py),len(m$(py))) = " "
 py = py * cy
 box px,py,cx,cy,1,rgb(black),rgb(black)
 
 ' Door on left side
 px = cx + 20
 py = rnd() * LENGTH
 py = py * 2
 mid$(m$(py),1) = " "
 py = py * cy
 box px,py,cx,cy,1,rgb(black),rgb(black)
   
END SUB

SUB setendpoints
 Local integer cx,cy,px,py
 cx = MM.HRes/(WIDTH*3)
 cy = MM.VRes/(LENGTH*2.8)
 
 ' Door on right side
 px = (WIDTH * 2 + 1) * cx + 20
 py = RND() * (LENGTH-1) + 1
 py = py * 2
 mid$(m$(py),len(m$(py))) = " "
 py = py * cy
 box px,py,cx,cy,1,rgb(black),rgb(black)
 
 ' Door on left side
 px = cx + 20
 py = RND() * (LENGTH-1) + 1
 py = py * 2
 mid$(m$(py),1) = " "
 py = py * cy
 box px,py,cx,cy,1,rgb(black),rgb(black)
 
END SUB

py = int(RND() * LENGTH) + 1