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: CanadaPosts: 1110 |
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: AustraliaPosts: 6120 |
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: AustraliaPosts: 6120 |
Call this just before printing the maze: 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: CanadaPosts: 1110 |
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: AustraliaPosts: 6120 |
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: CanadaPosts: 1110 |
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 |