the-maze/game.bas
File Type: text/x-c
#lang "fb"
#include "fbgfx.bi"
#include "GL/gl.bi"
Using FB
Const MAX_ROOMS As Integer = 30
Const WORLD_WIDTH_IN_ROOMS As Integer = 5
Const MAX_ROOM_ITEMS As Integer = 100
Const MAX_BOMBS As Integer = 10
Const MAX_ARROWS As Integer = 10
Const MAX_MONSTERS 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
End Type
Type Entity
x As Integer
y As Integer
dir As Integer
End Type
' Constants
Const DEFAULT_WORLDFILE = "themaze.dat"
Const DEFAULT_TILEFILE = "tiles.til"
Const FPS = 60.0
Const SLEEPTIME = 1000.0 / FPS
Const BOMBCYCLES = 3
Const ARROWCYCLES = 4
Const MONSTERCYCLES = 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
' 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_MONSTER
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
Enum GraphicsMode
GFX_ASCII = 0 ' classic CP437 glyphs
GFX_CUSTOM = 1 ' custom tile sprites (default)
End Enum
' Glyph + default color for each TileId (filled by InitTileTable).
' img is an optional FB image buffer for GFX_CUSTOM (created after ScreenRes).
Type TileDef
glyph As Integer
color As Integer
img As Any Ptr
End Type
Type GameConfig
fullscreen As Boolean
scale As Integer
useGlScale As Boolean
graphics As GraphicsMode
depth As Integer
tileFile As String
worldFile As String
tileDefs(0 To TILE_COUNT - 1) As TileDef
rooms(1 To MAX_ROOMS) As RoomData
End Type
Dim Shared As GameConfig config
'Game state structure which will be instantiated in the 'game' variable and shared around as needed.
Type GameState
playerX As Integer
playerY As Integer
currentRoom As Integer
numKeys As Integer
numDiamonds As Integer
livesLeft As Integer
cycleCount As Integer
lastPlayerCycle As Integer
lastArrowCycle As Integer
lastBombCycle As Integer
lastMonsterCycle As Integer
lastDiamondCycle As Integer
saveRoom As Integer
saveX As Integer
saveY As Integer
saveDiamonds As Integer
numBombs As Integer
numArrows As Integer
numMonsters As Integer
bombs(1 To MAX_BOMBS) As Entity
arrows(1 To MAX_ARROWS) As Entity
monsters(1 To MAX_MONSTERS) As Entity
isDead As Boolean
savedDiamondsCollected(1 To MAX_ROOMS) As Boolean
entityHurtPlayer As Boolean
tileMap(1 To GRID_PLAY_ROWS, 1 To GRID_COLS) As Integer
End Type
' 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
Declare Function LineofSight (tileMap(Any, Any) as Integer, ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer) As Boolean
Declare Sub Warp (tileMap(Any, Any) as Integer, ByRef x As Integer, ByRef y As Integer)
Declare Sub SetupScreen (ByRef game As GameState)
Declare Sub DrawWall (tileMap(Any, Any) as Integer, ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)
Declare Sub DrawBlock (tileMap(Any, Any) as Integer, ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)
Declare Sub DrawTile (tileMap(Any, Any) as Integer, 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 (tileMap(Any, Any) as Integer, ByVal y As Integer, ByVal x As Integer) As Integer
Declare Sub ClearTileMap (tileMap(Any, Any) as Integer)
Declare Sub InitTileTable ()
Declare Sub LoadTileGraphics ()
Declare Sub FreeTileGraphics ()
Declare Function PaletteRgb (ByVal index As Integer) As ULong
Declare Function DimRgb (ByVal pix As ULong) As ULong
Declare Function ParseColorToken (ByVal token As String) As Integer
Declare Function TileIdFromName (ByVal tileName As String) As Integer
Declare Function LoadTileFile (ByVal path As String) As Boolean
Declare Sub BuildPlaceholderTile (ByVal tileId As Integer)
Declare Sub SetColor (ByVal fg As Integer, ByVal bg As Integer = -1)
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 InitAudio ()
Declare Sub ShutdownAudio ()
Declare Sub Play (ByVal cmd As String)
Declare Sub LoadLevel (ByRef game As GameState)
Declare Sub DrawRoom (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 UpdateMonsters (ByRef game As GameState)
Declare Sub GameOver ()
Declare Sub KillEntity (tileMap(Any, Any) as Integer, 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
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).
' img is filled later by LoadTileGraphics when using GFX_CUSTOM.
Dim As Integer i
For i = 0 To TILE_COUNT - 1
config.tileDefs(i).img = 0
Next i
config.tileDefs(TILE_SPACE).glyph = 32: config.tileDefs(TILE_SPACE).color = COL_DEFAULT
config.tileDefs(TILE_WALL).glyph = 219: config.tileDefs(TILE_WALL).color = COL_DEFAULT
config.tileDefs(TILE_BLOCK).glyph = 177: config.tileDefs(TILE_BLOCK).color = COL_LIGHT_BLUE
config.tileDefs(TILE_WARP).glyph = 176: config.tileDefs(TILE_WARP).color = COL_LIGHT_RED
config.tileDefs(TILE_DIAMOND).glyph = 4: config.tileDefs(TILE_DIAMOND).color = COL_WHITE
config.tileDefs(TILE_KEY).glyph = 244: config.tileDefs(TILE_KEY).color = COL_YELLOW
config.tileDefs(TILE_DOOR).glyph = 35: config.tileDefs(TILE_DOOR).color = COL_BROWN
config.tileDefs(TILE_SAVE).glyph = 21: config.tileDefs(TILE_SAVE).color = COL_LIGHT_CYAN
config.tileDefs(TILE_WIN).glyph = 5: config.tileDefs(TILE_WIN).color = COL_LIGHT_MAGENTA
config.tileDefs(TILE_MONSTER).glyph = 234: config.tileDefs(TILE_MONSTER).color = COL_DEFAULT
config.tileDefs(TILE_BOMB).glyph = 127: config.tileDefs(TILE_BOMB).color = COL_LIGHT_MAGENTA
config.tileDefs(TILE_MINE).glyph = 233: config.tileDefs(TILE_MINE).color = COL_DEFAULT
config.tileDefs(TILE_ARROW_L).glyph = 16: config.tileDefs(TILE_ARROW_L).color = COL_GREEN
config.tileDefs(TILE_ARROW_R).glyph = 17: config.tileDefs(TILE_ARROW_R).color = COL_GREEN
config.tileDefs(TILE_DEAD).glyph = 88: config.tileDefs(TILE_DEAD).color = COL_RED
config.tileDefs(TILE_PLAYER_UP).glyph = 24: config.tileDefs(TILE_PLAYER_UP).color = COL_GREEN
config.tileDefs(TILE_PLAYER_DOWN).glyph = 25: config.tileDefs(TILE_PLAYER_DOWN).color = COL_GREEN
config.tileDefs(TILE_PLAYER_LEFT).glyph = 27: config.tileDefs(TILE_PLAYER_LEFT).color = COL_GREEN
config.tileDefs(TILE_PLAYER_RIGHT).glyph = 26: config.tileDefs(TILE_PLAYER_RIGHT).color = COL_GREEN
End Sub
' Classic CGA/EGA RGB values for COL_* indices (needed at 32 bpp).
Function PaletteRgb (ByVal index As Integer) As ULong
Dim As ULong table(0 To 15) = { _
RGB(0, 0, 0), RGB(0, 0, 170), RGB(0, 170, 0), RGB(0, 170, 170), _
RGB(170, 0, 0), RGB(170, 0, 170), RGB(170, 85, 0), RGB(170, 170, 170), _
RGB(85, 85, 85), RGB(85, 85, 255), RGB(85, 255, 85), RGB(85, 255, 255), _
RGB(255, 85, 85), RGB(255, 85, 255), RGB(255, 255, 85), RGB(255, 255, 255) }
If index < 0 Or index > 15 Then
PaletteRgb = table(7)
Else
PaletteRgb = table(index)
End If
End Function
' Color that works for both 8 bpp palette indices and 32 bpp RGB.
Sub SetColor (ByVal fg As Integer, ByVal bg As Integer = -1)
If config.depth <= 8 Then
If bg < 0 Then
Color fg
Else
Color fg, bg
End If
Else
If bg < 0 Then
Color PaletteRgb(fg)
Else
Color PaletteRgb(fg), PaletteRgb(bg)
End If
End If
End Sub
' Half-bright colour for '+' pixels (dimmed primary).
Function DimRgb (ByVal pix As ULong) As ULong
Dim As Integer r = (pix Shr 16) And 255
Dim As Integer g = (pix Shr 8) And 255
Dim As Integer b = pix And 255
DimRgb = RGB(r \ 2, g \ 2, b \ 2)
End Function
' Parse "7" or a CGA name ("yellow") into a 0..15 index. -1 on failure.
Function ParseColorToken (ByVal token As String) As Integer
Dim As String t = LCase(Trim(token))
Dim As Integer result = -1
Dim As Integer n
Dim As String c0
If Len(t) = 0 Then
ParseColorToken = -1
Exit Function
End If
Select Case t
Case "black"
result = COL_BLACK
Case "blue"
result = COL_BLUE
Case "green"
result = COL_GREEN
Case "cyan"
result = COL_CYAN
Case "red"
result = COL_RED
Case "magenta"
result = COL_MAGENTA
Case "brown"
result = COL_BROWN
Case "light_gray", "light_grey", "lightgray", "lightgrey", "gray", "grey"
result = COL_LIGHT_GRAY
Case "dark_gray", "dark_grey", "darkgray", "darkgrey"
result = COL_DARK_GRAY
Case "light_blue", "lightblue"
result = COL_LIGHT_BLUE
Case "light_green", "lightgreen"
result = COL_LIGHT_GREEN
Case "light_cyan", "lightcyan"
result = COL_LIGHT_CYAN
Case "light_red", "lightred"
result = COL_LIGHT_RED
Case "light_magenta", "lightmagenta"
result = COL_LIGHT_MAGENTA
Case "yellow"
result = COL_YELLOW
Case "white"
result = COL_WHITE
Case Else
n = Val(t)
c0 = Left(t, 1)
If n >= 0 And n <= 15 And c0 >= "0" And c0 <= "9" Then
result = n
End If
End Select
ParseColorToken = result
End Function
Function TileIdFromName (ByVal tileName As String) As Integer
Dim As String n = LCase(Trim(tileName))
Dim As Integer result = -1
Select Case n
Case "space", "empty"
result = TILE_SPACE
Case "wall"
result = TILE_WALL
Case "block"
result = TILE_BLOCK
Case "warp"
result = TILE_WARP
Case "diamond"
result = TILE_DIAMOND
Case "key"
result = TILE_KEY
Case "door"
result = TILE_DOOR
Case "save", "checkpoint"
result = TILE_SAVE
Case "win", "treasure", "goal"
result = TILE_WIN
Case "monster", "enemy"
result = TILE_MONSTER
Case "bomb"
result = TILE_BOMB
Case "mine"
result = TILE_MINE
Case "arrow_l", "arrow_left", "arrowl"
result = TILE_ARROW_L
Case "arrow_r", "arrow_right", "arrowr"
result = TILE_ARROW_R
Case "dead", "corpse"
result = TILE_DEAD
Case "player_up", "playerup"
result = TILE_PLAYER_UP
Case "player_down", "playerdown"
result = TILE_PLAYER_DOWN
Case "player_left", "playerleft"
result = TILE_PLAYER_LEFT
Case "player_right", "playerright", "player"
result = TILE_PLAYER_RIGHT
End Select
TileIdFromName = result
End Function
Sub BuildPlaceholderTile (ByVal tileId As Integer)
Dim As ULong fill = PaletteRgb(config.tileDefs(tileId).color)
Dim As ULong edge = PaletteRgb(COL_WHITE)
If tileId = TILE_SPACE Then
config.tileDefs(tileId).img = ImageCreate(CELL_W, CELL_H, PaletteRgb(COL_BLACK), 32)
Else
config.tileDefs(tileId).img = ImageCreate(CELL_W, CELL_H, fill, 32)
If config.tileDefs(tileId).img <> 0 Then
Line config.tileDefs(tileId).img, (0, 0)-(CELL_W - 1, CELL_H - 1), edge, B
Line config.tileDefs(tileId).img, (1, 1)-(CELL_W - 2, CELL_H - 2), fill, BF
End If
End If
End Sub
' Load INI-style .til text and bake 8x16 images. Returns True on success.
' Format:
' [palette] 0=color ... 9=color (CGA index or name)
' [wall] color=N then 16 lines of 8 chars: # + . 0-9
Function LoadTileFile (ByVal path As String) As Boolean
Dim As Integer fn = FreeFile
If Open(path For Input As #fn) <> 0 Then
LoadTileFile = False
Exit Function
End If
' Global accent palette as RGB (defaults: CGA 0..9).
Dim As ULong palRgb(0 To 9)
Dim As Integer pi
For pi = 0 To 9
palRgb(pi) = PaletteRgb(pi)
Next pi
' Per-tile pixel grid and flags gathered while parsing.
Dim As Integer pixels(0 To TILE_COUNT - 1, 0 To CELL_H - 1, 0 To CELL_W - 1)
Dim As Boolean hasPixels(0 To TILE_COUNT - 1)
Dim As Integer primaryOf(0 To TILE_COUNT - 1)
Dim As Integer rowOf(0 To TILE_COUNT - 1)
Dim As Integer tid, x, y, i, eq, idx, cval
Dim As String rawLine, section, keyName, valueStr, ch
Dim As String trimmed
Dim As Integer cur = -1
Dim As Boolean inPalette = False
Dim As Any Ptr img
Dim As ULong primary, dimmed, black, pix
Dim As Integer code
Dim As String c0
For i = 0 To TILE_COUNT - 1
hasPixels(i) = False
primaryOf(i) = config.tileDefs(i).color
rowOf(i) = 0
For y = 0 To CELL_H - 1
For x = 0 To CELL_W - 1
pixels(i, y, x) = 0
Next x
Next y
Next i
Do Until Eof(fn)
Line Input #fn, rawLine
' Strip CR if present; trim outer whitespace for section/key lines.
If Right(rawLine, 1) = Chr(13) Then rawLine = Left(rawLine, Len(rawLine) - 1)
trimmed = Trim(rawLine)
If Len(trimmed) = 0 Then Continue Do
If Left(trimmed, 1) = ";" Then Continue Do
If Left(trimmed, 1) = "[" AndAlso Right(trimmed, 1) = "]" Then
section = LCase(Trim(Mid(trimmed, 2, Len(trimmed) - 2)))
If section = "palette" Then
inPalette = True
cur = -1
Else
inPalette = False
cur = TileIdFromName(section)
If cur < 0 Then
LogConsole "warning: unknown tile section [" & section & "] in " & path
End If
End If
Continue Do
End If
If inPalette Then
eq = InStr(trimmed, "=")
If eq > 0 Then
keyName = Trim(Left(trimmed, eq - 1))
valueStr = Trim(Mid(trimmed, eq + 1))
If Len(keyName) = 1 AndAlso keyName >= "0" AndAlso keyName <= "9" Then
idx = Asc(keyName) - Asc("0")
cval = ParseColorToken(valueStr)
If cval >= 0 Then
palRgb(idx) = PaletteRgb(cval)
Else
LogConsole "warning: bad palette color '" & valueStr & "' for slot " & keyName
End If
End If
End If
Continue Do
End If
If cur < 0 Then Continue Do
eq = InStr(trimmed, "=")
c0 = Left(trimmed, 1)
If eq > 0 AndAlso c0 <> "#" AndAlso c0 <> "+" AndAlso c0 <> "." _
AndAlso Not (c0 >= "0" And c0 <= "9") Then
keyName = LCase(Trim(Left(trimmed, eq - 1)))
valueStr = Trim(Mid(trimmed, eq + 1))
If keyName = "color" Or keyName = "primary" Then
cval = ParseColorToken(valueStr)
If cval >= 0 Then
primaryOf(cur) = cval
Else
LogConsole "warning: bad color '" & valueStr & "' for tile id " & cur
End If
End If
Continue Do
End If
' Pixel row: take up to CELL_W significant chars (pad/truncate).
If rowOf(cur) >= CELL_H Then Continue Do
y = rowOf(cur)
For x = 0 To CELL_W - 1
If x + 1 <= Len(rawLine) Then
ch = Mid(rawLine, x + 1, 1)
Else
ch = "."
End If
Select Case ch
Case "#"
pixels(cur, y, x) = 1
Case "+"
pixels(cur, y, x) = 2
Case "0" To "9"
pixels(cur, y, x) = 10 + (Asc(ch) - Asc("0"))
Case Else
' '.' and any other char → black / empty
pixels(cur, y, x) = 0
End Select
Next x
rowOf(cur) += 1
hasPixels(cur) = True
Loop
Close #fn
' Bake images.
For tid = 0 To TILE_COUNT - 1
If config.tileDefs(tid).img <> 0 Then
ImageDestroy config.tileDefs(tid).img
config.tileDefs(tid).img = 0
End If
If Not hasPixels(tid) Then
BuildPlaceholderTile tid
Continue For
End If
img = ImageCreate(CELL_W, CELL_H, PaletteRgb(COL_BLACK), 32)
If img = 0 Then
LogConsole "warning: ImageCreate failed for tile " & tid
BuildPlaceholderTile tid
Continue For
End If
primary = PaletteRgb(primaryOf(tid))
dimmed = DimRgb(primary)
black = PaletteRgb(COL_BLACK)
For y = 0 To CELL_H - 1
For x = 0 To CELL_W - 1
code = pixels(tid, y, x)
Select Case code
Case 1
pix = primary
Case 2
pix = dimmed
Case 10 To 19
pix = palRgb(code - 10)
Case Else
pix = black
End Select
PSet img, (x, y), pix
Next x
Next y
config.tileDefs(tid).img = img
Next tid
LoadTileFile = True
End Function
' Build CELL_W x CELL_H image buffers for Put. Called after ScreenRes when
' graphics mode is GFX_CUSTOM. Prefers the text tileset (config.tileFile);
' falls back to solid placeholders if the file is missing or unreadable.
Sub LoadTileGraphics ()
If config.graphics <> GFX_CUSTOM Then Exit Sub
FreeTileGraphics
If Len(config.tileFile) = 0 Then
config.tileFile = DEFAULT_TILEFILE
End If
If LoadTileFile(config.tileFile) Then
Exit Sub
End If
LogConsole "warning: could not load tileset '" & config.tileFile & "'; using placeholders"
Dim As Integer i
For i = 0 To TILE_COUNT - 1
BuildPlaceholderTile i
If config.tileDefs(i).img = 0 Then
LogConsole "warning: failed to create bitmap for tile id " & i
End If
Next i
End Sub
Sub FreeTileGraphics ()
Dim As Integer i
For i = 0 To TILE_COUNT - 1
If config.tileDefs(i).img <> 0 Then
ImageDestroy config.tileDefs(i).img
config.tileDefs(i).img = 0
End If
Next i
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 from a .til file\n"
UsageText += !" --tilefile=FILE Tileset file (implies --tiles); default tiles.til\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"
UsageText += !".til files are INI-style text: [palette] plus one [tile_name] section per sprite (8x16).\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 InitializeConfig ()
config.fullscreen = False
config.scale = DEFAULT_SCALE
config.graphics = GFX_CUSTOM
config.depth = 8
config.tileFile = DEFAULT_TILEFILE
config.worldFile = DEFAULT_WORLDFILE
End Sub
Sub ParseCommandLine ()
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
config.fullscreen = True
ElseIf arg = "--windowed" Or arg = "-w" Then
config.fullscreen = False
ElseIf arg = "--ascii" Or arg = "-a" Then
config.graphics = GFX_ASCII
ElseIf arg = "--tiles" Or arg = "-t" Then
config.graphics = GFX_CUSTOM
ElseIf Left(arg, 11) = "--tilefile=" Then
config.tileFile = Mid(arg, 12)
config.graphics = GFX_CUSTOM
ElseIf arg = "--tilefile" Then
i += 1
Dim As String tileArg = Command(i)
If Len(tileArg) = 0 Then
LogConsole "error: --tilefile requires a value"
End 1
End If
config.tileFile = tileArg
config.graphics = GFX_CUSTOM
ElseIf Left(arg, 11) = "--worldfile=" Then
config.worldFile = Mid(arg, 13)
ElseIf arg = "--worldfile" Then
i += 1
Dim As String worldArg = Command(i)
If Len(worldArg) = 0 Then
LogConsole "error: --worldfile requires a value"
End 1
End If
config.worldFile = worldArg
ElseIf Left(arg, 8) = "--scale=" Then
config.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
config.scale = Val(scaleArg)
Else
LogConsole "error: unknown option: " & arg & !"\nTry --help for usage."
End 1
End If
i += 1
Loop
If config.scale < MIN_SCALE Or config.scale > MAX_SCALE Then
LogConsole "error: scale must be between " & MIN_SCALE & " and " & MAX_SCALE
End 1
End If
' Depth follows graphics mode: palette ASCII vs truecolor bitmaps.
If config.graphics = GFX_CUSTOM Then
config.depth = 32
Else
config.depth = 8
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.
'
' config.depth is set from graphics mode (8 = ASCII palette, 32 = custom
' tiles). 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
config.useGlScale = False
If config.fullscreen Then
flags Or= FB.GFX_FULLSCREEN
End If
If config.scale > 1 Then
ScreenControl FB.SET_GL_2D_MODE, FB.OGL_2D_AUTO_SYNC
ScreenControl FB.SET_GL_SCALE, config.scale
ScreenRes LOGICAL_W, LOGICAL_H, config.depth, , flags Or FB.GFX_OPENGL
If ScreenPtr <> 0 Then
config.useGlScale = True
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST)
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST)
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"
config.scale = 1
End If
End If
If ScreenPtr = 0 Then
ScreenRes LOGICAL_W, LOGICAL_H, config.depth, , flags
End If
If ScreenPtr = 0 Then
LogConsole "error: failed to open graphics mode (" & LOGICAL_W & "x" & _
LOGICAL_H & "x" & config.depth & ")"
If config.fullscreen Then
LogConsole "Try without --fullscreen."
End If
End 1
End If
' Text grid matches the classic 80x25 layout at either depth.
Width GRID_COLS, GRID_ROWS
WindowTitle "The Maze"
SetColor COL_DEFAULT, COL_BLACK
Cls
' Bitmaps require an active graphics mode (ImageCreate after ScreenRes).
LoadTileGraphics
End Sub
Sub ShutdownVideo ()
FreeTileGraphics
End Sub
Sub InitializeGame(ByRef game As GameState)
Randomize Timer
game.playerX = 40
game.playerY = 10
game.numArrows = 0
game.numMonsters = 0
game.numBombs = 0
game.livesLeft = 4
game.currentRoom = 1
game.cycleCount = 0
game.lastPlayerCycle = 0
game.lastArrowCycle = 0
game.lastBombCycle = 0
game.lastMonsterCycle = 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.
LoadLevel game
SetupScreen game
DrawRoom game
CaptureCheckpoint game
End Sub
Sub RunGameLoop(ByRef game As GameState)
Dim As Integer oldX, oldY, moveDir, playerTile
Dim As String keyBuf
playerTile = TILE_PLAYER_RIGHT
Do
oldX = game.playerX
oldY = game.playerY
moveDir = Dir.None
keyBuf = InKey$
' Direction input (time-critical, using MultiKey + fbgfx SC_* scancodes)
If MultiKey(SC_UP) Or keyBuf = Chr$(CH_NULL) + "H" Then
moveDir = Dir.UpDir
keyBuf = InKey$
ElseIf MultiKey(SC_DOWN) Or keyBuf = Chr$(CH_NULL) + "P" Then
moveDir = Dir.DownDir
keyBuf = InKey$
ElseIf MultiKey(SC_LEFT) Or keyBuf = Chr$(CH_NULL) + "K" Then
moveDir = Dir.LeftDir
keyBuf = InKey$
ElseIf MultiKey(SC_RIGHT) Or keyBuf = Chr$(CH_NULL) + "M" Then
moveDir = Dir.RightDir
keyBuf = InKey$
End If
' Non-movement keys
Select Case keyBuf
Case Chr$(CH_ESC)
System
Case "e", "E"
Shell "./edit"
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
playerTile = TILE_PLAYER_UP
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
playerTile = TILE_PLAYER_DOWN
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
playerTile = TILE_PLAYER_LEFT
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
playerTile = TILE_PLAYER_RIGHT
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.tileMap(), 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.tileMap(), 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.numMonsters > 0 AndAlso ShouldProcess(game.lastMonsterCycle, game.cycleCount, MONSTERCYCLES) Then UpdateMonsters game
If game.entityHurtPlayer AndAlso ShouldProcess(game.lastDiamondCycle, game.cycleCount, DIAMONDCYCLES) Then LoseDiamond game
' Draw player
DrawTile game.tileMap(), game.playerY, game.playerX, playerTile
If oldY <> game.playerY Or oldX <> game.playerX Then
DrawTile game.tileMap(), 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 += WORLD_WIDTH_IN_ROOMS
If game.currentRoom > MAX_ROOMS Then game.currentRoom -= MAX_ROOMS
game.playerY = 1
Case Dir.UpDir
game.currentRoom -= WORLD_WIDTH_IN_ROOMS
If game.currentRoom < 1 Then game.currentRoom += MAX_ROOMS
game.playerY = GRID_PLAY_ROWS
Case Dir.RightDir
game.currentRoom += 1
If game.currentRoom > MAX_ROOMS Then game.currentRoom -= MAX_ROOMS
game.playerX = 1
Case Dir.LeftDir
game.currentRoom -= 1
If game.currentRoom < 1 Then game.currentRoom += MAX_ROOMS
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.numMonsters = 0
For t = 1 To config.rooms(game.currentRoom).items Step 2
Dim As String tempStr = config.rooms(game.currentRoom).data(t)
x1 = Val(Right$(tempStr, Len(tempStr) - 1))
y1 = Val(config.rooms(game.currentRoom).data(t + 1))
x2 = Val(config.rooms(game.currentRoom).data(t + 2))
y2 = Val(config.rooms(game.currentRoom).data(t + 3))
Select Case Left$(tempStr, 1)
Case "l" 'Walls
DrawWall game.tileMap(), x1, y1, x2, y2
Case "b" 'Blocks
DrawBlock game.tileMap(), x1, y1, x2, y2
Case "s" 'Spaces
DrawTile game.tileMap(), y1, x1, TILE_SPACE
Case "p" 'Point
DrawTile game.tileMap(), y1, x1, TILE_WALL
Case "w" 'Warp
DrawTile game.tileMap(), y1, x1, TILE_WARP
Case "c" 'Diamond
If Not config.rooms(game.currentRoom).diamondsCollected Then
DrawTile game.tileMap(), y1, x1, TILE_DIAMOND
End If
Case "k" 'Key
If Not config.rooms(game.currentRoom).keysCollected Then
DrawTile game.tileMap(), y1, x1, TILE_KEY
End If
Case "d" 'Door
If Not config.rooms(game.currentRoom).doorOpened Then
DrawTile game.tileMap(), y1, x1, TILE_DOOR
Else
DrawTile game.tileMap(), y1, x1, TILE_SPACE
End If
Case "e" 'Monster
game.numMonsters = game.numMonsters + 1
game.monsters(game.numMonsters).x = x1
game.monsters(game.numMonsters).y = y1
DrawTile game.tileMap(), y1, x1, TILE_MONSTER
Case "v" 'Save point
DrawTile game.tileMap(), y1, x1, TILE_SAVE
Case "Q" 'Win marker
DrawTile game.tileMap(), 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(game.tileMap(), y1, x1 - 1) <> TILE_SPACE Then
DrawTile game.tileMap(), y1, x1, TILE_ARROW_L
game.arrows(game.numArrows).dir = 1
ElseIf GetTile(game.tileMap(), y1, x1 + 1) <> TILE_SPACE Then
DrawTile game.tileMap(), y1, x1, TILE_ARROW_R
game.arrows(game.numArrows).dir = -1
Else
DrawTile game.tileMap(), 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 game.tileMap(), y1, x1, TILE_BOMB
Case "n" 'Mine
DrawTile game.tileMap(), 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 LoadLevel(ByRef game As GameState)
Dim As Integer i, j
Dim As String tempStr
If Open(config.worldFile For Input As #1) <> 0 Then
LogConsole "error: could not open level file: " & config.worldFile
LogConsole "Run from the directory that contains the .dat (e.g. 'make run')."
ShutdownAudio
ShutdownVideo
End 1
End If
For i = 1 To MAX_ROOMS
Input #1, tempStr
config.rooms(i).items = Val(tempStr)
For j = 1 To config.rooms(i).items
Input #1, config.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
config.rooms(i).diamondsCollected = False
config.rooms(i).keysCollected = False
config.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) = config.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
config.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.tileMap(), 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.numMonsters > 0 AndAlso ShouldProcess(game.lastMonsterCycle, game.cycleCount, MONSTERCYCLES) Then UpdateMonsters 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)
config.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)
config.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
config.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(game.tileMap(), j, i) = TILE_DOOR Then DrawTile game.tileMap(), 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.tileMap(), game.bombs(entityIndex).y, game.bombs(entityIndex).x) = TILE_MINE Then
KillEntity game.tileMap(), game.bombs(), entityIndex, game.numBombs
DrawTile game.tileMap(), 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.tileMap(), game.bombs(entityIndex).y, game.bombs(entityIndex).x) = TILE_WARP Then Warp game.tileMap(), game.bombs(entityIndex).x, game.bombs(entityIndex).y
If GetTile(game.tileMap(), game.bombs(entityIndex).y, game.bombs(entityIndex).x) = TILE_MONSTER Then
whichEntityToKill = WhichEntity(game.monsters(), game.bombs(entityIndex).x, game.bombs(entityIndex).y, game.numMonsters)
If whichEntityToKill > 0 Then KillEntity game.tileMap(), game.monsters(), whichEntityToKill, game.numMonsters
End If
If GetTile(game.tileMap(), game.bombs(entityIndex).y, game.bombs(entityIndex).x) = TILE_ARROW_L Or GetTile(game.tileMap(), 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.tileMap(), game.arrows(), whichEntityToKill, game.numArrows
End If
If GetTile(game.tileMap(), game.bombs(entityIndex).y, game.bombs(entityIndex).x) <> TILE_SPACE And GetTile(game.tileMap(), game.bombs(entityIndex).y, game.bombs(entityIndex).x) <> TILE_DEAD Then game.bombs(entityIndex).y = entityOldY
DrawTile game.tileMap(), game.bombs(entityIndex).y, game.bombs(entityIndex).x, TILE_BOMB
If entityOldY <> game.bombs(entityIndex).y Or entityOldX <> game.bombs(entityIndex).x Then
DrawTile game.tileMap(), 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.tileMap(), game.arrows(entityIndex).y, game.arrows(entityIndex).x) = TILE_MINE Then
KillEntity game.tileMap(), game.arrows(), entityIndex, game.numArrows
DrawTile game.tileMap(), 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.tileMap(), game.arrows(entityIndex).y, game.arrows(entityIndex).x) = TILE_WARP Then Warp game.tileMap(), game.arrows(entityIndex).x, game.arrows(entityIndex).y
If GetTile(game.tileMap(), game.arrows(entityIndex).y, game.arrows(entityIndex).x) = TILE_MONSTER Then
whichEntityToKill = WhichEntity(game.monsters(), game.arrows(entityIndex).x, game.arrows(entityIndex).y, game.numMonsters)
If whichEntityToKill > 0 Then KillEntity game.tileMap(), game.monsters(), whichEntityToKill, game.numMonsters
End If
If GetTile(game.tileMap(), 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.tileMap(), game.bombs(), whichEntityToKill, game.numBombs
End If
If GetTile(game.tileMap(), game.arrows(entityIndex).y, game.arrows(entityIndex).x) <> TILE_DEAD Then
If GetTile(game.tileMap(), 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.tileMap(), game.arrows(entityIndex).y, game.arrows(entityIndex).x, TILE_ARROW_R
Else
DrawTile game.tileMap(), game.arrows(entityIndex).y, game.arrows(entityIndex).x, TILE_ARROW_L
End If
If entityOldX <> game.arrows(entityIndex).x Or entityOldY <> game.arrows(entityIndex).y Then
DrawTile game.tileMap(), entityOldY, entityOldX, TILE_SPACE
End If
End If
entityIndex = entityIndex + 1
Loop While entityIndex <= game.numArrows
End Sub
Sub UpdateMonsters(ByRef game As GameState)
Dim As Integer entityIndex = 1, entityOldX, entityOldY, whichEntityToKill
Dim As Boolean seen
Do
entityOldX = game.monsters(entityIndex).x: entityOldY = game.monsters(entityIndex).y
seen = LineofSight(game.tileMap(), game.playerX, game.playerY, game.monsters(entityIndex).x, game.monsters(entityIndex).y)
If seen AndAlso Not game.isDead Then
If Rnd(1) > .2 Then
If Abs(game.monsters(entityIndex).x - game.playerX) >= Abs(game.monsters(entityIndex).y - game.playerY) Then
game.monsters(entityIndex).x += Sgn(game.playerX - game.monsters(entityIndex).x)
Else
game.monsters(entityIndex).y += Sgn(game.playerY - game.monsters(entityIndex).y)
End If
Else
If Abs(game.monsters(entityIndex).x - game.playerX) >= Abs(game.monsters(entityIndex).y - game.playerY) Then
game.monsters(entityIndex).y += Int(Cos(Timer Mod 180 * 3.14 * 2 + entityIndex) + .5)
Else
game.monsters(entityIndex).x += Int(Cos(Timer Mod 180 * 3.14 * 2 + entityIndex) + .5)
End If
End If
Else
If Rnd(1) > .5 Then
game.monsters(entityIndex).y += Int(Sin(Timer Mod 180 * 3.14 * 2 + entityIndex) + .5) * ((entityIndex Mod 2) - .5) * 2
Else
game.monsters(entityIndex).x += Int(Cos(Timer Mod 180 * 3.14 * 2 + entityIndex) + .5)
End If
End If
If game.monsters(entityIndex).y < 1 Or game.monsters(entityIndex).y > GRID_PLAY_ROWS Then game.monsters(entityIndex).y = entityOldY
If game.monsters(entityIndex).x < 1 Or game.monsters(entityIndex).x > GRID_COLS Then game.monsters(entityIndex).x = entityOldX
If GetTile(game.tileMap(), game.monsters(entityIndex).y, game.monsters(entityIndex).x) = TILE_MINE Then
KillEntity game.tileMap(), game.monsters(), entityIndex, game.numMonsters
DrawTile game.tileMap(), entityOldY, entityOldX, TILE_SPACE
Else
If GetTile(game.tileMap(), game.monsters(entityIndex).y, game.monsters(entityIndex).x) = TILE_WARP Then
Warp game.tileMap(), game.monsters(entityIndex).x, game.monsters(entityIndex).y
End If
If game.monsters(entityIndex).x = game.playerX AndAlso game.monsters(entityIndex).y = game.playerY Then
If Not game.isDead Then game.entityHurtPlayer = True
End If
If GetTile(game.tileMap(), game.monsters(entityIndex).y, game.monsters(entityIndex).x) <> TILE_SPACE Then
game.monsters(entityIndex).x = entityOldX: game.monsters(entityIndex).y = entityOldY
Else
DrawTile game.tileMap(), entityOldY, entityOldX, TILE_SPACE
' Original palette shift: base green/cyan, +5 for later monsters
DrawTile game.tileMap(), game.monsters(entityIndex).y, game.monsters(entityIndex).x, TILE_MONSTER, _
entityIndex + COL_GREEN + (5 * (entityIndex > 5))
End If
End If
entityIndex = entityIndex + 1
Loop While entityIndex <= game.numMonsters
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
SetColor COL_DEFAULT, COL_BLACK
Cls
ClearTileMap game.tileMap()
' 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 (tileMap(Any, Any) as Integer, 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 tileMap(), y1 + t, x1 + r, TILE_BLOCK
Next r
Next t
End Sub
Sub DrawWall (tileMap(Any, Any) as Integer, 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 tileMap(), 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 tileMap(), yc, xc, TILE_WALL
End If
Loop
If yc > 0 And yc <= GRID_PLAY_ROWS And xc > 0 And xc <= GRID_COLS Then
DrawTile tileMap(), 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. monster palette shift).
Sub DrawTile (tileMap(Any, Any) as Integer, 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 = config.tileDefs(tileId).color
End If
Select Case config.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)
SetColor fg
Locate y, x
Print Chr$(config.tileDefs(tileId).glyph);
End Sub
' Blit a CELL_W x CELL_H bitmap at the cell's pixel origin.
' Images are precolored from the .til file (primary/dim/palette).
' fg is reserved for future runtime tinting (e.g. multicolor monsters).
' Falls back to ASCII if the image is missing.
Sub DrawTileCustom (ByVal y As Integer, ByVal x As Integer, ByVal tileId As Integer, ByVal fg As Integer)
Dim As Any Ptr img = config.tileDefs(tileId).img
If img = 0 Then
DrawTileAscii y, x, tileId, fg
Exit Sub
End If
Dim As Integer px = (x - 1) * CELL_W
Dim As Integer py = (y - 1) * CELL_H
Put (px, py), img, PSET
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)
SetColor 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 (tileMap(Any, Any) as Integer, 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 (tileMap(Any, Any) as Integer)
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 (tileMap(Any, Any) as Integer, ents() As Entity, ByVal p As Integer, ByRef n As Integer)
DrawTile tileMap(), ents(p).y, ents(p).x, TILE_DEAD
Play "l64o1go0cabc"
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 (tileMap(Any, Any) as Integer, 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(tileMap(), 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(tileMap(), 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(tileMap(), 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 (tileMap(Any, Any) as Integer, ByRef x As Integer, ByRef y As Integer)
Play "l64o3cego2bdfa"
Do
x = Int(Rnd(1) * GRID_COLS) + 1
y = Int(Rnd(1) * GRID_PLAY_ROWS) + 1
Loop While GetTile(tileMap(), 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
InitializeConfig
InitTileTable
ParseCommandLine
InitVideo
InitAudio
InitializeGame game
RunGameLoop game
ShutdownAudio
ShutdownVideo