Construction Crates Sample Program
' Construction Crates, a Sokoban-style game
' Use left/right/up/down arrows to control player
' Press ESC to restart the level
' Levels (c) by Jordi Domènech, sokoban-jd.blogspot.com
' Graphics from pixabay.com and Chat GPT
Program "Construction Crates" icon "icon_lowres.png"
' we start from level one, but if you want to cheat, you can change it
$numLevel = 1 ''' LoadNumericValue("SokobanLevel", 1)
' we'll cahnge the image depending on direction
$playerImage = #"worker.png"
$animationDuration = 0.05 ' animate character movement for this period of time
$animationResetTimeout = 0.5 ' reset character to default after this timeout
$animate = Null ' set animation data when needed
$animationResetAfter = Null ' time to reset character after animation is done
function OnTimer()
' no animation expecetd
if IsNull($animate)
' is there waiting period to reset the character?
if not IsNull($animationResetAfter) and GetTime() > $animationResetAfter
$animationResetAfter = Null
$playerImage = #"worker.png"
' otherwise do nothing and exit
else
exit function
end if
end if
' if animation expected, redraw
DrawLevel()
end function
function OnSize()
' constants
spacing = 10
cellSizeRegular = 200
' calculate starting point for redrawing
$Level.startX = spacing
$Level.startY = spacing
' prepare font for status text and estimate its size
SetFont("Arial")
SetFontSize(48)
SetColor("yellow")
textHeight = GetTextHeight("Sample Text")
' calculate cell width and height
cellWidthMax = int((GetWidth() - 2 * spacing) / $Level.width)
cellHeightMax = int((GetHeight() - 3 * spacing - textHeight) / $Level.height)
cellSizeMax = min(cellWidthMax, cellHeightMax)
cellSize = min(cellSizeRegular, cellSizeMax)
$Level.cellWidth = cellSize
$Level.cellHeight = cellSize
' calculate coordinates of status message
$Level.statusX = spacing
$Level.statusY = $Level.height * $Level.cellHeight + 2 * spacing
' resize window
windowWidth = $Level.width * $Level.cellWidth + 2 * spacing
windowHeight = $Level.height * $Level.cellHeight + 3 * spacing + textHeight
FixWindowSize (windowWidth, windowHeight)
' draw the loaded level
DrawLevel()
end function
function LoadLevelData()
' start a new level with zero height
level.height = 0
' split lines of the resource file
lines = SplitLines(#"levels.txt")
nLines = Size(lines)
' parse lines one by one
for i=1 to nLines
line = lines[i]
' non-empty line without special tags => level line
if line <> "" and not Find(line, ":")
' increase level height
level.height = level.height + 1
' get number of characters in current line and update level witdth
nChars = len(line)
if level.width < nChars
level.width = nChars
end if
' add a new row to the level
level.lines[level.height] = line
' empty line or line with a speacial tag means the end of the level
else
' if we read a level, add it to the global level data
if level.height > 0
$maxLevels = $maxLevels + 1
$LevelData[$maxLevels] = level
end if
' reset current level
level = null
level.height = 0
end if
next
end function
function ResetLevel()
' find effective layer number, we repeat the same levels over and over
n = ($numLevel-1) % $maxlevels + 1
' get text level data
LevelData = $LevelData[n]
' create a new level
$Lelel = null
$Level.height = LevelData.height
$Level.width = LevelData.width
' parse text level data to build a level
for y=1 to LevelData.height
' split current line into characters
chars = SplitCharacters(LevelData.lines[y])
' create one row of the level
for x=1 to LevelData.width
c = chars[x]
' is this a wall?
if c="#"
cell.wall = 1
else
cell.wall = 0
end if
' is this a target?
if c="." or c="*" or c="+"
cell.target = 1
else
cell.target = 0
end if
' is this a box?
if c="$" or c="*"
cell.box = 1
else
cell.box = 0
end if
' is this a player?
if c="@" or c="+"
$Level.x = x
$Level.y = y
end if
' add cell to the level
$Level.map[x][y] = cell
next
next
OnSize()
end function
function NextLevel()
' increase level and call ResetLevel
$numLevel = $numLevel + 1
SaveNumericValue("SokobanLevel", $numLevel)
ResetLevel()
end function
function CheckWin()
' go through the level and retrun 0(false) if there is a target without a box
for x=1 to $Level.width
for y=1 to $Level.height
if $Level.map[x][y].target = 1 and $Level.map[x][y].box <> 1
CheckWin = 0
exit function
end if
next
next
CheckWin = 1
end function
function DrawLevel()
' clear screen
ClearScreen()
' calculate animation data
if not IsNull($animate)
elapsed = GetTime() - $animate.startTime
if elapsed > $animationDuration
$animate = Null
$animationResetAfter = GetTime() + $animationResetTimeout
else
animatedXShift = -$animate.dx * ($animationDuration-elapsed) / $animationDuration * $Level.cellWidth
animatedYShift = -$animate.dy * ($animationDuration-elapsed) / $animationDuration * $Level.cellHeight
end if
end if
' draw level
screenX = $Level.startX
for x=1 to $Level.width
screenY = $Level.startY
for y=1 to $Level.height
cell = $Level.map[x][y]
' current cell x and y
xImage = screenX
yImage = screenY
' calculate shift for animation
if not IsNull($animate) and $animate.xBox = x and $animate.yBox = y
xImage = xImage + animatedXShift
yImage = yImage + animatedYShift
end if
' draw correct resource image for the cell
if cell.wall = 1
DrawImageRectangle(xImage, yImage, xImage + $Level.cellWidth, yImage + $Level.cellHeight, #"wall.png")
elseif cell.box = 1
if cell.target = 1
DrawImageRectangle(xImage, yImage, xImage + $Level.cellWidth, yImage + $Level.cellHeight, #"box_target.png")
else
DrawImageRectangle(xImage, yImage, xImage + $Level.cellWidth, yImage + $Level.cellHeight, #"box.png")
end if
elseif cell.target = 1
DrawImageRectangle(xImage, yImage, xImage + $Level.cellWidth, yImage + $Level.cellHeight, #"target.png")
end if
' update screen y
screenY = screenY + $Level.cellHeight
next
' update screen x
screenX = screenX + $Level.cellWidth
next
' player's x and y
playerX = $Level.startX + $Level.cellWidth * ($Level.x-1)
playerY = $Level.startY + $Level.cellHeight * ($Level.y-1)
' calculate shift for animation
if not IsNull($animate)
playerX = playerX + animatedXShift
playerY = playerY + animatedYShift
end if
' draw player's character
DrawImageRectangle(playerX, playerY, playerX + $Level.cellWidth, playerY + $Level.cellHeight, $playerImage)
' if won, print corresponding status message
if CheckWin()
DrawText ($Level.statusX, $Level.statusY, "You won! Press any key to continue")
' else print regular status message
else
DrawText ($Level.statusX, $Level.statusY, "Level: " & $numLevel & ". Press ESC or 1 to restart level")
end if
end function
function OnKeyboard(char)
' if won, just go to the next level
if CheckWin()
NextLevel()
exit function
end if
' if ESC, restart level
if char = "VK_ESCAPE" or char = "1"
ResetLevel()
exit function
end if
' calculate dx and dy shift
if char = "VK_LEFT" or char = "4"
dx = -1
dy = 0
elseif char = "VK_RIGHT" or char = "6"
dx = +1
dy = 0
elseif char = "VK_UP" or char = "2"
dx = 0
dy = -1
elseif char = "VK_DOWN" or char = "8"
dx = 0
dy = +1
else
exit function
end if
' get adjacent cell and next cell
Cell1 = $Level.map[$Level.x+dx][$Level.y+dy]
Cell2 = $Level.map[$Level.x+dx*2][$Level.y+dy*2]
' do the move if possible
if Cell1.wall=0 and Cell1.box = 0
$Level.x = $Level.x + dx
$Level.y = $Level.y + dy
' pick graphics for walking animation
if dx = -1
$playerImage = #"worker_walk_left.png"
elseif dx = +1
$playerImage = #"worker_walk_right.png"
elseif dy = -1
$playerImage = #"worker_walk_back.png"
elseif dy = +1
$playerImage = #"worker_walk_front.png"
end if
' set animation data
$animate = 1
$animate.dx = dx
$animate.dy = dy
$animate.startTime = GetTime()
' do the pusj if possible
elseif Cell1.wall=0 and Cell1.box=1 and Cell2.wall=0 and Cell2.box=0
$Level.map[$Level.x+dx][$Level.y+dy].box = 0
newBoxCellX = $Level.x+dx*2
newBoxCellY = $Level.y+dy*2
$Level.map[newBoxCellX][newBoxCellY].box = 1
$Level.x = $Level.x + dx
$Level.y = $Level.y + dy
' pick graphics for pushing animation
if dx = -1
$playerImage = #"worker_push_left.png"
elseif dx = +1
$playerImage = #"worker_push_right.png"
elseif dy = -1
$playerImage = #"worker_push_back.png"
elseif dy = +1
$playerImage = #"worker_push_front.png"
end if
' set animation data
$animate = 1
$animate.startTime = GetTime()
$animate.dx = dx
$animate.dy = dy
$animate.xBox = newBoxCellX
$animate.yBox = newBoxCellY
end if
' draw level
DrawLevel()
end function
function OnMouseDown(x, y)
$downX = x
$downY = y
end function
function OnMouseUp(x, y)
if abs(x - $downX) > abs(y - $downY)
if(x > $downX)
OnKeyboard("VK_RIGHT")
else
OnKeyboard("VK_LEFT")
end if
else
if(y > $downY)
OnKeyboard("VK_DOWN")
else
OnKeyboard("VK_UP")
end if
end if
end function
' load text level data
LoadLevelData()
' start the first level
ResetLevel()