the-maze/game.bas
File Type: text/x-c
#lang "fb"
#include "fbgfx.bi"
Using FB
Const MAX_ROOMS As Integer = 30
Const MAX_ROOM_ITEMS As Integer = 100
Const MAX_BOMBS As Integer = 10
Const MAX_ARROWS As Integer = 10
Const MAX_ENEMIES As Integer = 10
' Data structures
Enum Dir
None = 0
UpDir = 1
DownDir = 2
LeftDir = 3
RightDir = 4
End Enum
Type RoomData
items As Integer
data(1 To MAX_ROOM_ITEMS) As String
keysCollected As Boolean
diamondsCollected As Boolean
doorOpened As Boolean
saveState As Integer
End Type
Type Entity
x As Integer
y As Integer
dir As Integer
End Type
' Shared data (only rooms remain shared for now, as they are level data)
Dim Shared As RoomData rooms(1 To MAX_ROOMS)
'Game state structure which will be instantiated in the 'game' variable and shared around as needed.
Type GameState
playerX As Integer
playerY As Integer
playerDir As Dir
currentRoom As Integer
numKeys As Integer
numDiamonds As Integer
livesLeft As Integer
cycleCount As Integer
lastPlayerCycle As Integer
lastArrowCycle As Integer
lastBombCycle As Integer
lastEnemyCycle As Integer
lastDiamondCycle As Integer
saveRoom As Integer
saveX As Integer
saveY As Integer
saveDiamonds As Integer
numBombs As Integer
numArrows As Integer
numEnemies As Integer
bombs(1 To MAX_BOMBS) As Entity
arrows(1 To MAX_ARROWS) As Entity
enemies(1 To MAX_ENEMIES) As Entity
isDead As Boolean
savedDiamondsCollected(1 To MAX_ROOMS) As Boolean
EntityHurtPlayer As Boolean
levelFile As String
End Type
Declare Function LineofSight (ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer) As Boolean
Declare Sub Warp (ByRef x As Integer, ByRef y As Integer)
Declare Sub SetupScreen (ByRef game As GameState)
Declare Sub DrawWall (ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)
Declare Sub DrawBlock (ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)
Declare Sub DrawTile (ByVal y As Integer, ByVal x As Integer, ByVal tileId As Integer, ByVal fg As Integer = -1)
Declare Sub DrawTileAscii (ByVal y As Integer, ByVal x As Integer, ByVal tileId As Integer, ByVal fg As Integer)
Declare Sub DrawTileCustom (ByVal y As Integer, ByVal x As Integer, ByVal tileId As Integer, ByVal fg As Integer)
Declare Sub DrawText (ByVal y As Integer, ByVal x As Integer, ByVal text As String, ByVal fg As Integer)
Declare Function GetTile (ByVal y As Integer, ByVal x As Integer) As Integer
Declare Sub ClearTileMap ()
Declare Sub InitTileTable ()
Declare Function ShouldProcess (ByRef LastCycle As Integer, ByVal Cycle As Integer, ByVal NumCycles As Integer) As Boolean
Declare Sub ParseCommandLine ()
Declare Sub PrintUsage ()
Declare Sub LogConsole (ByVal msg As String)
Declare Sub InitVideo ()
Declare Sub ShutdownVideo ()
Declare Sub LoadLevel (ByRef game As GameState)
Declare Sub DrawRoom (ByRef game As GameState)
Declare Sub LoadNewLevel (ByRef game As GameState)
Declare Sub ChangeRoom (ByRef game As GameState, ByVal direction As Dir)
Declare Sub SaveCheckpoint (ByRef game As GameState)
Declare Sub HandlePlayerDeath (ByRef game As GameState)
Declare Sub CaptureCheckpoint (ByRef game As GameState)
Declare Sub RestoreCheckpoint (ByRef game As GameState)
Declare Sub ResetLevelState (ByRef game As GameState)
Declare Sub CollectDiamond (ByRef game As GameState)
Declare Sub CollectKey (ByRef game As GameState)
Declare Sub TryOpenDoor (ByRef game As GameState)
Declare Sub HandleWin (ByRef game As GameState)
Declare Sub LoseDiamond (ByRef game As GameState)
Declare Sub UpdateBombs (ByRef game As GameState)
Declare Sub UpdateArrows (ByRef game As GameState)
Declare Sub UpdateEnemies (ByRef game As GameState)
Declare Sub GameOver ()
Declare Sub KillEntity (ents() As Entity, ByVal p As Integer, ByRef n As Integer)
Declare Function WhichEntity (ents() As Entity, ByVal x As Integer, ByVal y As Integer, ByVal n As Integer) As Integer
' Constants
Const UP_KEY = &h48
Const DOWN_KEY = &h50
Const LEFT_KEY = &h4B
Const RIGHT_KEY = &h4D
Const FPS = 60.0
Const SLEEPTIME = 1000.0 / FPS
Const BOMBCYCLES = 3
Const ARROWCYCLES = 4
Const ENEMYCYCLES = 10
Const PLAYERCYCLES = 4
Const DIAMONDCYCLES = 20
Const DEADPAUSECYCLES = 80
Const WINPAUSECYCLES = 160
' Logical text grid (classic DOS layout preserved)
Const GRID_COLS As Integer = 80
Const GRID_PLAY_ROWS As Integer = 20
Const GRID_ROWS As Integer = 25
Const HUD_BORDER_ROW As Integer = 21
Const HUD_ROW1 As Integer = 22
Const HUD_ROW2 As Integer = 23
' Default fbgfx font cell size at the logical resolution. The render target
' is always LOGICAL_W x LOGICAL_H; --scale uses OpenGL 2D mode + SET_GL_SCALE
' so the OS window is larger without changing the framebuffer or text font.
Const CELL_W As Integer = 8
Const CELL_H As Integer = 16
Const LOGICAL_W As Integer = GRID_COLS * CELL_W ' 640
Const LOGICAL_H As Integer = GRID_ROWS * CELL_H ' 400
Const DEFAULT_SCALE As Integer = 2
Const MIN_SCALE As Integer = 1
Const MAX_SCALE As Integer = 6
' How playfield cells are painted (HUD always uses DrawText / ASCII).
Enum GraphicsMode
GFX_ASCII = 0 ' classic CP437 glyphs (default)
GFX_CUSTOM = 1 ' custom tile sprites (stub for now)
End Enum
' Video options (CLI + runtime after InitVideo)
Type VideoConfig
fullscreen As Boolean
scale As Integer
' True when the display is enlarged via OpenGL 2D + SET_GL_SCALE.
useGlScale As Boolean
graphics As GraphicsMode
End Type
Dim Shared As VideoConfig videoCfg
' Logical playfield map (rows 1..GRID_PLAY_ROWS). Stores TileId values.
' Source of truth for collision / LOS / warps. HUD is display-only.
Dim Shared As Integer tileMap(1 To GRID_PLAY_ROWS, 1 To GRID_COLS)
' CGA/EGA palette indices (used with 8-bpp ScreenRes)
Const COL_BLACK As Integer = 0
Const COL_BLUE As Integer = 1
Const COL_GREEN As Integer = 2
Const COL_CYAN As Integer = 3
Const COL_RED As Integer = 4
Const COL_MAGENTA As Integer = 5
Const COL_BROWN As Integer = 6
Const COL_LIGHT_GRAY As Integer = 7
Const COL_DARK_GRAY As Integer = 8
Const COL_LIGHT_BLUE As Integer = 9
Const COL_LIGHT_GREEN As Integer = 10
Const COL_LIGHT_CYAN As Integer = 11
Const COL_LIGHT_RED As Integer = 12
Const COL_LIGHT_MAGENTA As Integer = 13
Const COL_YELLOW As Integer = 14
Const COL_WHITE As Integer = 15
' Default playfield / HUD foreground
Const COL_DEFAULT As Integer = COL_LIGHT_GRAY
' Pass to DrawTile to use the tile table's default color (also the
' optional-parameter default).
Const COL_FROM_TILE As Integer = -1
' Non-tile ASCII / key codes (input + HUD chrome only)
Const CH_NULL As Integer = 0
Const CH_ESC As Integer = 27
Const CH_BORDER1 As Integer = 178
Const CH_BORDER2 As Integer = 177
Const CH_BORDER3 As Integer = 176
' Logical tile kinds stored in tileMap and compared by gameplay code.
Enum TileId
TILE_SPACE = 0
TILE_WALL
TILE_BLOCK
TILE_WARP
TILE_DIAMOND
TILE_KEY
TILE_DOOR
TILE_SAVE
TILE_WIN
TILE_ENEMY
TILE_BOMB
TILE_MINE
TILE_ARROW_L
TILE_ARROW_R
TILE_DEAD
TILE_PLAYER_UP
TILE_PLAYER_DOWN
TILE_PLAYER_LEFT
TILE_PLAYER_RIGHT
TILE_COUNT
End Enum
' Glyph + default color for each TileId (filled by InitTileTable).
Type TileDef
glyph As Integer
color As Integer
End Type
Dim Shared As TileDef tileDefs(0 To TILE_COUNT - 1)
' Player facing -> TileId
Dim Shared As Integer playerTiles(Dir.UpDir To Dir.RightDir)
Sub InitTileTable ()
' glyph is the CP437 code used for ASCII rendering; color is the default
' foreground for that tile kind (overridable via DrawTile's optional fg).
tileDefs(TILE_SPACE).glyph = 32: tileDefs(TILE_SPACE).color = COL_DEFAULT
tileDefs(TILE_WALL).glyph = 219: tileDefs(TILE_WALL).color = COL_DEFAULT
tileDefs(TILE_BLOCK).glyph = 177: tileDefs(TILE_BLOCK).color = COL_LIGHT_BLUE
tileDefs(TILE_WARP).glyph = 176: tileDefs(TILE_WARP).color = COL_LIGHT_RED
tileDefs(TILE_DIAMOND).glyph = 4: tileDefs(TILE_DIAMOND).color = COL_WHITE
tileDefs(TILE_KEY).glyph = 244: tileDefs(TILE_KEY).color = COL_YELLOW
tileDefs(TILE_DOOR).glyph = 35: tileDefs(TILE_DOOR).color = COL_BROWN
tileDefs(TILE_SAVE).glyph = 21: tileDefs(TILE_SAVE).color = COL_LIGHT_CYAN
tileDefs(TILE_WIN).glyph = 5: tileDefs(TILE_WIN).color = COL_LIGHT_MAGENTA
tileDefs(TILE_ENEMY).glyph = 234: tileDefs(TILE_ENEMY).color = COL_DEFAULT
tileDefs(TILE_BOMB).glyph = 127: tileDefs(TILE_BOMB).color = COL_LIGHT_MAGENTA
tileDefs(TILE_MINE).glyph = 233: tileDefs(TILE_MINE).color = COL_DEFAULT
tileDefs(TILE_ARROW_L).glyph = 16: tileDefs(TILE_ARROW_L).color = COL_GREEN
tileDefs(TILE_ARROW_R).glyph = 17: tileDefs(TILE_ARROW_R).color = COL_GREEN
tileDefs(TILE_DEAD).glyph = 88: tileDefs(TILE_DEAD).color = COL_RED
tileDefs(TILE_PLAYER_UP).glyph = 24: tileDefs(TILE_PLAYER_UP).color = COL_GREEN
tileDefs(TILE_PLAYER_DOWN).glyph = 25: tileDefs(TILE_PLAYER_DOWN).color = COL_GREEN
tileDefs(TILE_PLAYER_LEFT).glyph = 27: tileDefs(TILE_PLAYER_LEFT).color = COL_GREEN
tileDefs(TILE_PLAYER_RIGHT).glyph = 26: tileDefs(TILE_PLAYER_RIGHT).color = COL_GREEN
playerTiles(Dir.UpDir) = TILE_PLAYER_UP
playerTiles(Dir.DownDir) = TILE_PLAYER_DOWN
playerTiles(Dir.LeftDir) = TILE_PLAYER_LEFT
playerTiles(Dir.RightDir) = TILE_PLAYER_RIGHT
End Sub
Sub PrintUsage ()
Dim as String UsageText
UsageText = !"The Maze\n"
UsageText += !"Usage: game [options]\n"
UsageText += !"\n"
UsageText += !" --fullscreen, -f Run in fullscreen\n"
UsageText += !" --windowed, -w Run in a window (default)\n"
UsageText += !" --scale=N, -s N Pixel scale 1-" & MAX_SCALE & " (default " & DEFAULT_SCALE & !")\n"
UsageText += !" --ascii, -a ASCII playfield glyphs (default)\n"
UsageText += !" --tiles, -t Custom tile graphics (experimental)\n"
UsageText += !" --help, -h Show this help\n"
UsageText += !"\n"
UsageText += !"Logical grid remains " & GRID_COLS & "x" & GRID_ROWS & " text cells (" & LOGICAL_W & "x" & LOGICAL_H & !" px).\n"
UsageText += !"With --scale > 1 the window is enlarged via OpenGL (hardware); framebuffer stays " & LOGICAL_W & "x" & LOGICAL_H & !".\n"
UsageText += !"Playfield collision always uses the logical tile map; --ascii/--tiles only change how cells are drawn.\n"
LogConsole UsageText
End Sub
' Write a line to the process stdout. Bare Print goes to the graphics
' surface after ScreenRes; Open Cons keeps diagnostics on the real console.
Sub LogConsole (ByVal msg As String)
Dim As Integer fn = FreeFile
If Open Cons(For Output, As #fn) = 0 Then
Print #fn, msg
Close #fn
End If
End Sub
Sub ParseCommandLine ()
videoCfg.fullscreen = False
videoCfg.scale = DEFAULT_SCALE
videoCfg.graphics = GFX_ASCII
Dim As Integer i = 1
Do
Dim As String arg = Command(i)
If Len(arg) = 0 Then Exit Do
If arg = "--help" Or arg = "-h" Then
PrintUsage
End
ElseIf arg = "--fullscreen" Or arg = "-f" Then
videoCfg.fullscreen = True
ElseIf arg = "--windowed" Or arg = "-w" Then
videoCfg.fullscreen = False
ElseIf arg = "--ascii" Or arg = "-a" Then
videoCfg.graphics = GFX_ASCII
ElseIf arg = "--tiles" Or arg = "-t" Then
videoCfg.graphics = GFX_CUSTOM
ElseIf Left(arg, 8) = "--scale=" Then
videoCfg.scale = Val(Mid(arg, 9))
ElseIf arg = "--scale" Or arg = "-s" Then
i += 1
Dim As String scaleArg = Command(i)
If Len(scaleArg) = 0 Then
LogConsole "error: --scale requires a value"
End 1
End If
videoCfg.scale = Val(scaleArg)
Else
LogConsole "error: unknown option: " & arg & !"\nTry --help for usage."
End 1
End If
i += 1
Loop
If videoCfg.scale < MIN_SCALE Or videoCfg.scale > MAX_SCALE Then
LogConsole "error: scale must be between " & MIN_SCALE & " and " & MAX_SCALE
End 1
End If
End Sub
Sub InitVideo ()
' Always open the logical 640x400 surface. fbgfx picks an ~8x16 text font
' only when the window is near that size; a larger ScreenRes forces a
' smaller font and leaves most of the window blank.
'
' Enlargement uses OpenGL hardware scaling. Both controls must be set
' *before* ScreenRes with GFX_OPENGL:
' SET_GL_2D_MODE – without this, mode is OGL_2D_NONE: the software
' framebuffer is never uploaded to a GL texture, so
' the window stays black even though draws succeed.
' SET_GL_SCALE – multiplies the OS window size (e.g. 2 -> 1280x800).
' OGL_2D_AUTO_SYNC uploads + presents on the driver's normal refresh path,
' so Locate/Print keep working without an explicit Flip each frame.
Dim As Integer flags = FB.GFX_HIGH_PRIORITY Or FB.GFX_NO_SWITCH
videoCfg.useGlScale = False
If videoCfg.fullscreen Then
flags Or= FB.GFX_FULLSCREEN
End If
If videoCfg.scale > 1 Then
ScreenControl FB.SET_GL_2D_MODE, FB.OGL_2D_AUTO_SYNC
ScreenControl FB.SET_GL_SCALE, videoCfg.scale
ScreenRes LOGICAL_W, LOGICAL_H, 8, , flags Or FB.GFX_OPENGL
If ScreenPtr <> 0 Then
videoCfg.useGlScale = True
Else
' Reset so a later non-GL open is not affected.
ScreenControl FB.SET_GL_2D_MODE, FB.OGL_2D_NONE
ScreenControl FB.SET_GL_SCALE, 1
LogConsole "warning: OpenGL scale unavailable; running at --scale=1"
videoCfg.scale = 1
End If
End If
If ScreenPtr = 0 Then
ScreenRes LOGICAL_W, LOGICAL_H, 8, , flags
End If
If ScreenPtr = 0 Then
LogConsole "error: failed to open graphics mode (" & LOGICAL_W & "x" & LOGICAL_H & ")"
If videoCfg.fullscreen Then
LogConsole "Try without --fullscreen."
End If
End 1
End If
' 8-bit palette depth so Color 0-15 indices match classic CGA/EGA usage.
Width GRID_COLS, GRID_ROWS
WindowTitle "The Maze"
Color COL_DEFAULT, COL_BLACK
Cls
End Sub
Sub ShutdownVideo ()
' Nothing to free for the GL-scale path today; reserved for later resources.
End Sub
Sub InitializeGame(ByRef game As GameState)
Randomize Timer
game.playerX = 40
game.playerY = 10
game.playerDir = Dir.RightDir
game.numArrows = 0
game.numEnemies = 0
game.numBombs = 0
game.livesLeft = 4
game.currentRoom = 1
game.cycleCount = 0
game.lastPlayerCycle = 0
game.lastArrowCycle = 0
game.lastBombCycle = 0
game.lastEnemyCycle = 0
game.lastDiamondCycle = 0
game.isDead = False
game.EntityHurtPlayer = False
' Level progress, room flags, and checkpoint snapshot are handled
' by ResetLevelState (called from LoadLevel) + Capture after first draw.
InitTileTable
ParseCommandLine
InitVideo
If Open("game.ini" For Input As #1) <> 0 Then
LogConsole !"error: could not open game.ini\nRun from the build output directory (e.g. 'make run') so assets are on the path."
ShutdownVideo
End 1
End If
Input #1, game.levelFile
Close #1
LoadLevel game
SetupScreen game
DrawRoom game
CaptureCheckpoint game
End Sub
Sub RunGameLoop(ByRef game As GameState)
Dim As Integer oldX, oldY, moveDir
Dim As String keyBuf
Do
oldX = game.playerX
oldY = game.playerY
moveDir = Dir.None
keyBuf = InKey$
' Direction input (time-critical, using MultiKey)
If MultiKey(UP_KEY) Or keyBuf = Chr$(CH_NULL) + "H" Then
moveDir = Dir.UpDir
game.playerDir = Dir.UpDir
keyBuf = InKey$
ElseIf MultiKey(DOWN_KEY) Or keyBuf = Chr$(CH_NULL) + "P" Then
moveDir = Dir.DownDir
game.playerDir = Dir.DownDir
keyBuf = InKey$
ElseIf MultiKey(LEFT_KEY) Or keyBuf = Chr$(CH_NULL) + "K" Then
moveDir = Dir.LeftDir
game.playerDir = Dir.LeftDir
keyBuf = InKey$
ElseIf MultiKey(RIGHT_KEY) Or keyBuf = Chr$(CH_NULL) + "M" Then
moveDir = Dir.RightDir
game.playerDir = Dir.RightDir
keyBuf = InKey$
End If
' Non-movement keys
Select Case keyBuf
Case Chr$(CH_ESC)
System
Case "l", "L"
LoadNewLevel game
Case "e", "E"
Open "edit.ini" For Output As #1
Print #1, game.levelFile
Close #1
Shell "./edit"
Case " "
moveDir = Dir.None
End Select
' Player movement with timing
If ShouldProcess(game.lastPlayerCycle, game.cycleCount, PLAYERCYCLES) Then
Select Case moveDir
Case Dir.UpDir
game.playerY = game.playerY - 1
game.playerDir = Dir.UpDir
If game.playerY < 1 Then
ChangeRoom game, Dir.UpDir
oldX = game.playerX: oldY = game.playerY
End If
Case Dir.DownDir
game.playerY = game.playerY + 1
game.playerDir = Dir.DownDir
If game.playerY > GRID_PLAY_ROWS Then
ChangeRoom game, Dir.DownDir
oldX = game.playerX: oldY = game.playerY
End If
Case Dir.LeftDir
game.playerX = game.playerX - 1
game.playerDir = Dir.LeftDir
If game.playerX < 1 Then
ChangeRoom game, Dir.LeftDir
oldX = game.playerX: oldY = game.playerY
End If
Case Dir.RightDir
game.playerX = game.playerX + 1
game.playerDir = Dir.RightDir
If game.playerX > GRID_COLS Then
ChangeRoom game, Dir.RightDir
oldX = game.playerX: oldY = game.playerY
End If
End Select
End If
' Collision and item handling
Dim As Integer cell = GetTile(game.playerY, game.playerX)
Select Case cell
Case TILE_SAVE
SaveCheckpoint game
game.playerX = oldX: game.playerY = oldY
Case TILE_MINE
oldX = game.playerX: oldY = game.playerY
HandlePlayerDeath game
Case TILE_WARP
Warp game.playerX, game.playerY
Case TILE_DIAMOND
CollectDiamond game
Case TILE_DOOR
TryOpenDoor game
game.playerX = oldX: game.playerY = oldY
Case TILE_WIN
HandleWin game
Case TILE_KEY
CollectKey game
Case TILE_SPACE, TILE_DEAD, _
TILE_PLAYER_UP, TILE_PLAYER_DOWN, TILE_PLAYER_LEFT, TILE_PLAYER_RIGHT
' OK (empty, corpse, or self)
Case Else
game.playerX = oldX
game.playerY = oldY
End Select
' Reset the flag each frame; entity updates will set it if they step on the player.
game.EntityHurtPlayer = False
If game.numBombs > 0 AndAlso ShouldProcess(game.lastBombCycle, game.cycleCount, BOMBCYCLES) Then UpdateBombs game
If game.numArrows > 0 AndAlso ShouldProcess(game.lastArrowCycle, game.cycleCount, ARROWCYCLES) Then UpdateArrows game
If game.numEnemies > 0 AndAlso ShouldProcess(game.lastEnemyCycle, game.cycleCount, ENEMYCYCLES) Then UpdateEnemies game
If game.EntityHurtPlayer AndAlso ShouldProcess(game.lastDiamondCycle, game.cycleCount, DIAMONDCYCLES) Then LoseDiamond game
' Draw player
DrawTile game.playerY, game.playerX, playerTiles(game.playerDir)
If oldY <> game.playerY Or oldX <> game.playerX Then
DrawTile oldY, oldX, TILE_SPACE
End If
Sleep SLEEPTIME, 1
game.cycleCount = game.cycleCount + 1
Loop
End Sub
Sub ChangeRoom(ByRef game As GameState, ByVal direction As Dir)
Select Case direction
Case Dir.DownDir
game.currentRoom = game.currentRoom + 5
game.playerY = 1
Case Dir.UpDir
game.currentRoom = game.currentRoom - 5
game.playerY = GRID_PLAY_ROWS
Case Dir.RightDir
game.currentRoom = game.currentRoom + 1
game.playerX = 1
Case Dir.LeftDir
game.currentRoom = game.currentRoom - 1
game.playerX = GRID_COLS
End Select
SetupScreen game
DrawRoom game
End Sub
Sub DrawRoom(ByRef game As GameState)
' Draws room and populates entity arrays from room data
Dim As Integer t, x1, y1, x2, y2
Dim As String tempStr
game.numBombs = 0
game.numArrows = 0
game.numEnemies = 0
For t = 1 To rooms(game.currentRoom).items Step 2
Dim As String tempStr = rooms(game.currentRoom).data(t)
x1 = Val(Right$(tempStr, Len(tempStr) - 1))
y1 = Val(rooms(game.currentRoom).data(t + 1))
x2 = Val(rooms(game.currentRoom).data(t + 2))
y2 = Val(rooms(game.currentRoom).data(t + 3))
Select Case Left$(tempStr, 1)
Case "l" 'Walls
DrawWall(x1, y1, x2, y2)
Case "b" 'Blocks
DrawBlock(x1, y1, x2, y2)
Case "s" 'Spaces
DrawTile y1, x1, TILE_SPACE
Case "p" 'Point
DrawTile y1, x1, TILE_WALL
Case "w" 'Warp
DrawTile y1, x1, TILE_WARP
Case "c" 'Diamond
If Not rooms(game.currentRoom).diamondsCollected Then
DrawTile y1, x1, TILE_DIAMOND
End If
Case "k" 'Key
If Not rooms(game.currentRoom).keysCollected Then
DrawTile y1, x1, TILE_KEY
End If
Case "d" 'Door
If Not rooms(game.currentRoom).doorOpened Then
DrawTile y1, x1, TILE_DOOR
Else
DrawTile y1, x1, TILE_SPACE
End If
Case "e" 'Enemy
game.numEnemies = game.numEnemies + 1
game.enemies(game.numEnemies).x = x1
game.enemies(game.numEnemies).y = y1
DrawTile y1, x1, TILE_ENEMY
Case "v" 'Save point
DrawTile y1, x1, TILE_SAVE
Case "Q" 'Win marker
DrawTile y1, x1, TILE_WIN
Case "a" 'Arrow
game.numArrows = game.numArrows + 1
game.arrows(game.numArrows).x = x1
game.arrows(game.numArrows).y = y1
If GetTile(y1, x1 - 1) <> TILE_SPACE Then
DrawTile y1, x1, TILE_ARROW_L
game.arrows(game.numArrows).dir = 1
ElseIf GetTile(y1, x1 + 1) <> TILE_SPACE Then
DrawTile y1, x1, TILE_ARROW_R
game.arrows(game.numArrows).dir = -1
Else
DrawTile y1, x1, TILE_ARROW_R
game.arrows(game.numArrows).dir = (x1 >= GRID_COLS \ 2) - (x1 < GRID_COLS \ 2)
End If
Case "m" 'Bomb
game.numBombs = game.numBombs + 1
game.bombs(game.numBombs).x = x1
game.bombs(game.numBombs).y = y1
DrawTile y1, x1, TILE_BOMB
Case "n" 'Mine
DrawTile y1, x1, TILE_MINE
Case "o" 'Origin (player start) - only on initial load before first save
If game.saveRoom = 0 Then
game.playerX = x1
game.playerY = y1
End If
End Select
Next t
End Sub
Sub LoadNewLevel(ByRef game As GameState)
Cls
Color COL_WHITE, COL_BLACK
Dim As String newFile
Do
Input "Enter Filename for loading (8 characters or less): ", newFile
Sleep SLEEPTIME, 1
Loop While Len(newFile) < 1 Or Len(newFile) > 8
game.levelFile = newFile + ".dat"
Open "game.ini" For Output As #1
Print #1, game.levelFile
Close #1
LoadLevel game
' Start at the first room of the newly loaded level.
' ResetLevelState (called inside LoadLevel) has already zeroed
' progress and set saveRoom=0 so the origin marker in DrawRoom
' will place the player correctly.
game.currentRoom = 1
SetupScreen game
DrawRoom game
CaptureCheckpoint game
End Sub
Sub LoadLevel(ByRef game As GameState)
Dim As Integer i, j
Dim As String tempStr
If Open(game.levelFile For Input As #1) <> 0 Then
LogConsole "error: could not open level file: " & game.levelFile
LogConsole "Run from the directory that contains the .dat (e.g. 'make run'), or check game.ini."
ShutdownVideo
End 1
End If
For i = 1 To MAX_ROOMS
Input #1, tempStr
rooms(i).items = Val(tempStr)
For j = 1 To rooms(i).items
Input #1, rooms(i).data(j)
Next j
Next i
Close #1
ResetLevelState game
End Sub
Sub ResetLevelState (ByRef game As GameState)
' Reset all level-specific progress for a fresh start on a level file.
' This includes diamond/key counts, per-room collection/door state,
' and the continue-point snapshot. saveRoom=0 allows origin marker
' in DrawRoom to place the player on first draw.
game.numDiamonds = 0
game.numKeys = 0
game.saveRoom = 0
game.saveX = 0
game.saveY = 0
game.saveDiamonds = 0
For i As Integer = 1 To MAX_ROOMS
rooms(i).diamondsCollected = False
rooms(i).keysCollected = False
rooms(i).doorOpened = False
game.savedDiamondsCollected(i) = False
Next i
End Sub
Sub CaptureCheckpoint (ByRef game As GameState)
' Snapshot the current position, room, diamond count, and which
' diamonds have been collected. Used for both manual save points
' and the automatic initial checkpoint after loading a level.
game.saveRoom = game.currentRoom
game.saveX = game.playerX
game.saveY = game.playerY
game.saveDiamonds = game.numDiamonds
For i As Integer = 1 To MAX_ROOMS
game.savedDiamondsCollected(i) = rooms(i).diamondsCollected
Next i
End Sub
Sub RestoreCheckpoint (ByRef game As GameState)
' Restore player position/room and diamond progress from the last
' checkpoint. Keys and opened doors are intentionally left as-is
' (they are not rolled back on death).
game.numDiamonds = game.saveDiamonds
game.currentRoom = game.saveRoom
game.playerX = game.saveX
game.playerY = game.saveY
For i As Integer = 1 To MAX_ROOMS
rooms(i).diamondsCollected = game.savedDiamondsCollected(i)
Next i
End Sub
Sub SaveCheckpoint(ByRef game As GameState)
CaptureCheckpoint game
DrawText HUD_ROW2, 32, "*Continue Point*", COL_YELLOW
'Play "L64O2cdefg"
End Sub
Sub HandlePlayerDeath(ByRef game As GameState)
game.isDead = True
DrawTile game.playerY, game.playerX, TILE_DEAD
DrawText HUD_ROW1, 35, "You're Dead", COL_LIGHT_RED
'Play "l64O3cO2dO1eO0e"
Dim As Integer pauseStart = game.cycleCount
Do
Dim As String nul = InKey$
' During death we still animate entities; we don't care about EntityHurtPlayer here.
If game.numBombs > 0 AndAlso ShouldProcess(game.lastBombCycle, game.cycleCount, BOMBCYCLES) Then UpdateBombs game
If game.numArrows > 0 AndAlso ShouldProcess(game.lastArrowCycle, game.cycleCount, ARROWCYCLES) Then UpdateArrows game
If game.numEnemies > 0 AndAlso ShouldProcess(game.lastEnemyCycle, game.cycleCount, ENEMYCYCLES) Then UpdateEnemies game
Sleep SLEEPTIME, 1
game.cycleCount = game.cycleCount + 1
Loop While game.cycleCount - pauseStart < DEADPAUSECYCLES
game.livesLeft = game.livesLeft - 1
If game.livesLeft < 0 Then
GameOver()
Exit Sub
End If
' Restore from last checkpoint (only diamonds + pos/room; keys/doors persist)
RestoreCheckpoint game
game.isDead = False
game.EntityHurtPlayer = False
SetupScreen game
DrawRoom game
End Sub
Sub CollectDiamond(ByRef game As GameState)
rooms(game.currentRoom).diamondsCollected = True
game.numDiamonds = game.numDiamonds + 1
DrawText HUD_ROW1, 2, "Diamonds: " & game.numDiamonds, COL_WHITE
'Play "L64O3cfa"
End Sub
Sub CollectKey(ByRef game As GameState)
rooms(game.currentRoom).keysCollected = True
game.numKeys = game.numKeys + 1
DrawText HUD_ROW2, 60, "*Keys: " & game.numKeys & "*", COL_WHITE
'Play "l64O3cf"
End Sub
Sub TryOpenDoor(ByRef game As GameState)
If game.numKeys > 0 Then
game.numKeys = game.numKeys - 1
rooms(game.currentRoom).doorOpened = True
DrawText HUD_ROW2, 60, "Keys: " & game.numKeys, COL_WHITE
'Play "L64O0cfbO1e"
For i As Integer = 1 To GRID_COLS
For j As Integer = 1 To GRID_PLAY_ROWS
If GetTile(j, i) = TILE_DOOR Then DrawTile j, i, TILE_SPACE
Next j
Next i
Else
'Play "l64o0af"
End If
End Sub
Sub HandleWin(ByRef game As GameState)
Cls
DrawText 10, 36, "You Win!", COL_WHITE
DrawText 12, 29, "You got the treasure,", COL_WHITE
' Match classic Print spacing: number has a leading space
DrawText 13, 31, "plus " & game.numDiamonds & " diamonds.", COL_WHITE
Dim As Integer pauseStart = game.cycleCount
Do
Dim As String nul = InKey$
Sleep SLEEPTIME, 1
game.cycleCount = game.cycleCount + 1
Loop While game.cycleCount - pauseStart < WINPAUSECYCLES
Sleep 6
System
End Sub
Sub LoseDiamond(ByRef game As GameState)
game.numDiamonds = game.numDiamonds - 1
If game.numDiamonds < 0 Then
game.numDiamonds = 0
HandlePlayerDeath game
Exit Sub
End If
DrawText HUD_ROW1, 2, "Diamonds: " & game.numDiamonds, COL_WHITE
'Play "L64O2BBAG"
End Sub
Sub UpdateBombs(ByRef game As GameState)
Dim As Integer entityIndex = 1, entityOldX, entityOldY, whichEntityToKill
Do
entityOldY = game.bombs(entityIndex).y: entityOldX = game.bombs(entityIndex).x
If (game.playerX = game.bombs(entityIndex).x) AndAlso Not game.isDead Then
game.bombs(entityIndex).y = game.bombs(entityIndex).y + 1
Else
game.bombs(entityIndex).y = game.bombs(entityIndex).y - 1
End If
If game.bombs(entityIndex).y < 1 Or game.bombs(entityIndex).y > GRID_PLAY_ROWS Then game.bombs(entityIndex).y = entityOldY
If GetTile(game.bombs(entityIndex).y, game.bombs(entityIndex).x) = TILE_MINE Then
KillEntity game.bombs(), entityIndex, game.numBombs
DrawTile entityOldY, entityOldX, TILE_SPACE
Else
If game.bombs(entityIndex).x = game.playerX AndAlso game.bombs(entityIndex).y = game.playerY Then
If Not game.isDead Then game.EntityHurtPlayer = True
End If
' Warp may move the entity; re-read the cell after for the checks below.
If GetTile(game.bombs(entityIndex).y, game.bombs(entityIndex).x) = TILE_WARP Then Warp(game.bombs(entityIndex).x, game.bombs(entityIndex).y)
If GetTile(game.bombs(entityIndex).y, game.bombs(entityIndex).x) = TILE_ENEMY Then
whichEntityToKill = WhichEntity(game.enemies(), game.bombs(entityIndex).x, game.bombs(entityIndex).y, game.numEnemies)
If whichEntityToKill > 0 Then KillEntity game.enemies(), whichEntityToKill, game.numEnemies
End If
If GetTile(game.bombs(entityIndex).y, game.bombs(entityIndex).x) = TILE_ARROW_L Or GetTile(game.bombs(entityIndex).y, game.bombs(entityIndex).x) = TILE_ARROW_R Then
whichEntityToKill = WhichEntity(game.arrows(), game.bombs(entityIndex).x, game.bombs(entityIndex).y, game.numArrows)
If whichEntityToKill > 0 Then KillEntity game.arrows(), whichEntityToKill, game.numArrows
End If
If GetTile(game.bombs(entityIndex).y, game.bombs(entityIndex).x) <> TILE_SPACE And GetTile(game.bombs(entityIndex).y, game.bombs(entityIndex).x) <> TILE_DEAD Then game.bombs(entityIndex).y = entityOldY
DrawTile game.bombs(entityIndex).y, game.bombs(entityIndex).x, TILE_BOMB
If entityOldY <> game.bombs(entityIndex).y Or entityOldX <> game.bombs(entityIndex).x Then
DrawTile entityOldY, entityOldX, TILE_SPACE
End If
End If
entityIndex = entityIndex + 1
Loop While entityIndex <= game.numBombs
End Sub
Sub UpdateArrows(ByRef game As GameState)
Dim As Integer entityIndex = 1, entityOldX, entityOldY, whichEntityToKill
Do
entityOldY = game.arrows(entityIndex).y: entityOldX = game.arrows(entityIndex).x
If (game.playerY = game.arrows(entityIndex).y) AndAlso Not game.isDead Then
game.arrows(entityIndex).x = game.arrows(entityIndex).x + game.arrows(entityIndex).dir
Else
game.arrows(entityIndex).x = game.arrows(entityIndex).x - game.arrows(entityIndex).dir
End If
If game.arrows(entityIndex).x < 1 Or game.arrows(entityIndex).x > GRID_COLS Then game.arrows(entityIndex).x = entityOldX
If GetTile(game.arrows(entityIndex).y, game.arrows(entityIndex).x) = TILE_MINE Then
KillEntity game.arrows(), entityIndex, game.numArrows
DrawTile entityOldY, entityOldX, TILE_SPACE
Else
If game.arrows(entityIndex).x = game.playerX AndAlso game.arrows(entityIndex).y = game.playerY Then
If Not game.isDead Then game.EntityHurtPlayer = True
End If
If GetTile(game.arrows(entityIndex).y, game.arrows(entityIndex).x) = TILE_WARP Then Warp(game.arrows(entityIndex).x, game.arrows(entityIndex).y)
If GetTile(game.arrows(entityIndex).y, game.arrows(entityIndex).x) = TILE_ENEMY Then
whichEntityToKill = WhichEntity(game.enemies(), game.arrows(entityIndex).x, game.arrows(entityIndex).y, game.numEnemies)
If whichEntityToKill > 0 Then KillEntity game.enemies(), whichEntityToKill, game.numEnemies
End If
If GetTile(game.arrows(entityIndex).y, game.arrows(entityIndex).x) = TILE_BOMB Then
whichEntityToKill = WhichEntity(game.bombs(), game.arrows(entityIndex).x, game.arrows(entityIndex).y, game.numBombs)
If whichEntityToKill > 0 Then KillEntity game.bombs(), whichEntityToKill, game.numBombs
End If
If GetTile(game.arrows(entityIndex).y, game.arrows(entityIndex).x) <> TILE_DEAD Then
If GetTile(game.arrows(entityIndex).y, game.arrows(entityIndex).x) <> TILE_SPACE Then game.arrows(entityIndex).x = entityOldX
End If
If game.arrows(entityIndex).dir = 1 Then
DrawTile game.arrows(entityIndex).y, game.arrows(entityIndex).x, TILE_ARROW_L
Else
DrawTile game.arrows(entityIndex).y, game.arrows(entityIndex).x, TILE_ARROW_R
End If
If entityOldX <> game.arrows(entityIndex).x Or entityOldY <> game.arrows(entityIndex).y Then
DrawTile entityOldY, entityOldX, TILE_SPACE
End If
End If
entityIndex = entityIndex + 1
Loop While entityIndex <= game.numArrows
End Sub
Sub UpdateEnemies(ByRef game As GameState)
Dim As Integer entityIndex = 1, entityOldX, entityOldY, whichEntityToKill
Dim As Boolean seen
Do
entityOldX = game.enemies(entityIndex).x: entityOldY = game.enemies(entityIndex).y
seen = LineofSight(game.playerX, game.playerY, game.enemies(entityIndex).x, game.enemies(entityIndex).y)
If seen AndAlso Not game.isDead Then
If Rnd(1) > .2 Then
If Abs(game.enemies(entityIndex).x - game.playerX) >= Abs(game.enemies(entityIndex).y - game.playerY) Then
game.enemies(entityIndex).x = game.enemies(entityIndex).x + Sgn(game.playerX - game.enemies(entityIndex).x)
Else
game.enemies(entityIndex).y = game.enemies(entityIndex).y + Sgn(game.playerY - game.enemies(entityIndex).y)
End If
Else
If Abs(game.enemies(entityIndex).x - game.playerX) >= Abs(game.enemies(entityIndex).y - game.playerY) Then
game.enemies(entityIndex).y = game.enemies(entityIndex).y + Int(Cos(Timer Mod 180 * 3.14 * 2 + entityIndex) + .5)
Else
game.enemies(entityIndex).x = game.enemies(entityIndex).x + Int(Cos(Timer Mod 180 * 3.14 * 2 + entityIndex) + .5)
End If
End If
Else
If Rnd(1) > .5 Then
game.enemies(entityIndex).y = game.enemies(entityIndex).y + Int(Sin(Timer Mod 180 * 3.14 * 2 + entityIndex) + .5) * ((entityIndex Mod 2) - .5) * 2
Else
game.enemies(entityIndex).x = game.enemies(entityIndex).x + Int(Cos(Timer Mod 180 * 3.14 * 2 + entityIndex) + .5)
End If
End If
If game.enemies(entityIndex).y < 1 Or game.enemies(entityIndex).y > GRID_PLAY_ROWS Then game.enemies(entityIndex).y = entityOldY
If game.enemies(entityIndex).x < 1 Or game.enemies(entityIndex).x > GRID_COLS Then game.enemies(entityIndex).x = entityOldX
If GetTile(game.enemies(entityIndex).y, game.enemies(entityIndex).x) = TILE_MINE Then
KillEntity game.enemies(), entityIndex, game.numEnemies
DrawTile entityOldY, entityOldX, TILE_SPACE
Else
If GetTile(game.enemies(entityIndex).y, game.enemies(entityIndex).x) = TILE_WARP Then Warp game.enemies(entityIndex).x, game.enemies(entityIndex).y
If game.enemies(entityIndex).x = game.playerX AndAlso game.enemies(entityIndex).y = game.playerY Then
If Not game.isDead Then game.EntityHurtPlayer = True
End If
If GetTile(game.enemies(entityIndex).y, game.enemies(entityIndex).x) <> TILE_SPACE Then
game.enemies(entityIndex).x = entityOldX: game.enemies(entityIndex).y = entityOldY
Else
DrawTile entityOldY, entityOldX, TILE_SPACE
' Original palette shift: base green/cyan, +5 for later enemies
DrawTile game.enemies(entityIndex).y, game.enemies(entityIndex).x, TILE_ENEMY, _
entityIndex + COL_GREEN + (5 * (entityIndex > 5))
End If
End If
entityIndex = entityIndex + 1
Loop While entityIndex <= game.numEnemies
End Sub
Sub GameOver()
Dim As Integer t
For t = 1 To GRID_COLS
Dim As String nul = InKey$
Next t
DrawText 11, 32, "G A M E O V E R", COL_RED
Sleep 2
DrawText 10, 31, "Play again? (Y/N)", COL_WHITE
Dim As String a
Do
a = InKey$
Sleep SLEEPTIME, 1
Loop Until a = "n" Or a = "N" Or a = Chr$(CH_ESC) Or a = "y" Or a = "Y"
System
End Sub
Sub SetupScreen (ByRef game As GameState)
Dim As Integer t
Color COL_DEFAULT, COL_BLACK
Cls
ClearTileMap
' HUD chrome is display-only (DrawText); it never touches tileMap.
For t = 1 To GRID_COLS
DrawText HUD_BORDER_ROW, t, Chr$(CH_BORDER1), COL_DEFAULT
DrawText HUD_BORDER_ROW + 1, t, Chr$(CH_BORDER2), COL_DEFAULT
DrawText HUD_BORDER_ROW + 2, t, Chr$(CH_BORDER3), COL_DEFAULT
Next t
DrawText HUD_ROW1, 36, "The Maze", COL_WHITE
DrawText HUD_ROW1, 2, "Diamonds: " & game.numDiamonds, COL_WHITE
DrawText HUD_ROW1, 60, "Room: " & game.currentRoom, COL_WHITE
DrawText HUD_ROW2, 60, "Keys: " & game.numKeys, COL_WHITE
DrawText HUD_ROW2, 2, "Tries: " & game.livesLeft, COL_WHITE
End Sub
Sub DrawBlock (ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)
Dim As Integer t, r
For t = 0 To y2 - y1
For r = 0 To x2 - x1
DrawTile y1 + t, x1 + r, TILE_BLOCK
Next r
Next t
End Sub
Sub DrawWall (ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)
Dim As Integer dy, dx, yc, xc
Dim As Single dd, tc
dy = y2 - y1: dx = x2 - x1: yc = y2: xc = x2
If dx = 0 Then
For yc = y2 To y1 Step Sgn(-dy)
If yc > 0 And yc <= GRID_PLAY_ROWS And xc > 0 And xc <= GRID_COLS Then
DrawTile yc, xc, TILE_WALL
End If
Next yc
Else
dd = dy / dx
For xc = x2 To x1 Step Sgn(-dx)
tc = Int(dd * (xc - x2) + y2)
Do While tc <> yc
yc = yc + Sgn(-dy)
If yc > 0 And yc <= GRID_PLAY_ROWS And xc > 0 And xc <= GRID_COLS Then
DrawTile yc, xc, TILE_WALL
End If
Loop
If yc > 0 And yc <= GRID_PLAY_ROWS And xc > 0 And xc <= GRID_COLS Then
DrawTile yc, xc, TILE_WALL
End If
Next xc
End If
End Sub
' Playfield write: stores TileId in the logical map, then paints via the
' selected graphics mode. fg defaults to COL_FROM_TILE (-1) for the table
' color; pass an explicit palette index to override (e.g. enemy palette shift).
Sub DrawTile (ByVal y As Integer, ByVal x As Integer, ByVal tileId As Integer, ByVal fg As Integer = -1)
If y < 1 Or y > GRID_PLAY_ROWS Or x < 1 Or x > GRID_COLS Then Exit Sub
If tileId < 0 Or tileId >= TILE_COUNT Then tileId = TILE_SPACE
tileMap(y, x) = tileId
Dim As Integer drawColor = fg
If drawColor = COL_FROM_TILE Then
drawColor = tileDefs(tileId).color
End If
Select Case videoCfg.graphics
Case GFX_CUSTOM
DrawTileCustom y, x, tileId, drawColor
Case Else
DrawTileAscii y, x, tileId, drawColor
End Select
End Sub
' Classic CP437 glyph at the cell's text location.
Sub DrawTileAscii (ByVal y As Integer, ByVal x As Integer, ByVal tileId As Integer, ByVal fg As Integer)
Color fg
Locate y, x
Print Chr$(tileDefs(tileId).glyph);
End Sub
' Custom sprite path. Not implemented yet: fall back to ASCII so --tiles is
' safe to enable while art is developed. Replace this body with Put/BLoad
' (or similar) once a tileset exists; keep tileMap updates in DrawTile only.
Sub DrawTileCustom (ByVal y As Integer, ByVal x As Integer, ByVal tileId As Integer, ByVal fg As Integer)
DrawTileAscii y, x, tileId, fg
End Sub
' Display-only text (HUD, menus, messages). Does not touch tileMap.
Sub DrawText (ByVal y As Integer, ByVal x As Integer, ByVal text As String, ByVal fg As Integer)
Color fg
Locate y, x
Print text;
End Sub
' Logical TileId for collision / LOS / warps / door scans.
' Out-of-bounds reads return TILE_SPACE so callers can treat edges as empty.
Function GetTile (ByVal y As Integer, ByVal x As Integer) As Integer
If y < 1 Or y > GRID_PLAY_ROWS Or x < 1 Or x > GRID_COLS Then
GetTile = TILE_SPACE
Exit Function
End If
GetTile = tileMap(y, x)
End Function
Sub ClearTileMap ()
Dim As Integer y, x
For y = 1 To GRID_PLAY_ROWS
For x = 1 To GRID_COLS
tileMap(y, x) = TILE_SPACE
Next x
Next y
End Sub
Sub KillEntity (ents() As Entity, ByVal p As Integer, ByRef n As Integer)
DrawTile ents(p).y, ents(p).x, TILE_DEAD
n = n - 1
For i As Integer = p To n
If i < MAX_BOMBS Then
ents(i) = ents(i + 1)
End If
Next
End Sub
Function LineofSight (ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer) As Boolean
Dim As Integer dy, dx, yc, xc
Dim As Single dd, tc
dy = y2 - y1: dx = x2 - x1: yc = y2: xc = x2
LineofSight = True
If dx = 0 And dy = 0 Then Exit Function
If dx = 0 Then
For yc = y2 To y1 Step Sgn(-dy)
If yc > 0 And yc <= GRID_PLAY_ROWS And xc > 0 And xc <= GRID_COLS Then
If GetTile(yc, xc) <> TILE_SPACE And Not ((yc = y1 And xc = x1) Or (yc = y2 And xc = x2)) Then LineofSight = False
End If
Next yc
Else
dd = dy / dx
For xc = x2 To x1 Step Sgn(-dx)
tc = Int(dd * (xc - x2) + y2 + .5)
Do While tc <> yc
yc = yc + Sgn(-dy)
If yc > 0 And yc <= GRID_PLAY_ROWS And xc > 0 And xc <= GRID_COLS Then
If GetTile(yc, xc) <> TILE_SPACE And Not ((yc = y1 And xc = x1) Or (yc = y2 And xc = x2)) Then LineofSight = False
End If
Loop
If yc > 0 And yc <= GRID_PLAY_ROWS And xc > 0 And xc <= GRID_COLS Then
If GetTile(yc, xc) <> TILE_SPACE And Not ((yc = y1 And xc = x1) Or (yc = y2 And xc = x2)) Then LineofSight = False
End If
Next xc
End If
End Function
Sub Warp (ByRef x As Integer, ByRef y As Integer)
Do
x = Int(Rnd(1) * GRID_COLS) + 1
y = Int(Rnd(1) * GRID_PLAY_ROWS) + 1
Loop While GetTile(y, x) <> TILE_SPACE
End Sub
Function WhichEntity (ents() As Entity, ByVal x As Integer, ByVal y As Integer, ByVal n As Integer) As Integer
For i As Integer = 1 To n
If ents(i).x = x And ents(i).y = y Then WhichEntity = i
Next
End Function
Function ShouldProcess (ByRef LastCycle As Integer, ByVal Cycle As Integer, ByVal NumCycles As Integer) As Boolean
If Cycle - LastCycle >= NumCycles Then
ShouldProcess = True
LastCycle = Cycle
Else
ShouldProcess = False
End If
End Function
' ==================== Program entry point ====================
Dim As GameState game
InitializeGame game
RunGameLoop game
ShutdownVideo