A-maze

Post Reply
User avatar
Mr. Kibernetik
Site Admin
Posts: 4786
Joined: Mon Nov 19, 2012 10:16 pm
My devices: iPhone, iPad, MacBook
Location: Russia
Flag: Russia

A-maze

Post by Mr. Kibernetik »

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:

Image

Image

Image

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

Henko
Posts: 814
Joined: Tue Apr 09, 2013 12:23 pm
My devices: iPhone,iPad
Windows
Location: Groningen, Netherlands
Flag: Netherlands

Re: A-maze

Post by Henko »

Really amazing! :o

User avatar
Mr. Kibernetik
Site Admin
Posts: 4786
Joined: Mon Nov 19, 2012 10:16 pm
My devices: iPhone, iPad, MacBook
Location: Russia
Flag: Russia

Re: A-maze

Post by Mr. Kibernetik »

Henko wrote:Really amazing! :o
Thank you! :)

User avatar
Dutchman
Posts: 851
Joined: Mon May 06, 2013 9:21 am
My devices: iMac, iPad Air, iPhone
Location: Netherlands
Flag: Netherlands

Re: A-maze

Post by Dutchman »

I don't see where to start :?:

User avatar
Mr. Kibernetik
Site Admin
Posts: 4786
Joined: Mon Nov 19, 2012 10:16 pm
My devices: iPhone, iPad, MacBook
Location: Russia
Flag: Russia

Re: A-maze

Post by Mr. Kibernetik »

Next version of "A-Maze" can be found here: viewtopic.php?f=20&t=603

User avatar
Mr. Kibernetik
Site Admin
Posts: 4786
Joined: Mon Nov 19, 2012 10:16 pm
My devices: iPhone, iPad, MacBook
Location: Russia
Flag: Russia

Re: A-maze

Post by Mr. Kibernetik »

Dutchman wrote:I don't see where to start :?:
You can select any point for entrance.
In next version there is an explicit entrance.

Post Reply