Rem Random Maze Generation By TDK_Man
Rem For DBC Challenges
 
Set Display Mode 800,600,32
Sync On
Sync Rate 0
Randomize Timer()
AutoCam Off
Gosub MakeTextures
CLS
 
rem Input "Maze Grid Size (Eg: 16 = 16x16 Maze): ";GridSize
CellSize = 32: GridSize=16
 
PlayerHeight# = CellSize/3.0
CeilingHeight# = CellSize
rem Set Camera Range 1.0,Gridsize*CellSize
 
Dim CellVisited(GridSize-1,GridSize-1)
Dim WallArray(GridSize-1,GridSize-1)
Dim Neighbours(3)
Dim NextPathDir(3)
Dim OriginalPath(GridSize*GridSize,1)
MazeOffsetX = 10: MazeOffsetY = 10
 
OrigPathCells = 1: CellNum = 1
OriginX = -1: OriginY = -1
 
Rem Cells...
CLS
For Ny=0 To GridSize-1
  For Nx=0 To GridSize-1
    CellVisited(Nx,Ny) = -1: Rem Set Each Cell To Unvisited (1=Visited)
    WallArray(Nx,Ny) = 15: Rem Set Each Cell To Having All Four Walls
  Next Nx
Next Ny
 
EntryX = GridSize/2: EntryY = 0
ExitX = -1: ExitY = -1
CurrentCellX = EntryX: CurrentCellY = EntryY
 
WallArray(EntryX,EntryY) = WallArray(EntryX,EntryY)-1: Rem Remove top wall for exit door
CellVisited(EntryX,EntryY) = 1: Rem Set Entry Cell As Visited
Phase = 1
Print "Please Wait - Generating Random Maze..."
 
Do
  If Phase = 1 Then Gosub MainPath
  If Phase = 2 Then Gosub NextCell
  If Phase = 3 Then Gosub UnChartered
  If Phase = 4 Then Gosub Finished
  Sync
Loop
End
 
Finished:
  Rem Maze Finished!!!!
  Set Camera View 0,0,800,600
  Position Camera EntryX*CellSize+(CellSize/2),PlayerHeight,CellSize*GridSize
  YRotate Camera 180
  Fog On: Fog Color 0: Fog Distance CellSize*3
  Backdrop On: Color Backdrop 0
  Hide Mouse
  LightLevel = 40
  Color Light 0,0
  Set Mipmap Mode 2
  Wireframe=1: Transparency=1: Cull=0: Filter=1: Light=1: Fog=1: Ambient=0
 
  Rem Missing Left Walls
  Backz = CellSize*GridSize
  ObjNum = 1
  For Ny=1 To GridSize
    Make Object Box ObjNum,1,CellSize,CellSize
    Make Object Collision Box ObjNum,-0.5,0-(CellSize/2),0-(CellSize/2),0.5,CellSize/2,CellSize/2,0
    Set Object ObjNum,Wireframe, Transparency, Cull, Filter, Light, Fog, Ambient
    Set Object Ambient ObjNum,RGB(LightLevel,LightLevel,LightLevel)
    Texture Object ObjNum,2
    Scale Object Texture ObjNum,4,4
    Position Object ObjNum,0,CellSize/2,Ny*CellSize
    Inc ObjNum
  Next Ny
 
  Rem Missing Top Wall
  For Nx=1 To GridSize
    ThisCell = WallArray(Nx-1,0)
    If ThisCell >= 8: Rem Right Wall
      Dec ThisCell,8
    Endif
    If ThisCell >= 4 : Rem Left Wall
      Dec ThisCell,4
    Endif
    If ThisCell >= 2: Rem Bottom Wall
      Dec ThisCell,2
    Endif
    If ThisCell = 1: Rem Top Wall
      Make Object Box ObjNum,CellSize,CellSize,1
      Make Object Collision Box ObjNum,0-(CellSize/2),0-(CellSize/2),-0.5,CellSize/2,CellSize/2,0.5,0
      Set Object ObjNum,Wireframe, Transparency, Cull, Filter, Light, Fog, Ambient
      Set Object Ambient ObjNum,RGB(LightLevel,LightLevel,LightLevel)
      Texture Object ObjNum,2
      Scale Object Texture ObjNum,4,4
      Position Object ObjNum,Nx*CellSize-(CellSize/2),CellSize/2,Backz+(CellSize/2)
      Inc ObjNum
    Endif
  Next Ny
 
  Rem Maze Walls
  For Ny=0 To GridSize-1
    For Nx=0 To GridSize-1
      CLS
      ThisCell = WallArray(Nx,Ny)
      If ThisCell >= 8
        Rem Right Wall
        Make Object Box ObjNum,1,CellSize,CellSize
        Make Object Collision Box ObjNum,-0.5,0-(CellSize/2),0-(CellSize/2),0.5,CellSize/2,CellSize/2,0
        Set Object ObjNum,Wireframe, Transparency, Cull, Filter, Light, Fog, Ambient
        Set Object Ambient ObjNum,RGB(LightLevel,LightLevel,LightLevel)
        Texture Object ObjNum,2
        Scale Object Texture ObjNum,4,4
        Position Object ObjNum,Nx*CellSize+CellSize,CellSize/2,Backz-(Ny*CellSize)
        Inc ObjNum
        Dec ThisCell,8
      Endif
      If ThisCell >= 4
        Dec ThisCell,4
      Endif
      If ThisCell >= 2
        Rem Bottom Wall
        Make Object Box ObjNum,CellSize,CellSize,1
        Make Object Collision Box ObjNum,0-(CellSize/2),0-(CellSize/2),0.5,CellSize/2,CellSize/2,0.5,0
        Set Object ObjNum,Wireframe, Transparency, Cull, Filter, Light, Fog, Ambient
        Set Object Ambient ObjNum,RGB(LightLevel,LightLevel,LightLevel)
        Texture Object ObjNum,2
        Scale Object Texture ObjNum,4,4
        If Ny=GridSize-1
        Else
        Endif
        Position Object ObjNum,Nx*CellSize+(CellSize/2),CellSize/2,Backz-(Ny*CellSize)+(CellSize/2)
        Inc ObjNum
        Dec ThisCell,2
      Endif
    Next Nx
  Next Ny
 
  Rem Finish Sign
  Make Object Box ObjNum,CellSize,CellSize/4,.01
  Set Object ObjNum, Wireframe, Transparency, Cull, Filter, 0, 0, 0
  Texture Object ObjNum,3
  Position Object ObjNum,ExitX*CellSize+(CellSize/2),CeilingHeight#-(CellSize/8),CellSize/2
 
  Rem Sliding Collision Box For Camera
  Make Object Sphere 5000,2
  Set Object Collision To Spheres 5000
  Make Object Collision Box 5000,-2,-2,-2,2,2,2,0
 
  RoofPosX=(Gridsize*CellSize)/2: RoofPosZ=RoofPosX + (CellSize/2)
  RoofWid = Gridsize*CellSize: RoofHig=RoofWid : rem - (CellSize/4)
 
  Rem Floor
  Inc ObjNum
  Make Object Plain ObjNum,RoofWid,RoofHig
  Set Object Ambient ObjNum,RGB(LightLevel,LightLevel,LightLevel)
  Set Object ObjNum,Wireframe, Transparency, Cull, Filter, Light, 0, Ambient
  Position Object ObjNum,RoofPosX,0,RoofPosZ
  XRotate Object ObjNum,90
  Texture Object ObjNum,2
  Scale Object Texture ObjNum,Gridsize*4,Gridsize*4
 
  Rem Roof
  Inc ObjNum
  Make Object Plain ObjNum,RoofWid,RoofHig
  Set Object Ambient ObjNum,RGB(LightLevel,LightLevel,LightLevel)
  Set Object ObjNum,Wireframe, Transparency, Cull, Filter, Light, 0, Ambient
  Position Object ObjNum,RoofPosX,CeilingHeight#,RoofPosZ
  XRotate Object ObjNum,90
  Texture Object ObjNum,2
  Scale Object Texture ObjNum,Gridsize*4,Gridsize*4
 
  Do
    CX#=Camera Angle X(): CY#=Camera Angle Y(): CZ#=Camera Angle Z()
    CY#=Wrapvalue(CY#+mousemovex())
    CX#=Wrapvalue(CX#+mousemovey())
    Rotate Camera CX#,CY#,CZ#
    If MouseClick()=1 Then Move Camera CellSize/120.0
    If MouseClick()=2 Then Move Camera 0-CellSize/120.0
    CamX# = Camera Position X(): CamY# = PlayerHeight#: CamZ# = Camera Position Z()
    Position Camera CamX#,PlayerHeight#,CamZ#
    Position Object 5000,CamX#,PlayerHeight#,CamZ#
    ObjHit = Object Collision(5000,0)
    If ObjHit > 0
      Dec CamX#,Get Object Collision X()
      Dec CamZ#,Get Object Collision Z()
      Position Camera CamX#,PlayerHeight#,CamZ#
      Position Object 5000,CamX#,PlayerHeight#,CamZ#
    Endif
    Sync
  Loop
Return
 
UnChartered:
  FoundOne=0
  For Ny=0 To GridSize-1
    For Nx=0 To GridSize-1
      If CellVisited(NX,NY)=-1: Rem Unvisited Cell
        CurrentCellX = Nx: CurrentCellY = Ny
        CellVisited(NX,NY) = Phase
        Nx=GridSize-1: Ny=GridSize-1
        Inc FoundOne
      Endif
    Next Nx
  Next Ny
  If FoundOne=0
    Phase = 4
  Else
    Phase = 2
    CellNum = 3
    OrigPathCells=0
  Endif
Return
 
NextCell:
  Rem Clear Last Array Data
  For N=0 To 3
    NextPathDir(N) = 0: Neighbours(N) = 0
  Next N
  Rem Neighbours Start At 1=North  2=South  3=East  4=West
  If CurrentCellY > 0 Then Neighbours(0) = CellVisited(CurrentCellX,CurrentCellY-1)
  If CurrentCellY < GridSize-1 Then Neighbours(1) = CellVisited(CurrentCellX,CurrentCellY+1)
  If CurrentCellX < GridSize-1 Then Neighbours(2) = CellVisited(CurrentCellX+1,CurrentCellY)
  If CurrentCellX > 0 Then Neighbours(3) = CellVisited(CurrentCellX-1,CurrentCellY)
  DirCounter = 0
  For N=0 To 3
    If Neighbours(N) = -1: Rem Unvisited
      NextPathDir(DirCounter) = N
      Inc DirCounter
    Endif
  Next N
  If DirCounter > 0
 
    If CellNum=3
      OriginalPath(OrigPathCells,0) = CurrentCellX
      OriginalPath(OrigPathCells,1) = CurrentCellY
      Inc OrigPathCells
    Endif
 
    Rem Choose Random Direction
    DirToGo = Rnd(DirCounter-1)
    ActDir = NextPathDir(DirToGo)
    Select ActDir
      Case 0
        Rem North
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-1
        Dec CurrentCellY
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-2
      EndCase
      Case 1
        Rem South
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-2
        Inc CurrentCellY
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-1
      EndCase
      Case 2
        Rem East
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-8
        Inc CurrentCellX
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-4
      EndCase
      Case 3
        Rem West
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-4
        Dec CurrentCellX
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-8
      EndCase
    EndSelect
    Rem Record Main Path X/Y Positions For Later Retracing
 
    Rem Move Into New Cell
    CellVisited(CurrentCellX,CurrentCellY) = CellNum
 
  Else
    Rem No adjacent -1 cells to jump into
    Inc RetraceSteps
    If RetraceSteps > OrigPathCells
      RetraceSteps=1
      OrigPathCells=1
      Phase = 3
    Else
      CurrentCellX = OriginalPath(RetraceSteps,0)
      CurrentCellY = OriginalPath(RetraceSteps,1)
      OriginX = CurrentCellX: OriginY = CurrentCellY
    Endif
  Endif
Return
 
MainPath:
  Rem Clear Last Array Data
  For N=0 To 3
    NextPathDir(N) = 0: Neighbours(N) = 0
  Next N
  Rem Neighbours Start At 1=North  2=South  3=East  4=West
  If CurrentCellY < GridSize-1 Then Neighbours(1) = CellVisited(CurrentCellX,CurrentCellY+1)
  If CurrentCellX < GridSize-1 Then Neighbours(2) = CellVisited(CurrentCellX+1,CurrentCellY)
  If CurrentCellX > 0 Then Neighbours(3) = CellVisited(CurrentCellX-1,CurrentCellY)
  DirCounter = 0
  For N=1 To 3
    If Neighbours(N) = -1: Rem Unvisited
      NextPathDir(DirCounter) = N
      Inc DirCounter
    Endif
  Next N
  If CurrentCellY < GridSize-1
    Rem Choose Random Direction
    DirToGo = Rnd(DirCounter-1)
    ActDir = NextPathDir(DirToGo)
    Select ActDir
      Case 1
        Rem South
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-2
        Inc CurrentCellY
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-1
      EndCase
      Case 2
        Rem East
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-8
        Inc CurrentCellX
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-4
      EndCase
      Case 3
        Rem West
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-4
        Dec CurrentCellX
        WallArray(CurrentCellX,CurrentCellY) = WallArray(CurrentCellX,CurrentCellY)-8
      EndCase
    EndSelect
    Rem Record Main Path X/Y Positions For Later Retracing
    OriginalPath(OrigPathCells,0) = CurrentCellX
    OriginalPath(OrigPathCells,1) = CurrentCellY
    Inc OrigPathCells
    Rem Move Into New Cell
    CellVisited(CurrentCellX,CurrentCellY) = CellNum
  Else
    Rem Reached Exit Wall
    WallArray(CurrentCellX,CurrentCellY) = 12: Rem Open Door To Outside
    ExitX = CurrentCellX: ExitY = CurrentCellY
    RetraceSteps = 1
    CurrentCellX = OriginalPath(RetraceSteps,0): CurrentCellY = OriginalPath(RetraceSteps,1)
    OriginX = CurrentCellX: OriginY = CurrentCellY
    Phase = 2
    CellNum = 2
  Endif
Return
 
DrawMaze:
  CLS
  For Ny=0 To GridSize-1
    For Nx=0 To GridSize-1
      Rem Draw Floor
      Ink RGB(255,255,255),0
      rem If (Nx=EntryX and Ny=EntryY) Or (Nx=ExitX and Ny=ExitY) Then Ink RGB(230,230,230),0
 
      rem If CellVisited(Nx,Ny)=1 Then Ink RGB(255,240,240),0
      rem If CellVisited(Nx,Ny)=3 Then Ink RGB(255,200,140),0
 
      rem If CellVisited(Nx,Ny)=-1 Then Ink RGB(255,240,240),0
 
      Box Nx*CellSize+MazeOffsetX,Ny*CellSize+MazeOffsetY,  Nx*CellSize+MazeOffsetX+CellSize-1,  Ny*CellSize+MazeOffsetY+CellSize-1
      TextPosX = Nx*CellSize+(CellSize/2)+2: TextPosY = Ny*CellSize+(CellSize/2)+2
 
      rem Ink 0,0: Text TextPosX,TextPosY,Str$(WallArray(NX,NY))
      rem Ink 0,0: Text TextPosX,TextPosY,Str$(CellVisited(NX,NY))
 
      Rem If CellVisited(Nx,Ny)=-1 Then Ink 0,0: Text TextPosX,TextPosY,Str$(CellVisited(Nx,Ny))
      Rem All Four Walls = 1+2+4+8 (15)
      ThisCell = WallArray(Nx,Ny)
      Ink RGB(255,0,0),0
      If ThisCell >= 8
        Rem Right Wall
        WallPosX = Nx*CellSize+(MazeOffsetX+CellSize-1)
        Line WallPosX,  Ny*CellSize+MazeOffsetY,  WallPosX,  Ny*CellSize+MazeOffsetY+CellSize-1
        Dec ThisCell,8
      Endif
      If ThisCell >= 4
        Rem Left Wall
        Dec ThisCell,4
      Endif
      If ThisCell >= 2
        Rem Bottom Wall
        WallPosY = Ny*CellSize+(MazeOffsetY+CellSize-1)
        Line Nx*CellSize+MazeOffsetX,WallPosY,Nx*CellSize+MazeOffsetX+CellSize-1,WallPosY
        Dec ThisCell,2
      Endif
      If ThisCell = 1
        Rem Top Wall
      Endif
    Next Nx
  Next Ny
  Ink RGB(255,255,255),0
Return
 
MakeTextures:
  Create Bitmap 1,800,600
  CLS RGB(200,200,200): Ink RGB(90,90,100),0
  For N=0 To 3: Circle 6,6,4-N: Next N
  For N=0 To 3: Circle 123,6,4-N: Next N
  For N=0 To 3: Circle 6,59,4-N: Next N
  For N=0 To 3: Circle 123,59,4-N: Next N
  Box 6,2,124,63: Box 2,6,127,59
  For N=1 To 4000
    C=Rnd(200): Ink RGB(C,C,C),0: Dot Rnd(122)+4,Rnd(58)+4
  Next N
  Sync
  Get Image 1,0,0,128,64
  For Ny=0 To 15
    For Nx=0 To 9
      Paste Image 1,Nx*128-Offset,Ny*64
    Next Nx
    Inc Offset,64: If Offset=128 Then Offset=0
  Next Ny
  Delete Image 1
  Blur Bitmap 1,1
  Get Image 2,0,0,512,512
 
  CLS RGB(96,96,96)
  Get Image 1,0,0,128,128
 
  CLS RGB(255,255,255)
  Ink 0,0
  Text 2,0,"EXIT"
  Get Image 3,0,0,Text Width("EXIT")+4,Text Height("X")+2
 
  Set Current Bitmap 0
  Delete Bitmap 1
  CLS
  Ink RGB(255,255,255),0
Return