A-maze
Posted: Wed Jun 25, 2014 9:24 am
This is my algorithm to make labyrinth of desired difficulty inside any shape. It has one and only one solution for any two points and works very fast.
Here I chose letter "A" as a sample shape:
And this is the code:
Here I chose letter "A" as a sample shape:
And this is the code:
Code: Select all
'A-maze v1.0
'labyrinth generator
'made in "smart BASIC"
'(c)Mr.Kibernetik, 2014
maze.diffic=120
scene
maze
def scene
graphics
graphics clear 0,0,0
width=screen_width()
height=screen_height()
draw color 0,0,1
draw font size max(width,height)
t$="A"
draw text t$ at (width-text_width(t$))/2,(height-text_height(t$))/2
draw color 1,1,1
draw linecap round
end def
def maze
xsize=scene.width/diffic
ysize=scene.height/diffic
wsize=min(xsize,ysize)
width=floor(scene.width/wsize)
height=floor(scene.height/wsize)
width1=width-1
height1=height-1
xsize=scene.width/width
ysize=scene.height/height
wsize=min(xsize,ysize)
xoff=(scene.width-wsize*width1)/2
yoff=(scene.height-wsize*height1)/2
size=width*height
dim pt(width,height),crd$(size+1)
ss=screen_scale()
for x=0 to width1
for y=0 to height1
xs=xoff+x*wsize
ys=yoff+y*wsize
get pixel xs*ss,ys*ss color r,g,b
draw pixel xs*ss,ys*ss color 1,1,1
if r+g+b=0 then continue y
cnt+=1
pt(x,y)=cnt
crd$(cnt)=x&","&y
next y
next x
randomize
draw size wsize/8
graphics clear 0,0,0
for x=0 to width1
for y=0 to height1
if pt(x,y)=0 then continue y
dn=0 ! d1=0 ! d2=0 ! d3=0 ! d4=0
if (y>0 and pt(x,y-1)=0) or y=0 then
dn+=1 ! d3=1
end if
if (y<height1 and pt(x,y+1)=0) or y=height1 then
dn+=1 ! d1=1
end if
if (x>0 and pt(x-1,y)=0) or x=0 then
dn+=1 ! d2=1
end if
if (x<width1 and pt(x+1,y)=0) or x=width1 then
dn+=1 ! d4=1
end if
if dn=0 or dn=4 then continue y
if dn=3 then
crd$(pt(x,y))=""
pt(x,y)=0
cnt-=1
continue y
end if
if dn=2 then
if (d1 and d3) or (d2 and d4) then
crd$(pt(x,y))=""
pt(x,y)=0
cnt-=1
continue y
end if
goto cont
end if
if d1 or d3 then
d1=0 ! d2=1 ! d3=0 ! d4=1 ! goto cont
end if
if d2 or d4 then
d1=1 ! d2=0 ! d3=1 ! d4=0 ! goto cont
end if
cont:
if y=0 and d1 then
dn-=1 ! d1=0
end if
if y=height1 and d3 then
dn-=1 ! d3=0
end if
if x=0 and d4 then
dn-=1 ! d4=0
end if
if x=width1 and d2 then
dn-=1 ! d2=0
end if
if d1 then wall(x,y,x,y-1,pt(x,y),pt(x,y-1))
if d2 then wall(x,y,x+1,y,pt(x,y),pt(x+1,y))
if d3 then wall(x,y,x,y+1,pt(x,y),pt(x,y+1))
if d4 then wall(x,y,x-1,y,pt(x,y),pt(x-1,y))
next y
next x
loop:
x1=rnd(width-2)+1
y1=rnd(height-2)+1
n1=pt(x1,y1)
if n1=0 then loop
x2=x1 ! y2=y1
on rnd(4)+1 goto 1,2,3,4
1 y2=y1-1 ! goto 5
2 x2=x1+1 ! goto 5
3 y2=y1+1 ! goto 5
4 x2=x1-1
5 n2=pt(x2,y2)
if n2=0 then loop
if n1=n2 then loop
wall(x1,y1,x2,y2,n1,n2)
goto loop
end def
def wall(x1,y1,x2,y2,n1,n2)
px1=maze.xoff+x1*maze.wsize
py1=maze.yoff+y1*maze.wsize
px2=maze.xoff+x2*maze.wsize
py2=maze.yoff+y2*maze.wsize
draw line px1,py1 to px2,py2
if n1=n2 then return
if len(maze.crd$(n1))<=len(maze.crd$(n2)) then
ns=n1 ! nd=n2
else
ns=n2 ! nd=n1
end if
split maze.crd$(ns) to xy$,xyn with ";"
for i=0 to xyn-1
split xy$(i) to crd$ with ","
x=crd$(0) ! y=crd$(1)
maze.pt(x,y)=nd
next i
maze.crd$(nd)&=";"&maze.crd$(ns)
maze.crd$(ns)=""
cnt+=1
if cnt=maze.cnt-1 then
notes set ,,,,,,,,,"wa5"
notes play
pause notes_length()
end
end if
end def
