Home JAQForum Ver 20.06 Log In or Join Active Topics Local Time 00:41 06 Mar 2024 Privacy Policy Jump to Select Sites home page Forum home page Windmills Solar EV's Electronics Microcontrollers PCB Manufacture Other Stuff Site News

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: 1073
 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: 5841
 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: 5841
 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: 1073
 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: 5841
 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: 1073
 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