Home
JAQForum Ver 24.01
Log In or Join  
Active Topics
Local Time 03:11 15 Dec 2024 Privacy Policy
Jump to

Notice. New forum software under development. It's going to miss a few functions and look a bit ugly for a while, but I'm working on it full time now as the old forum was too unstable. Couple days, all good. If you notice any issues, please contact me.

Forum Index : Microcontroller and PC projects : CMM2: Maze Generating Program

Author Message
vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1110
Posted: 12:33am 09 Jun 2020
Copy link to clipboard 
Print this post

After more than a month of forced waiting, a shiny new Colour Maximite 2 from Circuit Gizmos finally, FINALLY arrived in the post. Thanks Circuit Gizmos! Two thumbs up!

It started fine. I briefly bricked it with the wrong firmware but now it is up to date and working marvelously.

Here is my first CMM2 program to share. I have implemented Eller's algorithm to generate mazes. I wrote the program last month for the original Colour Maximite and just finished porting and embellishing it for the CMM2.

Give it a try, let me know if you break it, bugs, whatever.
Enjoy!

' 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


Visit Vegipete's *Mite Library for cool programs.
 
TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 6120
Posted: 03:05am 09 Jun 2020
Copy link to clipboard 
Print this post

Excellent work.

My first instinct was black is the walls.
It didn't take long to realise that the walls are white.

It needs a start and end added.


I will add my joystick/mouse reader to it to make a good dexterity trainer, something that I had been planning to do.

Jim
VK7JH
MMedit   MMBasic Help
 
TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 6120
Posted: 03:40am 09 Jun 2020
Copy link to clipboard 
Print this post

Call this just before printing the maze:
  Quote  SUB setendpoints
 
LOCAL INTEGER s
 
DO
   s =
RND()*LENGTH*2 + 1
   
IF MID$(m$(s),2,1)= " " THEN EXIT DO
 
LOOP
 m$(s)=
" "+MID$(m$(s),2)
 
DO
   s =
RND()*LENGTH*2 + 1
   
IF MID$(m$(s),LEN(m$(s))-1,1)= " " THEN EXIT DO
 
LOOP
 m$(s)=
LEFT$(m$(s),LEN(m$(s))-1)+" "
 
END SUB
 



Random start and finish on each side.

Jim
Edited 2020-06-09 13:55 by TassyJim
VK7JH
MMedit   MMBasic Help
 
vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1110
Posted: 05:18am 09 Jun 2020
Copy link to clipboard 
Print this post

Good modification, but I can't get it to work, partially because the maze is printed line by line as it is generated.

Try the following instead:
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

The subroutine can be placed at the very end of the program and called just before the "print @(10,530..." line. It makes the openings left and right on screen and in the m$ array. Note there is an awesome new MID$ command!
Visit Vegipete's *Mite Library for cool programs.
 
TassyJim

Guru

Joined: 07/08/2011
Location: Australia
Posts: 6120
Posted: 02:06am 10 Jun 2020
Copy link to clipboard 
Print this post

I made a small change to prevent py = 0

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


This is my mouse track in action:

 
Jim
VK7JH
MMedit   MMBasic Help
 
vegipete

Guru

Joined: 29/01/2013
Location: Canada
Posts: 1110
Posted: 02:20am 10 Jun 2020
Copy link to clipboard 
Print this post

Cool! Nice job.

I figured out the cy = 0 problem last night. It seems to be related to floating point rounding fun.

Change the rnd() lines to
py = int(RND() * LENGTH) + 1

Visit Vegipete's *Mite Library for cool programs.
 
Print this page


To reply to this topic, you need to log in.

© JAQ Software 2024