DECLARE SUB slopeFromData ()
DECLARE SUB main ()
DECLARE SUB actorDraw (iSlot AS INTEGER)
DECLARE SUB actorMove (iActor AS INTEGER)
DECLARE FUNCTION getInput% ()
DECLARE SUB mapFromData ()
DECLARE SUB mapDraw ()

CONST cActorOnGroundLeft = &H1    ' Left foot on the ground.
CONST cActorOnGroundRight = &H2   ' Right foot on the ground.
CONST cActorOnGround = &H3        ' Actor is on the ground.

CONST cBlockIsSolid = &H8000 ' Block is solid.
CONST cBlockIsSlope = &H4000 ' Block is a slope.

CONST True = -1
CONST False = 0

CONST cCellWidth = 16
CONST cCellHeight = 16
CONST cNumSlopes = 6         ' Number of slope Types
CONST cMaxCells = 512

TYPE blockType
	iColor AS INTEGER
	iFlags AS INTEGER
	iShape AS INTEGER          ' Index (divided by 16) in gSlope()
END TYPE

TYPE ActorType
	iFlags AS INTEGER   ' Special flags.
	fX AS SINGLE        ' Actor's origin, located in the bottom
	fY AS SINGLE        '   center of the bounding box.
	fVelX AS SINGLE     ' Velocity, added to the origin every game
	fVelY AS SINGLE     '   tick, influenced by body type.
	iBBoxW AS INTEGER   ' Bounding box half width and height,
	iBBoxH AS INTEGER   '   relative to the origin.
END TYPE

DIM SHARED gBlock(15) AS blockType
DIM SHARED gActor(0) AS ActorType
DIM SHARED gSlope(cCellWidth * cNumSlopes - 1) AS INTEGER

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

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

' This is our world data. We got a whole set of blocks: solid,
' non-solid, and several slopes (indices 2 to 7.)
DATA "11000000000000000011"
DATA "11000000000000000011"
DATA "11000000000051111011"
DATA "11000000000011110011"
DATA "11120000000000000011"
DATA "11112003411200000011"
DATA "11111111111110000011"
DATA "11000001100000001111"
DATA "11000001100000051111"
DATA "11167000000000511111"
DATA "11111670000005111111"
DATA "11111111111111111111"

' Slope 0, going down (1 step right = 1 unit down)
' Slope 1 & 2, going down (2 steps right = 1 unit down)
' Slope 3 & 4, going up (2 steps right = 1 unit up)
' Slope 5, going up (1 step right = 1 unit up)
DATA 15,14,13,12,11,10,09,08,07,06,05,04,03,02,01,00
DATA 15,15,14,14,13,13,12,12,11,11,10,10,09,09,08,08
DATA 07,07,06,06,05,05,04,04,03,03,02,02,01,01,00,00
DATA 00,00,01,01,02,02,03,03,04,04,05,05,06,06,07,07
DATA 08,08,09,09,10,10,11,11,12,12,13,13,14,14,15,15
DATA 00,01,02,03,04,05,06,07,08,09,10,11,12,13,14,15

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

	' Shorthand
	uActor = gActor(iSlot)

	iX = INT(uActor.fX) - uActor.iBBoxW
	iY = INT(uActor.fY) - uActor.iBBoxH + 1
	iW = 1 + uActor.iBBoxW * 2
	iH = uActor.iBBoxH

	' Draw actor in current location, draw its origin point.
	LINE (iX, iY)-STEP(iW - 1, iH - 1), 4, B
	PSET (INT(uActor.fX), INT(uActor.fY)), 15
END SUB

''
'' Adjust the actor's coordinates using its horizontal and
'' vertical velocity (fVelX, fVelY.) Test for collisions against
'' vertical edges first (left/right moves) and then against
'' horizontal edges (up/down moves.)
''
SUB actorMove (iActor AS INTEGER)
	DIM fIdealX AS SINGLE, fIdealY AS SINGLE, iAdr AS INTEGER
	DIM iCol AS INTEGER, iColLf AS INTEGER, iColRt AS INTEGER
	DIM iRow AS INTEGER, iRowUp AS INTEGER, iRowDn AS INTEGER
	DIM iRelX AS INTEGER, iRelY AS INTEGER
	DIM iCelX AS INTEGER, iCelY AS INTEGER
	DIM iLf AS INTEGER, iUp AS INTEGER
	DIM iRt AS INTEGER, iDn AS INTEGER

	' The actor is moving vertically. It cannot be on the ground.
	IF (gActor(iActor).fVelY) THEN
		gActor(iActor).iFlags = gActor(iActor).iFlags AND NOT cActorOnGround
	END IF

	' Test collisions with vertical edges first.
	IF (gActor(iActor).fVelX) THEN

		' Compute the would-be target coordinates.
		fIdealX = gActor(iActor).fX + gActor(iActor).fVelX
		fIdealY = gActor(iActor).fY

		' Compute the would-be bounding box.
		iLf = fIdealX - gActor(iActor).iBBoxW
		iRt = fIdealX + gActor(iActor).iBBoxW
		iUp = fIdealY - (gActor(iActor).iBBoxH - 1)
		iDn = fIdealY

		' Select the proper column of tiles (either on the left or
		' right side of the actor, depending on its direction.)
		IF (0 < gActor(iActor).fVelX) THEN
			iCol = iRt \ cCellWidth
		ELSE
			iCol = iLf \ cCellWidth
		END IF

		' If we use the FULL height of the bounding box, we will
		' always trigger a collision against the vertical seams of
		' the cells that make up the floor when the actor is on the
		' ground. We offset the values because we don't want to test
		' against the floor: only against solid blocks directly to
		' the left or right.
		iRowUp = (iUp + 4) \ cCellHeight
		IF (gActor(iActor).iFlags AND cActorOnGround) THEN
			iRowDn = (iDn \ cCellHeight) - 1
		ELSE
			iRowDn = (iDn - 4) \ cCellHeight
		END IF
		iAdr = iCol

		' Test right/left collision. If we got a collision, adjust
		' the ideal X coordinate and exit the loop.
		FOR iRow = iRowUp TO iRowDn
			IF (gBlock(gMapData(iAdr + iRow * gMapWidth)).iFlags AND cBlockIsSolid) THEN
				IF (0 < gActor(iActor).fVelX) THEN
					fIdealX = (iCol * cCellWidth) - gActor(iActor).iBBoxW
				ELSE
					fIdealX = ((iCol + 1) * cCellWidth) - 1 + gActor(iActor).iBBoxW
				END IF
				' Cancel horizontal velocity.
				gActor(iActor).fVelX = 0
				EXIT FOR
			END IF
		NEXT iRow

		' Update X coordinate.
		gActor(iActor).fX = fIdealX

		' The actor was on the ground last time we checked and the
		' horizontal velocity is not Null, we have to make sure the
		' actor's feet are still on the ground.
		IF (gActor(iActor).iFlags AND cActorOnGround) THEN

			' Compute the bounding box with the updated coordinates.
			iLf = fIdealX - gActor(iActor).iBBoxW
			iRt = fIdealX + gActor(iActor).iBBoxW
			iUp = fIdealY - (gActor(iActor).iBBoxH - 1)
			iDn = fIdealY

			' Feet are located on the same tile row.
			iRow = (iDn \ cCellHeight)

			' Slopes have the priority for this test again. If the new
			' origin is NOT in a slope tile, test the tile just above:
			' the actor may come from a solid tile and onto a slope.
			iAdr = iRow * gMapWidth + (fIdealX \ cCellWidth)
			IF ((gBlock(gMapData(iAdr)).iFlags AND cBlockIsSlope) = 0) THEN
				iAdr = iAdr - gMapWidth
			END IF

			' If the actor is walking on a slope, we have to adjust
			' the vertical coordinate. We don't care where its feet
			' are at all.
			IF (gBlock(gMapData(iAdr)).iFlags AND cBlockIsSlope) THEN

				' Get the left and bottom coordinates of the slope cell.
				iCelX = (iAdr MOD gMapWidth) * cCellWidth
				iCelY = (iAdr \ gMapWidth) * cCellHeight + (cCellHeight - 1)

				' Get the horizontal location of the actor, relative to
				' the left edge of the tile.
				iRelX = fIdealX - iCelX

				' Get the floor elevation.
				iRelY = iCelY - gSlope(gBlock(gMapData(iAdr)).iShape * cCellWidth + iRelX)

				' Set the actor's vertical location.
				gActor(iActor).fY = iRelY

			' The actor is not on a slope, check both feet.
			ELSE
				' Left foot.
				iAdr = iRow * gMapWidth + ((iLf + 1) \ cCellWidth)
				IF (gBlock(gMapData(iAdr)).iFlags AND cBlockIsSolid) THEN
					gActor(iActor).iFlags = gActor(iActor).iFlags OR cActorOnGroundLeft
				ELSE
					gActor(iActor).iFlags = gActor(iActor).iFlags AND NOT cActorOnGroundLeft
				END IF

				' Right foot.
				iAdr = iRow * gMapWidth + ((iRt - 1) \ cCellWidth)
				IF (gBlock(gMapData(iAdr)).iFlags AND cBlockIsSolid) THEN
					gActor(iActor).iFlags = gActor(iActor).iFlags OR cActorOnGroundRight
				ELSE
					gActor(iActor).iFlags = gActor(iActor).iFlags AND NOT cActorOnGroundRight
				END IF
			END IF
		END IF
	END IF

	' The actor's vertical velocity is not Null, we may test for
	' jump or drop.
	IF (gActor(iActor).fVelY) THEN

		' Compute the would-be target coordinates.
		fIdealX = gActor(iActor).fX
		fIdealY = gActor(iActor).fY + gActor(iActor).fVelY

		' Compute the would-be bounding box.
		iLf = fIdealX - gActor(iActor).iBBoxW
		iRt = fIdealX + gActor(iActor).iBBoxW
		iUp = fIdealY - (gActor(iActor).iBBoxH - 1)
		iDn = fIdealY

		' If the actor is going up, check head bump.
		IF (0 > gActor(iActor).fVelY) THEN
			iRow = iUp \ cCellHeight

			' Same problem as before: we cannot use the full width of
			' the bounding box as the actor will get stuck at the
			' horizontal seams of the cells that make up the walls.
			iColLf = (iLf + 1) \ cCellWidth
			iColRt = (iRt - 1) \ cCellWidth
			iAdr = iRow * gMapWidth

			' Test top collision. If we got a collision, adjust the
			' ideal Y coordinate and exit the loop.
			FOR iCol = iColLf TO iColRt
				IF (gBlock(gMapData(iAdr + iCol)).iFlags AND cBlockIsSolid) THEN
					fIdealY = ((iRow + 1) * cCellHeight) - 1 + (gActor(iActor).iBBoxH - 1)
					gActor(iActor).fVelY = 0
					EXIT FOR
				END IF
			NEXT iCol

		' The actor is falling. Reminder: cActorOnGround is clear
		' because the vertical velocity is not Null. We did that early
		' in the routine. This means we don't have to clear the flag
		' if neither foot is on the ground.
		ELSE

			' Feet are located on the same tile row.
			iRow = (iDn \ cCellHeight)

			' Slopes have the priority, check now.
			iAdr = iRow * gMapWidth + (gActor(iActor).fX \ cCellWidth)
			IF (gBlock(gMapData(iAdr)).iFlags AND cBlockIsSlope) THEN

				' Get the left and bottom coordinates of the slope cell.
				iCelX = (iAdr MOD gMapWidth) * cCellWidth
				iCelY = (iAdr \ gMapWidth) * cCellHeight + (cCellHeight - 1)

				' Get the horizontal location of the actor, relative to
				' the left edge of the tile.
				iRelX = fIdealX - iCelX

				' Get the floor elevation.
				iRelY = iCelY - gSlope(gBlock(gMapData(iAdr)).iShape * cCellWidth + iRelX)

				' If the actor's origin is below the floor level, adjust
				' the ideal Y coordinate.
				IF (gActor(iActor).fY >= iRelY) THEN
					fIdealY = iRelY
					gActor(iActor).iFlags = gActor(iActor).iFlags OR cActorOnGround
					gActor(iActor).fVelY = 0
				END IF

			ELSE
				' Left foot.
				iAdr = iRow * gMapWidth + ((iLf + 1) \ cCellWidth)
				IF (gBlock(gMapData(iAdr)).iFlags AND cBlockIsSolid) THEN
					fIdealY = (iRow * cCellHeight)
					gActor(iActor).iFlags = gActor(iActor).iFlags OR cActorOnGroundLeft
					gActor(iActor).fVelY = 0
				END IF

				' Right foot.
				iAdr = iRow * gMapWidth + ((iRt - 1) \ cCellWidth)
				IF (gBlock(gMapData(iAdr)).iFlags AND cBlockIsSolid) THEN
					fIdealY = (iRow * cCellHeight)
					gActor(iActor).iFlags = gActor(iActor).iFlags OR cActorOnGroundRight
					gActor(iActor).fVelY = 0
				END IF

				' TODO: if we're on the floor, it's possible that the
				' tile above is a slope. In that case we must push the
				' actor up!
			END IF
		END IF

		' Update Y coordinate.
		gActor(iActor).fY = fIdealY
	END IF
END SUB

''
'' 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 iBackW AS INTEGER, iBackH AS INTEGER
	DIM iBackTmpX AS INTEGER, iBackTmpY AS INTEGER
	DIM iBackImg(511) AS INTEGER

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

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

	gBlock(1).iColor = 3
	gBlock(1).iFlags = cBlockIsSolid

	gBlock(2).iColor = 2  ' dark green
	gBlock(2).iFlags = cBlockIsSlope
	gBlock(2).iShape = 0

	gBlock(3).iColor = 5  ' dark purple
	gBlock(3).iFlags = cBlockIsSlope
	gBlock(3).iShape = 3

	gBlock(4).iColor = 13 ' bright pink
	gBlock(4).iFlags = cBlockIsSlope
	gBlock(4).iShape = 4

	gBlock(5).iColor = 10 ' light green
	gBlock(5).iFlags = cBlockIsSlope
	gBlock(5).iShape = 5

	gBlock(6).iColor = 1  ' dark blue
	gBlock(6).iFlags = cBlockIsSlope
	gBlock(6).iShape = 1

	gBlock(7).iColor = 9  ' light blue
	gBlock(7).iFlags = cBlockIsSlope
	gBlock(7).iShape = 2

	' Load map data
	mapFromData

	' Load slope data
	slopeFromData

	' Set actor's current location and bounding box
	gActor(0).fX = 64
	gActor(0).fY = 48
	gActor(0).iBBoxW = 7
	gActor(0).iBBoxH = 18

	SCREEN 13
	mapDraw

	' Redraw actor (copy background)
	iBackX = INT(gActor(0).fX) - gActor(0).iBBoxW
	iBackY = INT(gActor(0).fY) - gActor(0).iBBoxH
	iBackW = 1 + gActor(0).iBBoxW * 2
	iBackH = gActor(0).iBBoxH
	GET (iBackX, iBackY)-STEP(iBackW, iBackH), 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
					' The actor is only allowed to jump when it's on the
					' ground.
					IF (gActor(0).iFlags AND cActorOnGround) THEN
						gActor(0).fVelY = -1.2
					END IF
				CASE cKeyRt
					' Make "walking" a toggle to allow the keyboard buffer
					' to breath (choking happens when the keyboard buffer
					' is filled with too many inputs and we don't have the
					' time to process them all - it happens on genuine
					' hardware but not in DOSBox.) Same logic for cKeyLf.
					IF (gActor(0).fVelX) THEN
						gActor(0).fVelX = 0
					ELSE
						gActor(0).fVelX = .5
					END IF
				CASE cKeyLf
					IF (gActor(0).fVelX) THEN
						gActor(0).fVelX = 0
					ELSE
						gActor(0).fVelX = -.5
					END IF
				CASE cKeyEsc
					EXIT SUB
				END SELECT
			END IF

			' If the actor is not on the ground, apply gravity.
			IF ((gActor(0).iFlags AND cActorOnGround) = 0) THEN
				gActor(0).fVelY = gActor(0).fVelY + .02
			END IF

			' Process actor's physics.
			actorMove 0

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

		' Redraw actor (erase background as necessary)
		iBackTmpX = INT(gActor(0).fX) - gActor(0).iBBoxW
		iBackTmpY = INT(gActor(0).fY) - gActor(0).iBBoxH
		IF (iBackX <> iBackTmpX) OR (iBackY <> iBackTmpY) THEN
			PUT (iBackX, iBackY), iBackImg, PSET
			iBackX = iBackTmpX
			iBackY = iBackTmpY
			GET (iBackX, iBackY)-STEP(iBackW, iBackH), iBackImg
			actorDraw 0
		END IF
	LOOP
END SUB

''
'' Read data off gMapData() and display on-screen. The top-left
'' corner of the map is located at 0, 0 with positive values
'' going right and down.
''
SUB mapDraw
	DIM iR AS INTEGER, iC AS INTEGER
	DIM iX AS INTEGER, iY AS INTEGER
	DIM iRow AS INTEGER, iShape 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
			' On-screen horizontal offset.
			iX = iC * cCellWidth

			' Get block type.
			uBlock = gBlock(gMapData(iRow + iC))

			' Solid, fill and cross.
			IF (uBlock.iFlags AND cBlockIsSolid) THEN
				LINE (iX, iY)-STEP(cCellWidth - 1, cCellHeight - 1), uBlock.iColor, BF
				LINE (iX, iY)-STEP(cCellWidth - 1, cCellHeight - 1), 0
				LINE (iX + cCellWidth - 1, iY)-STEP(-(cCellWidth - 1), cCellHeight - 1), 0

			' Slope.
			ELSEIF (uBlock.iFlags AND cBlockIsSlope) THEN
				iShape = uBlock.iShape * cCellWidth
				FOR iAlt = 0 TO cCellWidth - 1
					LINE (iX + iAlt, iY + cCellHeight - 1)-STEP(0, -gSlope(iShape + iAlt)), uBlock.iColor
				NEXT iAlt

			' Non-solid.
			ELSE
				LINE (iX, iY)-STEP(cCellWidth - 1, cCellHeight - 1), uBlock.iColor, BF
			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

''
'' Setup slope types via DATA statements.
''
SUB slopeFromData
	DIM iSlope AS INTEGER, iFloor AS INTEGER, iIndex AS INTEGER

	' Read the floor offset of each slope.
	FOR iSlope = 0 TO cNumSlopes - 1
		iIndex = iSlope * cCellWidth
		FOR iFloor = 0 TO cCellWidth - 1
			READ gSlope(iIndex + iFloor)
		NEXT iFloor
	NEXT iSlope
END SUB