RosettaCodeData/Task/Maze-generation/M2000-Interpreter/maze-generation-2.m2000
2025-02-27 18:35:13 -05:00

96 lines
3.2 KiB
Text

Module Maze2 {
\\ depth-first search
While Inkey$<>"" {} ' drop keys
Const View as boolean=True
Double tcc
Form 80,50
again:
Gradient 5,6
Cursor 0,0
let w=random(2,6)*10, h=random(1,4)*10, slice=w*h div 30
let slice=if(slice=0->1, slice) : counter =1
Double
\\center proportional text double size
Report 2, Format$("Maze {0}x{1}",w,h)
Normal
Hold
Refresh
Set Fast !
stack new {
Profiler
Dim maze$(1 to w+1, 1 to h+1)="#"
Include=Lambda w,h (a,b) ->a>=1 and a<=w and b>=1 and b<=h
Flush ' empty stack
if random(1,2)=1 then
entry=(if(random(1,2)=1->2, w),Random(1, h/2)*2)
else
entry=(random(1,w/2)*2,If(Random(1,2)=1->2,h))
end if
maze$(entry#val(0), entry#val(1))=" "
forchoose=(,)
Push Entry
do
do
NewForChoose(!entry)
status=len(forchoose)
if status>0 then
status--
forchoose=forchoose#val(random(0,status))
Push forchoose
OpenDoor(!Entry, !forchoose)
if view then counter=if(counter=0->slice, counter-1) : if counter=0 then ShowMaze()
else
exit
end if
entry=forchoose
Always
if empty then exit
Read entry
Always
tc= timecount/1000
}
ShowMaze()
Cursor 0,Height-1
Print Part $(6,width), ~(15,0,0),"Press a key or mouse button after any drawing of the maze to exit - "+format$("{0:3}",tc)
Refresh
counter=10
every 200 {
counter--
if inkey$<>"" or mouse<>0 then counter=-1 : exit
if counter<1 then exit
}
if counter=0 then Release : goto again
End
Sub NewForChoose(x,y)
Local x1=x-2, x2=x+2, y1=y-2, y2=y+2, arr=(,)
Stack New {
if include(x1,y) then if Maze$(x1,y)<>" " Then push (x1, y)
if include(x2,y) then if Maze$(x2,y)<>" " Then push (x2, y)
if include(x,y1) then if Maze$(x,y1)<>" " Then push (x, y1)
if include(x,y2) then if Maze$(x,y2)<>" " Then push (x, y2)
forchoose= Array([])
}
End Sub
Sub OpenDoor(x1,y1, x2,y2)
Local i
if x1=x2 then
y1+=y2<=>y1
for i=y1 to y2 step sgn(y2-y1) {maze$(x1, i)=" " }
Else
x1+=x2<=>x1
for i=x1 to x2 step sgn(x2-x1) {maze$(i, y1)=" "}
End if
End Sub
Sub ShowMaze()
Refresh 5000
Rem cls ,4 ' split screen - preserve lines form 0 to 3
Release
cursor 0,(height-h) div 2
Local i, j, t=40-w div 2
For j=1 to h+1 { Print @(t) : for i=1 to w+1 {Print maze$(i,j);}:Print}
Print
Refresh 100
End Sub
}
Maze2