DECLARE SUB main ()
DECLARE SUB mapFromData ()
DECLARE SUB mapDraw ()
DECLARE FUNCTION actorMoveTarget% (iActor AS INTEGER, iDirection AS INTEGER)
DECLARE SUB actorDraw (iSlot AS INTEGER)
DECLARE FUNCTION getInput% ()

CONST cCellWidth = 16
CONST cCellHeight = 16
CONST cMaxCells = 512

CONST cBlockWallUp = &H1      ' Top edge cannot be crossed.
CONST cBlockWallLf = &H2      ' Left edge cannot be crossed.
CONST cBlockWallDn = &H4      ' Bottom edge cannot be crossed.
CONST cBlockWallRt = &H8      ' Right edge cannot be crossed.
CONST cBlockWallAll = &HF     ' Shorthand for all edges blocked.
CONST cBlockIsSolid = &H8000  ' Block is solid.

CONST cMoveUp = 0
CONST cMoveRt = 1
CONST cMoveDn = 2
CONST cMoveLf = 3

TYPE blockType
	iColor AS INTEGER
	iFlags AS INTEGER
END TYPE

TYPE ActorType
	iX AS INTEGER       ' Horizontal coordinate, in cells (column)
	iY AS INTEGER       ' Vertical coordinate, in cells (rows)
END TYPE

DIM SHARED gBlock(15) AS blockType

DIM SHARED gMapData(cMaxCells - 1) AS INTEGER
DIM SHARED gMapWidth               AS INTEGER
DIM SHARED gMapHeight              AS INTEGER

DIM SHARED gActor(0) AS ActorType

main

' Cells are 16x16 and mode 13 is 320x200. This means we can
' have a one-screen map of 20 columns by 12 rows.
DATA 20, 12

' New world data.
DATA "88888888888888888600"
DATA "11111118888844444500"
DATA "88188818888677777700"
DATA "45928888888677777700"
DATA "77928888888677777700"
DATA "77928444444500000000"
DATA "77135777777700000000"
DATA "00177444457700011111"
DATA "00177777770000010000"
DATA "00111111111111110000"
DATA "00000000000000000000"
DATA "00000000000000000000"

''
'' Display the actor on screen.
''
SUB actorDraw (iSlot AS INTEGER)
	DIM uActor AS ActorType, iX AS INTEGER, iY AS INTEGER

	' Shorthand
	uActor = gActor(iSlot)

	' Compute the actor's current location.
	iX = uActor.iX * cCellWidth + 1
	iY = uActor.iY * cCellHeight + 1

	' Draw actor in current location.
	LINE (iX, iY)-STEP(cCellWidth - 3, cCellHeight - 3), 4, B
END SUB

''
'' This function returns the address of the cell the actor may
'' move to, or -1 if the actor is not allowed to go there.
''
FUNCTION actorMoveTarget% (iActor AS INTEGER, iDirection AS INTEGER)
	DIM iTargetX AS INTEGER, iTargetY AS INTEGER
	DIM iOffsetX AS INTEGER, iOffsetY AS INTEGER
	DIM iSourceAdr AS INTEGER, iTargetAdr AS INTEGER
	DIM iMaskExit AS INTEGER, iMaskEntry AS INTEGER
	DIM iIsSolid AS INTEGER

	' Get the coordinates of the destination cell and the proper
	' wall bitflag; the actor is going to cross two borders (one
	' is the exit of the starting cell, the other is the entry of
	' the target cell.)
	SELECT CASE (iDirection)
	CASE cMoveUp
		iOffsetX = 0
		iOffsetY = -1
		iMaskExit = cBlockWallUp
		iMaskEntry = cBlockWallDn
	CASE cMoveLf
		iOffsetX = -1
		iOffsetY = 0
		iMaskExit = cBlockWallLf
		iMaskEntry = cBlockWallRt
	CASE cMoveDn
		iOffsetX = 0
		iOffsetY = 1
		iMaskExit = cBlockWallDn
		iMaskEntry = cBlockWallUp
	CASE cMoveRt
		iOffsetX = 1
		iOffsetY = 0
		iMaskExit = cBlockWallRt
		iMaskEntry = cBlockWallLf
	END SELECT
	iTargetX = gActor(iActor).iX + iOffsetX
	iTargetY = gActor(iActor).iY + iOffsetY

	' Out of bound check: return -1 if the cell is out of bounds.
	IF (iTargetX < 0) OR (iTargetX >= gMapWidth) OR (iTargetY < 0) OR (iTargetY >= gMapHeight) THEN
		actorMoveTarget% = -1
		EXIT FUNCTION
	END IF

	' Get the target cell address.
	iTargetAdr = iTargetX + iTargetY * gMapWidth

	' If the target block is solid, abort right away.
	IF (gBlock(gMapData(iTargetAdr)).iFlags AND cBlockIsSolid) THEN
		actorMoveTarget% = -1
		EXIT FUNCTION
	END IF

	' Get the source cell address.
	iSourceAdr = gActor(iActor).iX + gActor(iActor).iY * gMapWidth

	' If either edge is blocked, iIsSolid is True.
	iIsSolid = (((gBlock(gMapData(iTargetAdr)).iFlags AND iMaskEntry) OR (gBlock(gMapData(iSourceAdr)).iFlags AND iMaskExit)) <> 0)

	' Return iTargetAdr (the address of the cell within the world)
	' if the actor can move there, or -1 if it cannot.
	actorMoveTarget% = iTargetAdr OR iIsSolid
END FUNCTION

''
'' Catch keyboard input via INKEY$, return an INTEGER.
''
FUNCTION getInput%
	DIM sTemp AS STRING, iSize AS INTEGER

	sTemp = INKEY$
	iSize = LEN(sTemp)

	IF (iSize = 1) THEN
		getInput% = ASC(sTemp)
	ELSEIF (iSize = 2) THEN
		getInput% = CVI(sTemp)
	END IF
END FUNCTION

''
'' Main routine. Use the arrow keys to move around, and escape
'' to terminate the program. The trickier part is probably the
'' timestepping; long story short: we measure the time elapsed
'' since last game update. For every 0.01 second, we update the
'' game to catch up and reduce the "temporal debt" by 0.01. It's
'' not very useful right now but it will become necessary when
'' we tackle smooth movement.
''
SUB main
	CONST cKeyUp = &H4800
	CONST cKeyDn = &H5000
	CONST cKeyLf = &H4B00
	CONST cKeyRt = &H4D00
	CONST cKeyEsc = &H1B

	' For timestepping...
	DIM fCurrent AS SINGLE, fPrevious AS SINGLE
	DIM fElapsed AS SINGLE, fLag AS SINGLE

	' For clearing the screen
	DIM iBackX AS INTEGER, iBackY AS INTEGER
	DIM iBackImg(511) AS INTEGER

	' User input, temporary target cell address.
	DIM iUser AS INTEGER, iAdr AS INTEGER

	' Setup block types; Grass
	gBlock(0).iColor = 2
	gBlock(0).iFlags = 0

	' Dirt path
	gBlock(1).iColor = 6
	gBlock(1).iFlags = 0

	' Left cliff
	gBlock(2).iColor = 7
	gBlock(2).iFlags = cBlockWallLf

	' Bottom left cliff
	gBlock(3).iColor = 7
	gBlock(3).iFlags = cBlockWallLf OR cBlockWallDn

	' Bottom cliff
	gBlock(4).iColor = 7
	gBlock(4).iFlags = cBlockWallDn

	' Bottom-right cliff
	gBlock(5).iColor = 7
	gBlock(5).iFlags = cBlockWallRt OR cBlockWallDn

	' Right cliff
	gBlock(6).iColor = 7
	gBlock(6).iFlags = cBlockWallRt

	' Cliff front (solid)
	gBlock(7).iColor = 7
	gBlock(7).iFlags = cBlockIsSolid

	' Stone top (walkable)
	gBlock(8).iColor = 7
	gBlock(8).iFlags = 0

	' Sloped dirt path (walkable)
	gBlock(9).iColor = 114
	gBlock(9).iFlags = 0

	' Load map data
	mapFromData

	' Set actor's current location.
	gActor(0).iX = 3
	gActor(0).iY = 1

	SCREEN 13
	mapDraw

	' Redraw actor (copy background)
	iBackX = gActor(0).iX: iBackY = gActor(0).iY
	GET (iBackX * cCellWidth, iBackY * cCellHeight)-STEP(cCellWidth - 1, cCellHeight - 1), iBackImg
	actorDraw 0

	fPrevious = TIMER
	DO
		' Update timer
		fCurrent = TIMER
		fElapsed = fCurrent - fPrevious
		fLag = fLag + fElapsed
		fPrevious = fCurrent

		' Process game logic until we're caught up.
		WHILE (fLag > .01)

			' Catch user input.
			iUser = getInput%
			IF (iUser) THEN

				SELECT CASE (iUser)
				CASE cKeyUp
					iAdr = actorMoveTarget%(0, cMoveUp)
				CASE cKeyDn
					iAdr = actorMoveTarget%(0, cMoveDn)
				CASE cKeyRt
					iAdr = actorMoveTarget%(0, cMoveRt)
				CASE cKeyLf
					iAdr = actorMoveTarget%(0, cMoveLf)
				CASE cKeyEsc
					EXIT SUB
				END SELECT

				' Got a new target cell, convert the address to proper
				' X, Y coordinates.
				IF (iAdr >= 0) THEN
					gActor(0).iX = iAdr MOD gMapWidth
					gActor(0).iY = iAdr \ gMapWidth
				END IF
			END IF

			' One game tick is 0.01 second.
			fLag = fLag - .01
		WEND

		' Redraw actor (erase background as necessary)
		IF (iBackX <> gActor(0).iX) OR (iBackY <> gActor(0).iY) THEN
			PUT (iBackX * cCellWidth, iBackY * cCellHeight), iBackImg, PSET
			iBackX = gActor(0).iX: iBackY = gActor(0).iY
			GET (iBackX * cCellWidth, iBackY * cCellHeight)-STEP(cCellWidth - 1, cCellHeight - 1), iBackImg
			actorDraw 0
		END IF
	LOOP
END SUB

''
'' Read data off gMapData() and display on-screen. This time the
'' routine outlines solid edges if there's any.
''
SUB mapDraw
	DIM iR AS INTEGER, iC AS INTEGER
	DIM iX AS INTEGER, iY AS INTEGER
	DIM iRow AS INTEGER, iClr AS INTEGER
	DIM uBlock AS blockType

	' Read map data.
	FOR iR = 0 TO gMapHeight - 1

		' Get the reading offset to the 1st cell of the row.
		iRow = iR * gMapWidth
		' On-screen vertical offset.
		iY = iR * cCellHeight

		FOR iC = 0 TO gMapWidth - 1

			' Get tile info.
			uBlock = gBlock(gMapData(iRow + iC))

			' On-screen horizontal offset.
			iX = iC * cCellWidth

			' Draw cell, use tile-defined color.
			LINE (iX, iY)-STEP(cCellWidth - 1, cCellHeight - 1), uBlock.iColor, BF

			' If the block is solid, cross it.
			IF (uBlock.iFlags AND cBlockIsSolid) THEN
				LINE (iX, iY)-STEP(cCellWidth - 1, cCellHeight - 1), 0
				LINE (iX + cCellWidth - 1, iY)-STEP(-(cCellWidth - 1), cCellHeight - 1), 0

			' Draw solid edges.
			ELSEIF (uBlock.iFlags AND cBlockWallAll) THEN
				iClr = uBlock.iColor + 1
				IF (uBlock.iFlags AND cBlockWallUp) THEN
					LINE (iX, iY)-STEP(cCellWidth - 1, 0), iClr
				END IF
				IF (uBlock.iFlags AND cBlockWallLf) THEN
					LINE (iX, iY)-STEP(0, cCellHeight - 1), iClr
				END IF
				IF (uBlock.iFlags AND cBlockWallDn) THEN
					LINE (iX, iY + cCellHeight - 1)-STEP(cCellWidth - 1, 0), iClr
				END IF
				IF (uBlock.iFlags AND cBlockWallRt) THEN
					LINE (iX + cCellWidth - 1, iY)-STEP(0, cCellHeight - 1), iClr
				END IF
			END IF

		NEXT iC

	NEXT iR
END SUB

''
'' Setup the world via DATA statements.
''
SUB mapFromData
	DIM iR AS INTEGER, iC AS INTEGER
	DIM sDta AS STRING, iRow AS INTEGER

	' Read map width and height in cells. If you use custom
	' values, make sure they do not overflow the buffer we
	' allocated for the map data earlier.
	READ gMapWidth, gMapHeight

	' Start reading DATA statements. If you use custom values,
	' make sure there's enough data available to fill the map or
	' this will crash.
	FOR iR = 0 TO gMapHeight - 1

		' Read one row.
		READ sDta

		' Get the writing offset to the 1st cell of the row.
		iRow = iR * gMapWidth

		' Decode each cell and write to gMapData(). If you use
		' custom values, make sure each DATA statement contains the
		' proper number of cells or this may crash.
		FOR iC = 0 TO gMapWidth - 1
			gMapData(iRow + iC) = VAL(MID$(sDta, 1 + iC, 1))
		NEXT iC

	NEXT iR
END SUB