Sorry your browser is not supported!

set display mode 1280, 1024, 32
`Declare some types
type mazeCell
   N
   S
   E
   W
endtype
`define a coord
type Coord
   x as integer
   y as integer
endtype

`How many cells do we want?
#constant M_WIDTH 16
#constant M_HEIGHT 16

`What is the size of the "alley"
global MAP_SCALE#
MAP_SCALE# = 24.0

`Create a maze array of cells
dim Maze(M_WIDTH, M_HEIGHT) as mazeCell

`Generate the maze
GenerateMaze()


paste image 1, 0, 0
wait key
end





`*******************************
`**                           **
`**      MAZE GENERATION      **
`**                           **
`*******************************
function GenerateMaze()
   `Create a maze full of walls (like a grid
   for i = 1 to M_WIDTH
      for j = 1 to M_HEIGHT
         Maze(i,j).N = 1
         Maze(i,j).S = 1
         Maze(i,j).E = 1
         Maze(i,j).W = 1
      next j
   next i

   `Create a stack of walls to be knocked down to create a path
   dim CellStack() as Coord : empty array CellStack() : array index to stack CellStack()
   TotalCells = M_WIDTH * M_HEIGHT
   `Visited cells = 1 as we're about to pick our starting cell
   VisitedCells = 1
   currentCell as Coord
   currentCell.x = rnd(M_WIDTH-2)+1
   currentCell.y = rnd(M_HEIGHT-2)+1
   Dim Available(4)

   `Loop over every single cell until we've visited them all
   while VisitedCells < TotalCells
      `Clear available walls
      Available(0) = 0
      Available(1) = 0
      Available(2) = 0
      Available(3) = 0


      ` 0 = S
      ` 1 = N
      ` 2 = W
      ` 3 = E
      `Count how many walls are available and work out which ones are availble.
      `A cell in question IS available if it has all 4 walls in tact... This stops a cell becoming 2-sided...
      found = 0
      if currentCell.y > 1
         tX = currentCell.x
         tY = currentCell.y-1
         if Maze(tx,ty).N = 1 AND Maze(tx,ty).S = 1 AND Maze(tx,ty).E = 1 AND Maze(tx,ty).W = 1
            inc found
            Available(0) = 1
         endif
      endif
      if currentCell.y < M_HEIGHT
         tX = currentCell.x
         tY = currentCell.y+1
         if Maze(tx,ty).N = 1 AND Maze(tx,ty).S = 1 AND Maze(tx,ty).E = 1 AND Maze(tx,ty).W = 1
            inc found
            Available(1) = 1
         endif
      endif
      if currentCell.x > 1
         tX = currentCell.x-1
         tY = currentCell.y
         if Maze(tx,ty).N = 1 AND Maze(tx,ty).S = 1 AND Maze(tx,ty).E = 1 AND Maze(tx,ty).W = 1
            inc found
            Available(2) = 1
         endif
      endif
      if currentCell.x < M_WIDTH
         tX = currentCell.x+1
         tY = currentCell.y
         if Maze(tx,ty).N = 1 AND Maze(tx,ty).S = 1 AND Maze(tx,ty).E = 1 AND Maze(tx,ty).W = 1
            inc found
            Available(3) = 1
         endif
      endif

      `if we foudn a wall to knock down, pick on...
      if found > 0
         `Pick a random wall - if its not available (worked out above) then pick another
         choice = rnd(3)
         while Available(choice) = 0
            choice = rnd(3)
         endwhile

         `Depending on selection, knock down that wall and att the current cell to the stack for backtrackign purposes
         select choice
            `North
            case 0
               Maze(currentCell.x, currentCell.y).N = 0
               Maze(currentCell.x, currentCell.y-1).S = 0
               add to stack CellStack()
               CellStack() = currentCell
               dec currentCell.y
            endcase

            `South
            case 1
               Maze(currentCell.x, currentCell.y).S = 0
               Maze(currentCell.x, currentCell.y+1).N = 0
               add to stack CellStack()
               CellStack() = currentCell
               inc currentCell.y
            endcase

            `West
            case 2
               Maze(currentCell.x, currentCell.y).W = 0
               Maze(currentCell.x-1, currentCell.y).E = 0
               add to stack CellStack()
               CellStack() = currentCell
               dec currentCell.x
            endcase

            `East
            case 3
               Maze(currentCell.x, currentCell.y).E = 0
               Maze(currentCell.x+1, currentCell.y).W = 0
               add to stack CellStack()
               CellStack() = currentCell
               inc currentCell.x
            endcase
         endselect
         `We just visited a new cell!!
         inc VisitedCells
      else
         `In this case, there is nowhere to go - so lets set the current cell to the last one...
         currentCell = CellStack()
         remove from stack CellStack()
      endif
   endwhile

   `Create a 2D Map image
   cls

   IMGX# = M_WIDTH  * MAP_SCALE#
   IMGY# = M_HEIGHT * MAP_SCALE#

   SCALEX# = (IMGX#-1) / M_WIDTH
   SCALEY# = (IMGY#-1) / M_HEIGHT

   for i = 1 to M_WIDTH
      for j = 1 to M_HEIGHT
         x1 = (i-1) *  SCALEX#
         x2 =  i    *  SCALEX#
         y1 = (j-1) * -SCALEY# + (M_HEIGHT * MAP_SCALE#)
         y2 =  j    * -SCALEY# + (M_HEIGHT * MAP_SCALE#)

         if Maze(i,j).N = 1 then line x1, y1, x2, y1
         if Maze(i,j).S = 1 then line x1, y2, x2, y2
         if Maze(i,j).E = 1 then line x2, y1, x2, y2
         if Maze(i,j).W = 1 then line x1, y1, x1, y2
      next j
   next i

   get image 1, 0, 1, IMGX#, IMGY#+1, 1
endfunction

sync on
set display mode 800,600,32
randomize timer()

type cell
   visited as integer
   xpos as integer
   ypos as integer
   xconnect as integer
   yconnect as integer
   room as integer
endtype

mapwidth=30
mapheight = 30
dens as float =.90
map_density=(mapwidth*mapheight)*dens
rooms=rnd(10)+10

dim maze(mapwidth,mapheight) as cell

startx=rnd(mapwidth):starty=rnd(mapheight)

maze(startx,starty).visited=1
maze(startx,starty).xpos=startx
maze(startx,starty).ypos=starty
maze(startx,starty).xconnect=startx
maze(startx,starty).yconnect=starty

repeat
blocked=0
if startx-1<=0
   inc blocked
else
   if maze(startx-1,starty).visited=1 then inc blocked
endif

if starty-1<=0
   inc blocked
else
   if maze(startx,starty-1).visited=1 then inc blocked
endif

if startx+1>=mapwidth
   inc blocked
else
   if maze(startx+1,starty).visited=1 then inc blocked
endif

if starty+1>=mapheight
   inc blocked
else
   if maze(startx,starty+1).visited=1 then inc blocked
endif

if blocked<4

   repeat
   open=1
   direction=rnd(4)+1
      select direction
         case 1:
         if starty-1>=0
            if maze(startx,starty-1).visited=0
               newx=startx:newy=starty-1
               maze(newx,newy).visited=1
               maze(newx,newy).xpos=newx
               maze(newx,newy).ypos=newy
               maze(newx,newy).xconnect=startx
               maze(newx,newy).yconnect=starty
               open=0
               startx=newx:starty=newy
            endif
         endif
         endcase
         case 2:
         if starty+1<=mapheight
            if maze(startx,starty+1).visited=0
               newx=startx:newy=starty+1
               maze(newx,newy).visited=1
               maze(newx,newy).xpos=newx
               maze(newx,newy).ypos=newy
               maze(newx,newy).xconnect=startx
               maze(newx,newy).yconnect=starty
               open=0
               startx=newx:starty=newy
            endif
         endif
         endcase
         case 3:
         if startx-1>=0
            if maze(startx-1,starty).visited=0
               newx=startx-1:newy=starty
               maze(newx,newy).visited=1
               maze(newx,newy).xpos=newx
               maze(newx,newy).ypos=newy
               maze(newx,newy).xconnect=startx
               maze(newx,newy).yconnect=starty
               open=0
               startx=newx:starty=newy
            endif
         endif
         endcase

         case 4:
         if startx+1<=mapwidth
            if maze(startx+1,starty).visited=0
               newx=startx+1
               newy=starty
               maze(newx,newy).visited=1
               maze(newx,newy).xpos=newx
               maze(newx,newy).ypos=newy
               maze(newx,newy).xconnect=startx
               maze(newx,newy).yconnect=starty
               open=0
               startx=newx:starty=newy
            endif
         endif
         endcase
      endselect
   until open=0
else
repeat
  xx=rnd(mapwidth)
  yy=rnd(mapheight)
until maze(xx,yy).visited=1
startx=xx:starty=yy

endif
density=0

for a=0 to mapwidth
for b=0 to mapheight
   if maze(a,b).visited=1 then inc density
   line maze(a,b).xpos*10,maze(a,b).ypos*10,maze(a,b).xconnect*10,maze(a,b).yconnect*10
next b
next a
if density>=map_density  then map_complete=1
sync
until map_complete=1

for a = 1 to rooms
   repeat
      repeat
      xx=rnd(mapwidth):yy=rnd(mapheight)
      until xx>=1 and xx<=mapwidth-1 and yy>=1 and yy<=mapheight-1
   until maze(xx,yy).visited=1 and maze(xx,yy).room=0 and maze(xx-1,yy).room=0 and maze(xx+1,yy).room=0 and maze(xx,yy+1).room=0 and maze(xx,yy-1).room=0
   maze(xx,yy).room=1
next a


do
cls
for a=0 to mapwidth
for b=0 to mapheight
   ink rgb(255,255,255),0
   line maze(a,b).xpos*10,maze(a,b).ypos*10,maze(a,b).xconnect*10,maze(a,b).yconnect*10

next b
next a

for a = 0 to mapwidth:for b = 0 to mapheight
if maze(a,b).room=1
      ink rgb(255,0,0),0
      box a*10-5,b*10-5,a*10+5,b*10+5
   endif
next b:next a
text 400,400,"DONE"
sync
loop

`Basic Setup
randomize timer()
sync on
sync rate 0
autocam off
disable escapekey

`Variables
repeat
   print "Must be odd."
   sync
   input "Width: ",width
until width>3 and width/2<>width/2.0
repeat
   print "Must be odd."
   sync
   input "Height: ",height
until height>3 and height/2<>height/2.0
`width=201
`height=201
depth=32
maxpoints=20
maxpathlen=width*height
`Setup for path finding
type node
   g as integer
   h as integer
   pdx as integer
   pdy as integer
   state as integer
endtype
global dim blocks(maxpoints/2,width,height) as node

`Setup for storing positions
type position
   x as integer
   y as integer
endtype
dim pos(maxpoints,2) as position
dim path_positions_list(maxpoints/2,maxpathlen) as position

`Setup for drawing
make memblock 1,width*height*depth*4+12
write memblock dword 1,0,width
write memblock dword 1,4,height
write memblock dword 1,8,depth
for x=1 to width-2
   for y=1 to height-2
      write memblock dword 1,(y*width+x)*4+12,rgb(255,255,255)
   next y
next x
for x=0 to width-1
   write memblock dword 1,x*4+12,rgb(0,0,0)
   write memblock dword 1,((height-1)*width+x)*4+12,rgb(0,0,0)
next x
for y=0 to height-1
   write memblock dword 1,y*width*4+12,rgb(0,0,0)
   write memblock dword 1,(y*width+width-1)*4+12,rgb(0,0,0)
next y
make image from memblock 1,1
sprite 1,0,0,1
size sprite 1,screen width(),screen height()

`Draw
repeat
   sync
   mclick=mouseclick()
   px=x
   py=y
   x=mousex()*(width+0.0)/screen width()
   y=mousey()*(height+0.0)/screen height()
   if mclick=1
      if clicking=1
         if px=x
            if py>y
               lowy=y
               highy=py
            else
               lowy=py
               highy=y
            endif
            for iy=lowy to highy
               write memblock dword 1,(iy*width+x)*4+12,rgb(0,0,0)
            next i
         else
            if abs((py-y+0.0)/(px-x+0.0))=<1
               m#=(py-y+0.0)/(px-x+0.0)
               if px>x
                  lowx=x
                  highx=px
               else
                  lowx=px
                  highx=x
               endif
               for ix=lowx to highx
                  iy=m#*(ix-x)+y
                  write memblock dword 1,(iy*width+ix)*4+12,rgb(0,0,0)
               next ix
            else
               m#=(px-x+0.0)/(py-y+0.0)
               if py>y
                  lowy=y
                  highy=py
               else
                  lowy=py
                  highy=y
               endif
               for iy=lowy to highy
                  ix=m#*(iy-y)+x
                  write memblock dword 1,(iy*width+ix)*4+12,rgb(0,0,0)
               next iy
            endif
         endif
      else
         write memblock dword 1,(y*width+x)*4+12,rgb(0,0,0)
      endif
      clicking=1
   endif
   if mclick=2 and clicking=0
      if checks/2=checks/2.0
         write memblock dword 1,(y*width+x)*4+12,rgb(255,0,0)
         inc p
         pos(p,1).x=x
         pos(p,1).y=y
      else
         write memblock dword 1,(y*width+x)*4+12,rgb(0,255,0)
         pos(p,2).x=x
         pos(p,2).y=y
      endif
      inc checks
      clicking=2
   endif
   if mclick=0
      clicking=0
   endif
   if spacekey()=1 and mazemade=0
      create_maze(width,height)
      mazemade=1
   endif
   make image from memblock 1,1
   if escapekey()=1
      end
   endif
until returnkey()=1 and checks=>2 and checks/2.0=checks/2

`Define world for path finding
for x=0 to width-1
   for y=0 to height-1
      if memblock dword (1,(y*width+x)*4+12)=rgb(0,0,0)
         blocks(0,x,y).state=1
      else
         blocks(0,x,y).state=-1
      endif
   next y
next x

dim success(p) as boolean

`Find path
for i=1 to p
   success(i)=find_path(i,pos(i,1).x,pos(i,1).y,pos(i,2).x,pos(i,2).y,width,height)
next i

`Draw path
color as dword
for i=1 to p
   if success(i)=1
      color=rgb(rnd(255),rnd(255),rnd(255))
      for i2=1 to path_positions_list(i,0).x
         write memblock dword 1,(path_positions_list(i,i2).y*width+path_positions_list(i,i2).x)*4+12,color
      next i2
   endif
next i
make image from memblock 1,1
sync
wait key
end

function find_path(pathnum,startx,starty,endx,endy,width,height)
for x=1 to width
   for y=1 to height
      blocks(pathnum,x,y).state=blocks(0,x,y).state
   next y
next x
blocks(pathnum,startx,starty).state=0
blocks(pathnum,startx,starty).g=0
blocks(pathnum,startx,starty).h=(abs(startx-endx)+abs(starty-endy))*10
blocks(pathnum,startx,starty).pdx=0
blocks(pathnum,startx,starty).pdy=0
repeat
   lowestf=999999
   fx=0
   fy=0
   for x=1 to width
      for y=1 to height
         if blocks(pathnum,x,y).state=0
            tempf=blocks(pathnum,x,y).g+blocks(pathnum,x,y).h
            if tempf<lowestf
               lowestf=tempf
               fx=x
               fy=y
            endif
         endif
      next y
   next x
   if lowestf=999999
      exitfunction 0
   endif
   for a=-1 to 1
      for b=-1 to 1
         n=abs(a)+abs(b)
         diagonal=int(n/2)
         if n=1
            mv=10
         endif
         if n=2
            mv=14
         endif
         if fx+a>-1 and fy+b>-1 and fx+a<width and fy+b<height
            if (blocks(pathnum,fx+a,fy+b).state=1)+(blocks(pathnum,fx+a,fy+b).state=0 and blocks(pathnum,fx+a,fy+b).g<blocks(pathnum,fx,fy).g+mv)+(diagonal=1 and blocks(pathnum,fx+a,fy).state=1)+(diagonal=1 and blocks(pathnum,fx+a,fy).state=1 or blocks(pathnum,fx,fy+b).state=1)=0
               blocks(pathnum,fx+a,fy+b).state=0
               blocks(pathnum,fx+a,fy+b).h=(abs(fx+a-endx)+abs(fy+b-endy))*10
               blocks(pathnum,fx+a,fy+b).g=blocks(pathnum,fx,fy).g+mv
               blocks(pathnum,fx+a,fy+b).pdx=a
               blocks(pathnum,fx+a,fy+b).pdy=b
            endif
         endif
      next b
   next a
   blocks(pathnum,fx,fy).state=1
   if escapekey()=1
      end
   endif
until blocks(pathnum,endx,endy).state=0
nx=endx
ny=endy
pathlen=0
repeat
   inc pathlen
   blocks(pathnum,nx,ny).state=2
   nx=nx-blocks(pathnum,nx,ny).pdx
   ny=ny-blocks(pathnum,nx,ny).pdy
   if escapekey()=1
      end
   endif
until nx=startx and ny=starty
nx=endx
ny=endy
path_positions_list(pathnum,0).x=pathlen
for i=1 to pathlen
   path_positions_list(pathnum,pathlen-i+1).x=nx
   path_positions_list(pathnum,pathlen-i+1).y=ny
   nx=nx-blocks(pathnum,nx,ny).pdx
   ny=ny-blocks(pathnum,nx,ny).pdy
next i
endfunction 1

`For those with short attention spans
function create_maze(xtiles,ytiles)
max=(xtiles*ytiles)-((xtiles-2)*(ytiles-2)-((xtiles-3)/2)*(ytiles-3))+2
local dim maze(xtiles,ytiles) as boolean
for x=1 to xtiles
   maze(x,1)=1
   maze(x,ytiles)=1
next x
for y=1 to ytiles
   maze(1,y)=1
   maze(xtiles,y)=1
next y
counter=2*xtiles+2*ytiles-2
while counter<max and escapekey()=0
   x=rnd(xtiles-2)+1
   y=rnd(ytiles-2)+1
   if maze(x-1,y-1)=1 and maze(x-1,y)+maze(x,y-1)=0 or maze(x-1,y+1)=1 and maze(x-1,y)+maze(x,y+1)=0 or maze(x+1,y-1)=1 and maze(x+1,y)+maze(x,y-1)=0 or maze(x+1,y+1)=1 and maze(x+1,y)+maze(x,y+1)=0 or maze(x,y)=1 or x/2.0=x/2 and y/2.0=y/2 or maze(x-1,y)+maze(x+1,y)+maze(x,y-1)+maze(x,y+1)<>1
   else
      maze(x,y)=1
      inc counter
   endif
endwhile
for x=0 to xtiles-1
   for y=0 to ytiles-1
      if maze(x+1,y+1)=1
         write memblock dword 1,(y*xtiles+x)*4+12,rgb(0,0,0)
      endif
   next y
next x
undim maze(0)
endfunction

rem Challenge: random maze creator
rem Author: acelepage (challenge setter)
set display mode 1024,768,32
hide mouse
backdrop on
color backdrop 0
sync on
top=30
size=10
xoff=20
yoff=20
dim grid(top,top)
doagain:
xtop=1
ytop=1
for x=0 to top
  for y=0 to top
    grid(x,y)=0
  next y
next x
x=1
y=1
quit=0
count=0
while quit=0
  direction=rnd(3)
  accept=1
  xnew=x
  ynew=y
  select direction
    case 0
      xnew=x-2
      if xnew<0
        xnew=x
        accept=0
      endif
    endcase
    case 1
      ynew=y-2
      if ynew<0
        ynew=y
        accept=0
      endif
    endcase
    case 2
      xnew=x+2
      if xnew>top
        xnew=x
        accept=0
      endif
    endcase
    case 3
      ynew=y+2
      if ynew>top
        ynew=y
        accept=0
      endif
    endcase
  endselect
  if grid(xnew,ynew)>0
    accept=0
  endif
  if accept=1
    if x>xnew
      xsgn=-1
    else
      xsgn=1
    endif
    if y>ynew
      ysgn=-1
    else
      ysgn=1
    endif
    for i=x to xnew step xsgn
      for j=y to ynew step ysgn
        grid(i,j)=1
      next j
    next i
    x=xnew
    y=ynew
    count=0
  else
    inc count
    if count > 8
      if x-1>0 and grid(x-1,y)=1
        x=x-1
        grid(x+1,y)=4
        x=x-1
        grid(x+1,y)=4
      else
        if x+1<top and grid(x+1,y)=1
          x=x+1
          grid(x-1,y)=4
          x=x+1
          grid(x-1,y)=4
        else
          if y-1>0 and grid(x,y-1)=1
            y=y-1
            grid(x,y+1)=4
            y=y-1
            grid(x,y+1)=4
          else
            if y+1<top and grid(x,y+1)=1
              y=y+1
              grid(x,y-1)=4
              y=y+1
              grid(x,y-1)=4
            endif
          endif
        endif
      endif
      if x=1 and y=1 then quit=1
      if x=top-1 and y>ytop
        xtop=x
        ytop=y
      endif
    endif
  endif
  gosub showgrid
  sync
endwhile
grid(1,0)=1
grid(1,1)=1
grid(xtop,ytop)=1
grid(top,ytop)=1
gosub showgrid
ink rgb(255,0,0),0
line top*size+size+xoff,ytop*size+size*0.5+yoff,top*size+size*2+xoff,ytop*size+size*0.5+yoff
line top*size+size*2+xoff,ytop*size+size*0.5+yoff,top*size+size*1.5+xoff,ytop*size+yoff
line top*size+size*2+xoff,ytop*size+size*0.5+yoff,top*size+size*1.5+xoff,ytop*size+size+yoff
text xoff,yoff+top*size+size,"press [SPACE] for next maze"

sync
while not spacekey()
endwhile
goto doagain
end

showgrid:
  line xoff+size*1.5,yoff-size*0.5,xoff+size*1.5,yoff-size*1.5
  line xoff+size*1.5,yoff-size*0.5,xoff+size,yoff-size
  line xoff+size*1.5,yoff-size*0.5,xoff+size*2,yoff-size
  ink rgb(255,255,255),0
  line xoff,yoff,top*size+size+xoff,yoff
  line xoff,yoff,xoff,top*size+size+yoff
  line xoff,top*size+size+yoff,top*size+size+xoff,top*size+size+yoff
  line top*size+size+xoff,yoff,top*size+size+xoff,top*size+size+yoff
  for i=0 to top
    for j=0 to top
      if grid(i,j)=3 then grid(i,j)=1
      if grid(i,j)>0 and grid(i,j)<5
        ink rgb(255,255,255),0
        box i*size+xoff,j*size+yoff,i*size+size+xoff,j*size+size+yoff
      endif
      if grid(i,j)=5
        ink rgb(0,255,0),0
        box i*size+xoff,j*size+yoff,i*size+size+xoff,j*size+size+yoff
      endif
    next j
  next i
return

set display mode 1024,768,32
start:
cls


boxx=600
boxy=600
segment=10


`draw box
ink -1,0
box 0,0,boxx,boxy

for p=1 to 2

boxx=600
boxy=600

for n=1 to 4
ink 0,0

  `draw horizintal wall
  wally=(1+rnd((boxx-(segment*2))/segment))*segment
  line 0,wally,boxx,wally
  `draw vertical line

  wallx=(1+rnd((boxy-(segment*2))/segment))*segment
  line wallx,0,wallx,boxy
  colour=rnd(2)
  if colour=0 then ink rgb(255,0,0),0
  if colour=1 then ink rgb(255,255,0),0
  if colour=2 then ink rgb(0,0,255),0
  if rnd(2)=0 then box 0,0,wallx,wally else box wallx,wally,boxx,boxy
`iterate

boxx=wallx
boxy=wally

next n
next p

text 0,650,"Press Space for next Mondrian"
sync
wait key
goto start

input "maze width: ",mx
input "maze height: ",mz

sync on
sync rate 20
autocam off
randomize val(right$(get time$(),2))*val(left$(right$(get time$(),5),2))

dim temproutex(1)
dim temproutez(1)
routepos=0
dim maze(mx,mz)
objs=0

position camera mx/2.0,mx,mz/2.0
point camera mx/2.0,0,mz/2.0
objs=objs+4

objs=objs+1
make object sphere objs,0.5

exitposx=-1
exitposz=-1
select rnd(3)
  case 0
    currposx=0
    currposz=rnd(mz)
    exits=mz
    prev=8
    exitside=2
  endcase
  case 1
    currposx=rnd(mx)
    exits=mx
    currposz=0
    prev=1
    exitside=4
  endcase
  case 2
    currposx=mx
    currposz=rnd(mz)
    exits=mz
    prev=2
    exitside=8
  endcase
  case 3
    currposx=rnd(mx)
    exits=mx
    currposz=mz
    prev=4
    exitside=1
  endcase
endselect
dim mexits(exits)
for count=0 to exits
mexits(count)=count
next count
startposx=currposx
startposz=currposz
startdir=reverse(prev)


  border=0
  if currposx<1
    border=8
  endif
  if currposz>mz-1
    border=border+4
  endif
  if currposx>mx-1
    border=border+2
  endif
  if currposz<1
    border=border+1
  endif
border=border-prev

while reachedexit=0
  exclude=prev+border
  if debug=1
    objs=objs+1
    make object cube objs,0.7
    position object objs,currposx,0,currposz
    position object 5,currposx,1,currposz
    sync
  endif
  dim temproutex(routepos)
  dim temproutez(routepos)
  temproutex(routepos)=currposx
  temproutez(routepos)=currposz
  routepos=routepos+1
  exclude=check(exclude,currposx,currposz)
  direction=gen(exclude)
  maze(currposx,currposz)=setmaze((15-prev)-direction,currposx,currposz,border)
  if direction = 0
    counta=routepos-1
    while check(cborder(temproutex(counta),temproutez(counta),mx,mz),temproutex(counta),temproutez(counta))=15
      counta=counta-1

      if counta<0
        maze(exitposx,exitposz)=0
        counta=routepos-1
      endif
    endwhile
    currposx=temproutex(counta)
    currposz=temproutez(counta)

  endif
  prev=reverse(direction)
  currposx=currposx+dcx(direction)
  currposz=currposz+dcz(direction)
  border=0
  if currposx<1
      if exitside=8
        exits=exits-1
        for counte=0 to exits
          if mexits(counte)=currposz
            array delete element mexits(0),counte
            counte=exits
          endif
        next counte
      endif
      border=8
  endif
  if currposz>mz-1
      if exitside=4
        exits=exits-1
        for counte=0 to exits
          if mexits(counte)=currposx
            array delete element mexits(0),counte
            counte=exits
          endif
        next counte
      endif
      border=border+4
  endif
  if currposx>mx-1
      if exitside=2
        exits=exits-1
        for counte=0 to exits
          if mexits(counte)=currposz
            array delete element mexits(0),counte
            counte=exits
          endif
        next counte
      endif
      border=border+2

  endif
  if currposz<1
      if exitside=1
        exits=exits-1
        for counte=0 to exits
          if mexits(counte)=currposx
            array delete element mexits(0),counte
            counte=exits
          endif
        next counte
      endif
      border=border+1
  endif
  if exits=0
    select exitside
    case 8
      exitposx=0
      exitposz=mexits(0)
    endcase
    case 4
      exitposx=mexits(0)
      exitposz=mz
    endcase
    case 2
      exitposx=mx
      exitposz=mexits(0)
    endcase
    case 1
      exitposx=mexits(0)
      exitposz=0
    endcase
    endselect
    maze(exitposx,exitposz)=15
  endif
  if (currposx=exitposx) AND (currposz=exitposz)then reachedexit=1
endwhile
  direction=exitside
  maze(currposx,currposz)=(15-prev)-direction

for count= 5 to objs
delete object count
next count
objs=4
for countx = 0 to mx
  for countz = 0 to mz
  currsquare=maze(countx,countz)
  if int(currsquare/8)=1
    objs=objs+1
    make object box objs,0.1,1,1
    position object objs,countx-0.5,0,countz
    currsquare=currsquare-8
  endif
  if int(currsquare/4)=1
    objs=objs+1
    make object box objs,1,1,0.1
    position object objs,countx,0,countz+0.5
    currsquare=currsquare-4
  endif
  if int(currsquare/2)=1
    objs=objs+1
    make object box objs,0.1,1,1
    position object objs,countx+0.5,0,countz
    currsquare=currsquare-2
  endif
  if currsquare=1
    objs=objs+1
    make object box objs,1,1,0.1
    position object objs,countx,0,countz-0.5
  endif
  next countz
next countx

objs=objs+1
make object sphere objs,0.6
position object objs,exitposx,1,exitposz
sync
sync
while spacekey()<>1
endwhile
cmax=camera angle x()
cmay=camera angle y()
cmaz=camera angle z()
cmx=camera position x()
cmy=camera position y()
cmz=camera position z()
for count=1 to 20
  rotate camera cmax-((cmax/20.0)*count),cmay-(((cmay-angle(exitside))/20.0)*count),cmaz-((cmaz/20.0)*count)
  position camera cmx-(((cmx-exitposx)/20.0)*count),cmy-((cmy/20.0)*count),cmz-(((cmz-exitposz)/20.0)*count)
  sync
next count
set camera range 0.1,3000
position camera exitposx,0,exitposz
rotate camera 0,angle(exitside),0
cp=0
ct=angle(exitside)
tar=0
currposx=exitposx
currposz=exitposz
objs=objs+1
make object cube objs,0.6
position object objs, startposx,0,startposz
endobj=objs
objs=objs+1
make object cube objs,0.5
playerobj=objs
gradx=0
gradz=0
targetposx=currposx
targetposz=currposz

do


cp=cp+mousemovey()
if cp>40 then cp=40
if cp<-40 then cp=-40
xrotate camera wrapvalue(cp)
ct=wrapvalue(ct+mousemovex())
yrotate camera ct

if (spacekey()) AND (tar=0)
  tar=1
  if controlkey()
    direction=cv(int(wrapvalue(camera angle y()+225)/90))
  else
    direction=cv(int(wrapvalue(camera angle y()+45)/90))
  endif
  if contains(direction,cborder(currposx,currposz,mx,mz))=1 then direction=direction-cborder(currposx,currposz,mx,mz)
  if contains(maze(currposx+dcx(direction),currposz+dcz(direction)),reverse(direction))=0
    `currposx=currposx+dcx(direction)
    `currposz=currposz+dcz(direction)
    targetposx=currposx+dcx(direction)
    targetposz=currposz+dcz(direction)
  endif
endif
if targetposx>currposx then gradx=gradx+1
if targetposx<currposx then gradx=gradx-1
if targetposz>currposz then gradz=gradz+1
if targetposz<currposz then gradz=gradz-1
if (currposx+(gradx/10.0)=targetposx) OR (currposx=targetposx)
  currposx=targetposx
  gradx=0
  tar=0
endif
if (currposz+(gradz/10.0)=targetposz) OR (currposz=targetposz)
  currposz=targetposz
  gradz=0
  tar=0
endif
if shiftkey()
  set camera range 1,3000
  position camera mx/2.0,mx,mz/2.0
  point camera mx/2.0,0,mz/2.0
else
  set camera range 0.1,3000
  position camera currposx+(gradx/10.0),0,currposz+(gradz/10.0)
  yrotate object playerobj,camera angle y()
endif
endscreenx=object screen x(endobj)
if endscreenx>screen width() then endscreenx=screen width()
if endscreenx<0 then endscreenx=0
if object in screen(endobj)=0
  if endscreenx>(screen width()/2) then endscreenx=screen width()
  if endscreenx<(screen width()/2) then endscreenx=0
endif
line endscreenx-10,10,endscreenx+10,10
line endscreenx+10,10,endscreenx,40
line endscreenx,40,endscreenx-10,10
rotate object endobj,wrapvalue(object angle x(endobj)+5),wrapvalue(object angle y(endobj)+5),wrapvalue(object angle z(endobj)+5)
position object playerobj,currposx+(gradx/10.0),0,currposz+(gradz/10.0)
if (currposx=startposx) AND (currposz=startposz) then exit
sync
loop


function cv(a)
select a
  case 0:res=4:endcase
  case 1:res=2:endcase
  case 2:res=1:endcase
  case 3:res=8:endcase
endselect
endfunction res


function gen(a)
dim pr(3)
prs=0
  if int(a/8)=1
    a=a-8
  else
    pr(prs)=8
    prs=prs+1
  endif
  if int(a/4)=1
    a=a-4
  else
    pr(prs)=4
    prs=prs+1
  endif
  if int(a/2)=1
    a=a-2
  else
    pr(prs)=2
    prs=prs+1
  endif
  if a=0
    pr(prs)=1
    prs=prs+1
  endif
if prs>0
  res=pr(rnd(prs-1))
endif
endfunction res

function dcx(a)
res=0
  if int(a/8)=1
    a=a-8
    res=-1
  endif
  if int(a/4)=1
    a=a-4
  endif
  if int(a/2)=1
    a=a-2
    res=1
  endif
endfunction res

function dcz(a)
res=0
  if int(a/8)=1
    a=a-8
  endif
  if int(a/4)=1
    a=a-4
    res=1
  endif
  if int(a/2)=1
    a=a-2
  endif
  if a=1
    res=-1
  endif
endfunction res

function reverse(a)
select a
  case 1:res=4:endcase
  case 2:res=8:endcase
  case 4:res=1:endcase
  case 8:res=2:endcase
endselect
endfunction res


function check(a,x,z)
res=a
  if int(a/8)=1
    a=a-8
  else
    if maze(x-1,z)<>0 then res=res+8
  endif
  if int(a/4)=1
    a=a-4
  else
    if maze(x,z+1)<>0 then res=res+4
  endif
  if int(a/2)=1
    a=a-2
  else
    if maze(x+1,z)<>0 then res=res+2
  endif
  if a=0
    if maze(x,z-1)<>0 then res=res+1
  endif
endfunction res

function cborder(x,z,mx,mz)
  res=0
  if x<1
    res=res+8
  endif
  if z>(mz-1)
    res=res+4
  endif
  if x>(mx-1)
    res=res+2
  endif
  if z<1
    res=res+1
  endif
endfunction res


function contains(a,b)
ret=0
  if int(a/8)=1
    a=a-8
    if b=8 then ret=1
  endif
  if int(a/4)=1
    a=a-4
    if b=4 then ret=1
  endif
  if int(a/2)=1
    a=a-2
    if b=2 then ret=1
  endif
  if a=1
    if b=1 then ret=1
  endif
endfunction ret

function setmaze(a,x,z,b)
res=a
a=a-b
  if int(a/8)=1
    a=a-8
    if (maze(x-1,z)>0) AND (contains(maze(x-1,z),2)=0) then res=res-8
  endif
  if int(a/4)=1
    a=a-4
    if (maze(x,z+1)>0) AND (contains(maze(x,z+1),1)=0) then res=res-4
  endif
  if int(a/2)=1
    a=a-2
    if (maze(x+1,z)>0) AND (contains(maze(x+1,z),8)=0) then res=res-2
  endif
  if a=1
    if (maze(x,z-1)>0) AND (contains(maze(x,z-1),4)=0) then res=res-1
  endif
  if res=0 then res=-1
endfunction res

function angle(a)
  if int(a/8)=1
    a=a-8
    res=90
  endif
  if int(a/4)=1
    a=a-4
    res=180
  endif
  if int(a/2)=1
    a=a-2
    res=270
  endif
  if a=1
    res=0
  endif
endfunction res

set display mode 1024,768,32
sync on
color backdrop 0
make object cube 1,1
hide object 1


centreradius=50
mazeradius=230
corridorwidth=30
x=mazeradius+5
y=mazeradius+5

ink rgb(200,200,255),0

start:
create bitmap 1,mazeradius*2+10,mazeradius*2+10
lock pixels
for r=centreradius to mazeradius step corridorwidth
  `corridor side walls
  ang1=rnd(360)
  ang2=ang1+350
  for n=ang1 to ang2
    line x+r*sin(n),y+r*cos(n),x+r*sin(n+1),y+r*cos(n+1)
  next n
  `corridor end walls
  if r<mazeradius
    ang3=ang1+rnd(350)
    line x+(r+1)*sin(ang3),y+(r+1)*cos(ang3),x+(r+corridorwidth)*sin(ang3),y+(r+corridorwidth)*cos(ang3)
  endif
  if r<mazeradius
    `sub-corridor side walls
    ang4=ang3+rnd(30)
    ang5=ang4+rnd(50)+100
    for n=ang4 to ang5
      line x+(r+corridorwidth/2)*sin(n),y+(r+corridorwidth/2)*cos(n),x+(r+corridorwidth/2)*sin(n+1),y+(r+corridorwidth/2)*cos(n+1)
    next n
    `sub-corridor end walls
    ang6=ang4+rnd(ang5-ang4)
    line x+(r+corridorwidth/2)*sin(ang6),y+(r+corridorwidth/2)*cos(ang6),x+(r+corridorwidth)*sin(ang6),y+(r+corridorwidth)*cos(ang6)
    `secondary sub-corridor side walls
    ang7=ang5+rnd(30)+10
    ang8=ang7+rnd(50)+80
    for n=ang7 to ang8
      line x+(r+corridorwidth/2)*sin(n),y+(r+corridorwidth/2)*cos(n),x+(r+corridorwidth/2)*sin(n+1),y+(r+corridorwidth/2)*cos(n+1)
    next n
    `secondary sub-corridor end walls
    ang9=ang7+rnd(ang8-ang7)
    if rnd(1)=0
      `make some go out to next wall
      line x+(r+corridorwidth/2)*sin(ang9),y+(r+corridorwidth/2)*cos(ang9),x+(r+corridorwidth)*sin(ang9),y+(r+corridorwidth)*cos(ang9)
    else
      `and some in to previous wall
      line x+(r+corridorwidth/2)*sin(ang9),y+(r+corridorwidth/2)*cos(ang9),x+(r)*sin(ang9),y+(r)*cos(ang9)
    endif

  endif
next r

unlock pixels
blur bitmap 1,2

get image 1,0,0,mazeradius*2+10,mazeradius*2+10,1

delete bitmap 1

sprite 1,screen width()/2-mazeradius,screen height()/2-mazeradius,1

do
text 0,0,"Press space to regenerate"
if spacekey()=1 then goto start
sync
loop

`Random Maze Generator
`Created by Parrot
`January 19, 2007

autocam off
sync on
sync rate 0
hide mouse

type collision_segment
   x1 as float
   x2 as float
   z1 as float
   z2 as float
endtype

dim collisions(25) as collision_segment

`Let there be light!
`set ambient light 80
make light 1
set point light 1,0,0,0
color light 1,RGB(255,255,255)

`Set the map values
mapxsize = 40
mapzsize = 40
squaresize = 6

`Create the map values and fill it with walls
dim map$(mapxsize,mapzsize)
for zsquare = 1 to mapzsize
   for xsquare = 1 to mapxsize
      map$(xsquare,zsquare) = "#"
   next xsqare
next zsquare

`Dig out the starting room
for zsquare = 2 to 6
   for xsquare = 2 to 6
      map$(xsquare,zsquare) = " "
   next xsqare
next zsquare
map$(4,4) = "S"
map$(4,7) = " "

north = 0
east = 1
south = 2
west = 3

randomize timer()

` Set the values to start and dig a path
direction = south
permutations = 20
xpos = 4
zpos = 8
gosub digger

`Dig out the destination room
for zsquare = mapzsize-5 to mapzsize-1
   for xsquare = mapxsize-5 to mapxsize-1
      map$(xsquare,zsquare) = " "
   next xsqare
next zsquare

map$(mapxsize-3,mapzsize-3) = "Z"
map$(mapxsize-3,mapzsize-6) = " "

`Dig a path from the destination room
direction = north
permutations = 20
xpos = mapxsize-3
zpos = mapzsize-7
gosub digger

`Dig a couple of extra paths for good measure
direction = north
permutations = 15
xpos = 2
zpos = mapzsize-1
gosub digger

direction = south
permutations = 15
xpos = mapzsize-1
zpos = 2
gosub digger

cubeofvictory = 1
walls = 2
ground = 3

floorxsize = squaresize * mapxsize
floorzsize = squaresize * mapzsize
sizeoffset# = squaresize / 2

`Create the ground
make object plain ground,floorxsize,floorzsize
rotate object ground,90,0,0
position object ground,floorxsize/2,0,floorzsize/2
color object ground, rgb(255,0,0)

`Create the seed object for the maze
make object cube walls, squaresize
make mesh from object walls, walls
delete object walls
make object cube walls, 1

wallpart = 1

`Set everything up according to the map
for zpos=1 to mapzsize
   for xpos=1 to mapxsize
      floorxpos = xpos * squaresize
      floorzpos = zpos * squaresize
      if map$(xpos,zpos)="S"
         position camera floorxpos-sizeoffset#,sizeoffset#,floorzpos-sizeoffset#
      endif
      if map$(xpos,zpos)="#"
         add limb walls, wallpart, walls
         offset limb walls, wallpart, floorxpos-sizeoffset#, sizeoffset#, floorzpos-sizeoffset#
         wallpart = wallpart + 1
      endif
      if map$(xpos,zpos)="Z"
         make object cube cubeofvictory, 2
         position object cubeofvictory, floorxpos-sizeoffset#, 3, floorzpos-sizeoffset#
      endif
   next xpos
next zpos

delete mesh walls

color object walls, rgb(0,255,0)

mapxpos = int(camera position x()/squaresize)
mapzpos = int(camera position z()/squaresize)
oldx# = camera position x()
oldz# = camera position z()

`Main Loop
DO
   nomove = 1

   `Detect keys and move the camera appropriately
   if upkey()
      move camera 0.1
      nomove = 0
   endif
   if downkey()
      move camera -0.1
      nomove = 0
   endif
   if leftkey()
      yrotate camera camera angle y()-0.5
      nomove = 0
   endif
   if rightkey()
      yrotate camera camera angle y()+0.5
      nomove = 0
   endif

   xdiff# = camera position x() - oldx#
   zdiff# = camera position z() - oldz#

   `Calculate the current position based on map co-ordinates
   mapxpos = int(camera position x()/squaresize)
   mapzpos = int(camera position z()/squaresize)

   if not nomove
      `Calculate a map-area perimiter around the player
      zpstart = mapzpos-2
      zpend = mapzpos+2
      xpstart = mapxpos-2
      xpend = mapxpos+2
      if zpstart < 1 then zpstart = 1
      if zpend > mapzsize then zpend = mapzsize
      if xpstart < 1 then xpstart = 1
      if xpend > mapxsize then xpend = mapxsize

      colcount = 0
      `Loop through all the co-ordinates in the map perimiter we just calculated
      for zperim = zpstart to zpend
         for xperim = xpstart to xpend
            if map$(xperim,zperim) = "#" `If there's a wall, calculate the collision values
               testx1# = (xperim * squaresize) - squaresize - sizeoffset#/2
               testz1# = (zperim * squaresize) - squaresize - sizeoffset#/2
               testx2# = (xperim * squaresize) + sizeoffset#/2
               testz2# = (zperim * squaresize) + sizeoffset#/2

               xcollision = 0
               zcollision = 0
               if camera position x() >= testx1# and camera position x() <= testx2# then xcollision = 1
               if camera position z() >= testz1# and camera position z() <= testz2# then zcollision = 1

               `If a collision occurs, record the collision values
               if xcollision and zcollision
                  colcount = colcount + 1
                  collisions(colcount).x1 = testx1#
                  collisions(colcount).x2 = testx2#
                  collisions(colcount).z1 = testz1#
                  collisions(colcount).z2 = testz2#
               endif
            endif
         next xperim
      next zperim
   endif

   `Handle the collisions based on all collision objects recorded
   if colcount
      xpointx# = oldx#+xdiff#
      xpointz# = oldz#
      zpointx# = oldx#
      zpointz# = oldz#+zdiff#
      for i=1 to colcount
         if xpointx# >= collisions(i).x1 and xpointx# <= collisions(i).x2 and xpointz# >= collisions(i).z1 and xpointz# <= collisions(i).z2
            xdiff# = 0
         endif
         if zpointx# >= collisions(i).x1 and zpointx# <= collisions(i).x2 and zpointz# >= collisions(i).z1 and zpointz# <= collisions(i).z2
            zdiff# = 0
         endif
      next i
      position camera oldx#+xdiff#,sizeoffset#,oldz#+zdiff#
   endif

   oldx# = camera position x()
   oldz# = camera position z()

   position light 1,camera position x(),camera position y(),camera position z()
   rotate light 1,camera angle x(),camera angle y(),camera angle z()

   `Draw a 2D Map on the screen
   for zpos=1 to mapzsize
      for xpos=1 to mapxsize
         floorxpos = xpos * squaresize
         floorzpos = zpos * squaresize
         if map$(xpos,zpos)="S"
            ink rgb(0,255,0),rgb(0,0,0)
            x1 = mapxsize*5 - 5*xpos
            x2 = x1+5
            box x1,5*zpos,x2,5*zpos+5
         endif
         if map$(xpos,zpos)="Z"
            ink rgb(255,0,0),rgb(0,0,0)
            x1 = mapxsize*5 - 5*xpos
            x2 = x1+5
            box x1,5*zpos,x2,5*zpos+5
         endif
         if map$(xpos,zpos)=" "
            ink rgb(255,255,255),rgb(0,0,0)
            x1 = mapxsize*5 - 5*xpos
            x2 = x1+5
            box x1,5*zpos,x2,5*zpos+5
         endif
      next xpos
   next zpos

   yrotate object cubeofvictory, object angle y(cubeofvictory) + 0.6

   sync
LOOP

digger:
   gosub excavate

   for pcount = 1 to permutations
      turnto = rnd(1)
      if direction = north or direction = south
         direction = west
         if turnto then direction = east
      else
         direction = south
         if turnto then direction = north
      endif

      gosub excavate
   next pcount
return

excavate:
   if direction = north then squaresleft = zpos - 2
   if direction = east then squaresleft = mapxsize - xpos - 2
   if direction = south then squaresleft = mapzsize - zpos - 2
   if direction = west then squaresleft = xpos - 2

   if squaresleft < 4
      olddir = direction
      oldsl = squaresleft

      if direction = north
         direction = south
      else
         if direction = south then direction = north
      endif

      if direction = east
         direction = west
      else
         if direction = west then direction = east
      endif

      if direction = north then squaresleft = zpos - 2
      if direction = east then squaresleft = mapxsize - xpos - 2
      if direction = south then squaresleft = mapzsize - zpos - 2
      if direction = west then squaresleft = xpos - 2
   endif

   distance = rnd(squaresleft-4) + 4
   if distance > 10 then distance = 10

   go = 1
   for i = 1 to distance
      if xpos <= 7 and zpos <= 7 then go = 0
      if xpos >= mapxsize-6 and zpos >= mapzsize-6 then go = 0

      if go
         map$(xpos,zpos) = " "
         if direction = north then zpos = zpos - 1
         if direction = east then xpos = xpos + 1
         if direction = south then zpos = zpos + 1
         if direction = west then xpos = xpos - 1
      endif
   next i
return

gadgetfreak 66

Parrot