rem ==================================================================
rem Tile Based Platform Game Example
rem
rem Sprites by Ari Feldman, other graphics and music by Marcus.
rem
rem Sorry for the unstructured and badly commented code :-)
rem ==================================================================

visible:
	vNextFrameTime
	vFrameHold


visible:
	rem Level.
	vTiles[][]
	vLevelWidth
	TILES_IMAGE = 0
	vLevelX = 0
	LEVEL_BG_IMAGE = 2
	TMP_IMAGE = 3

	vTimer

	rem Player.
	PLAYER_IMAGE = 4
	vPlayerX = 16
	vPlayerY = 240 - 128 - 16
	vPlayerXSpd = 0
	vPlayerYSpd# = 0.0
	vPlayerStanding
	vPlayerBaseFrame
	vPlayerFrame
	vPlayerWalkSeq[] = [0, 1, 0, 2]
	vPlayerAnimTimer = 0

	vScore = 0
	vCoins = 0

	rem Enemies.
	MAX_ENEMIES = 16
	SNAKE_IMAGE = 5
	ENEMY_TYPE = 0
	ENEMY_X = 1
	ENEMY_Y = 2
	ENEMY_DX = 3
	ENEMY_DY = 4
	vEnemies[MAX_ENEMIES][6]
	vEnemyCounter = 0
	vEnemyFrame = 0
	vEnemyFrameCounter = 0

	rem Images.
	SCORE_100_IMAGE = 6
	STAR_IMAGE = 7

	rem Sound.
	JUMP_SOUND = 0
	CEILING_SOUND = 1
	ENEMY_HIT_SOUND = 2
	BONUS_SOUND = 3

	rem SimpleParticle library ... I just glued it to this place.
	vParticles[][]
	PRT_TYPE			= 0
	PRT_IMAGE		= 1
	PRT_CEL			= 2
	PRT_ADDITIVE	= 3

	vParticlesF#[][]
	PRT_PARAM	= 0
	PRT_SPEED	= 1
	PRT_X			= 2
	PRT_Y			= 3
	PRT_SRC_DX	= 4
	PRT_SRC_DY	= 5
	PRT_DST_DX	= 6
	PRT_DST_DY	= 7

	vParticleCounter
	vMaxParticles


hidden:

rem Init window and load images etc.
proc InitAndLoad

rem Max 100 particles at a time.
proc InitParticles 100

set redraw off

rem Show instructions.
set color 0, 0, 0
cls
set caret 160, 16
set color 255, 255, 0
center "A Tile Based Platform Game Example"
set color 255, 255, 255
center 
center "Use arrow keys to move character!"
center "Jump on the snakes to defeat them!"
center "Pick up coins and cherries for no reason!"
center ""
center "Click to start . . ."
redraw
wait mousebutton

rem Play music and enter main loop.
play music 0, true

do
	
	rem Load a level named 'level.txt'.
	proc LoadLevel "level.txt"

	rem Init constant frame rate thing.
	proc InitFrameHold 60
	do
		rem Has applet been terminated?
		if not running() 
			stop music 0
			end
		endif

		rem Screenshot.
		if keydown("s", true) then save image primary, "sceenshot.bmp"

		rem Maintain constant frame rate.
		proc HoldFrame

		rem Update Player
		playerDied = UpdatePlayer()
		proc UpdateEnemies
		proc UpdateParticles

		rem Scroll if player has passed the midle of the screen horizontally.
		if vPlayerX > vLevelX + 160
			proc ScrollLevel 2
		endif

		rem Draw background image with parallax effect.
		set color 255, 255, 255
		draw image LEVEL_BG_IMAGE, 0, 0, (vLevelX/2)%320, 0, 320, 240

		rem Draw things ...
		draw image PLAYER_IMAGE, vPlayerX - vLevelX - 1, vPlayerY - 4, vPlayerBaseFrame + vPlayerFrame
		proc DrawEnemies
		proc RedrawLevel
		proc DrawScoreEtc
		proc DrawParticles

		rem Copy to window.
		redraw
	until keydown(27, true) or playerDied

loop

rem ==================================================================
rem Init and load.
rem ==================================================================
procedure InitAndLoad()
	set window 0, 0, 320, 240, false, true

	rem Load font.
	if javac()
		load font 0, "data_smb/impact16.txt", "data_smb/impact16.png"
	else
		load font 0, "data_smb/impact16.txt", "data_smb/impact16.bmp"
	endif

	set font 0

	set color 0, 0, 0
	cls
	set color 255, 255, 255
	set caret 160, 100
	center "Loading . . ."

	rem Create background image.
	load image TMP_IMAGE, "data_smb/bg0.bmp"
	create image LEVEL_BG_IMAGE, 320*2, 240
	set image LEVEL_BG_IMAGE
	set color 255, 255, 255
	draw image TMP_IMAGE, 0, 0
	draw image TMP_IMAGE, 320, 0
	set color 255, 255, 255
	free image TMP_IMAGE
	set image primary

	rem Player image.
	load image PLAYER_IMAGE, "data_smb/character.bmp"
	set image colorkey PLAYER_IMAGE, 255, 0, 255
	set image grid PLAYER_IMAGE, 4, 1
	
	rem Enemy snake image.
	load image SNAKE_IMAGE, "data_smb/snake.bmp"
	set image colorkey SNAKE_IMAGE, 255, 0, 255
	set image grid SNAKE_IMAGE, 4, 1

	rem Score 100 image.
	load image SCORE_100_IMAGE, "data_smb/100.bmp"
	set image colorkey SCORE_100_IMAGE, 255, 0, 255

	rem Star particle image.
	load image STAR_IMAGE, "data_smb/star.bmp"
	set image colorkey STAR_IMAGE, 255, 0, 255

	rem Load music.
	if javac()
		load music 0, "data_smb/forest.au"
	else
		load music 0, "data_smb/forest.xm"
	endif

	rem Load sounds.
	load sound JUMP_SOUND, "data_smb/jump.wav"
	load sound CEILING_SOUND, "data_smb/ceil.wav"
	load sound ENEMY_HIT_SOUND, "data_smb/enemyhit.wav"
	load sound BONUS_SOUND, "data_smb/bonus.wav"
endproc

rem ==================================================================
rem Load level.
rem ==================================================================
procedure LoadLevel(filename$)
	proc ClearEnemies
	proc ClearParticles

	vPlayerX = 16
	vPlayerY = 240 - 128 - 16
	vPlayerXSpd = 0
	vPlayerYSpd# = 0.0
	vPlayerStanding = false
	vPlayerBaseFrame = 0
	vPlayerFrame = 0
	
	vLevelX = 0
	
	open file 0, filename$

	load image TILES_IMAGE, read$(0)

	set image grid TILES_IMAGE, width(TILES_IMAGE)/16, height(TILES_IMAGE)/16
	set image colorkey TILES_IMAGE, 255, 0, 255
	vLevelWidth = read(0)
	vTiles[vLevelWidth][15]
	for y = 0 to 14
		for x = 0 to vLevelWidth - 1
			vTiles[x][y] = read(0)
		next
	next
	free file 0
endproc

rem ==================================================================
rem Redraw level.
rem ==================================================================
procedure RedrawLevel()
	xs = vLevelX/16
	offset = vLevelX%16
	set color 255, 255, 255
	for y = 0 to 14
		for x = 0 to 20
			draw image TILES_IMAGE, 16*x - offset, y*16, vTiles[xs + x][y]
		next
	next
endproc

rem ==================================================================
rem Scroll level.
rem ==================================================================
procedure ScrollLevel(step)
	vLevelX = vLevelX + step

	rem Add enemies.
	if vLevelX%16 = 0
		x = vLevelX/16 + 20
		for y = 0 to 14
			if vTiles[x][y] >= 40
				proc AddEnemy 1, x, y
				vTiles[x][y] = 0
			endif
		next
	endif
endproc


rem ==================================================================
rem Update player.
rem ==================================================================
function UpdatePlayer()
	rem Player's vertical speed should always increase, gravity that is.
	if vPlayerYSpd# < 6.0
		vPlayerYSpd# = min#(vPlayerYSpd# + 0.4, 6.0)
	endif

	rem Jump if player's standing and arrow key up is pressed.
	if vPlayerStanding and keydown(38)
		vPlayerYSpd# = -7.0
		play sound JUMP_SOUND
	endif

	vPlayerXSpd = 0

	rem Move left?
	if keydown(37)
		vPlayerXSpd = -2
		vPlayerBaseFrame = 2
		vPlayerAnimTimer = vPlayerAnimTimer + 1
		if vPlayerAnimTimer >= 8
			vPlayerFrame = 1 - vPlayerFrame
			vPlayerAnimTimer = 0
		endif
	rem Move right?
	elseif keydown(39)
		vPlayerXSpd = 2
		vPlayerBaseFrame = 0
		vPlayerAnimTimer = vPlayerAnimTimer + 1
		if vPlayerAnimTimer >= 8
			vPlayerFrame = 1 - vPlayerFrame
			vPlayerAnimTimer = 0
		endif
	else
		vPlayerFrame = 0
	endif

	if vPlayerYSpd# < 0.0 then vPlayerFrame = 1

	rem Call the move function with player's position and speed. The
	rem function handles collisions and returns a valid x and y.
	res[] = Move(vPlayerX, vPlayerY, vPlayerXSpd, int(vPlayerYSpd#), 14, 16, false)
	vPlayerX = res[0]
	vPlayerY = res[1]

	rem If res[2] is true, the player is on the ground.
	vPlayerStanding = res[2]

	rem Prevent player from leaving the screen (on the left).
	if vPlayerX - vLevelX < 0 then vPlayerX = vLevelX

	rem If res[3] is true the player has hit his head in something.
	if res[3] and vPlayerYSpd# < 0.0
		vPlayerYSpd# = 0.0
		play sound CEILING_SOUND
	endif

	rem Check for pickups.
	pickup = ItemAt(vPlayerX + 8, vPlayerY + 12)
	if pickup > 0
		rem Remove pickup.
		if pickup = 1
			vScore = vScore + 100
			proc AddParticle SCORE_100_IMAGE, 0, false, float(vPlayerX + 8 - vLevelX), float(vPlayerY - 4), 0.0, -1.0, 0.0, 0.0, 0.01, 0.0
		elseif pickup = 2
			vCoins = vCoins + 1
			proc AddStarPoff 84 + 8, 5 + 8
		endif
		play sound BONUS_SOUND		
		proc ChangeTile vPlayerX + 8, vPlayerY + 12, 0 
	endif	

	died = false
	rem Check for collisions with enemies.
	for i = 0 to MAX_ENEMIES - 1
		if vEnemies[i][ENEMY_TYPE]
			if vPlayerX + 16 > vEnemies[i][ENEMY_X] and vPlayerX < vEnemies[i][ENEMY_X] + 16
				if vPlayerY + 16 > vEnemies[i][ENEMY_Y] and vPlayerY < vEnemies[i][ENEMY_Y] + 16
					rem To hit or be hit.
					if vPlayerYSpd# > 0.0 and not vPlayerStanding
						vEnemies[i][ENEMY_TYPE] = 0
						rem Jump extra high if player's holding down the jump button.
						if keydown(38)
							vPlayerYSpd# = -8.0
						else
							vPlayerYSpd# = -4.0
						endif
						rem Add particle effects and score
						proc AddStarPoff vEnemies[i][ENEMY_X] + 8 - vLevelX, vEnemies[i][ENEMY_Y] + 8
						proc AddParticle SCORE_100_IMAGE, 0, false, float(vPlayerX + 8 - vLevelX), float(vPlayerY - 4), 0.0, -1.0, 0.0, 0.0, 0.01, 0.0
						vScore = vScore + 100
						play sound ENEMY_HIT_SOUND
					else
						rem Player has been hit.
						died = true
					endif
				endif 
			endif
		endif
	next

	if vPlayerY > 300 then died = true

	return died
endproc

rem ==================================================================
rem Return information about collision with bricks.
rem
rem In:
rem	x, y			position of object that is to be tested
rem	dx, dy		speed of object
rem	w, h			width and height of object
rem	safeDown		eh ... just something to make enemies turn early
rem					when they're close to a hole
rem
rem Out:
rem 	[0]			x after collision
rem	[1]			y after collision
rem	[2]			true if object is on the ground
rem	[3]			true if object has hit something with it's ... head
rem ==================================================================
function Move[](x, y, dx, dy, w, h, safeDown)
	bleft = false
	bright = false
	bup = false
	bdown = false

	if InsideBrick(x, y) = false and InsideBrick(x + dx, y) = true
		bleft = true
	elseif InsideBrick(x, y + h) = false and InsideBrick(x + dx, y +h - 1) = true
		bleft = true
	endif

	if InsideBrick(x + w - 1, y) = false and InsideBrick(x + w - 1 + dx, y) = true
		bright = true
	elseif InsideBrick(x + w - 1, y + h) = false and InsideBrick(x + w - 1 + dx, y + h - 1) = true
		bright = true
	endif

	if bleft
		x = x / 16
		x = x * 16
	elseif bright
		x = x + w + dx
		x = x/16
		x = x*16
		x = x - w
	else
		x = x + dx
	endif

	if dy < 0
		if InsideBrick(x, y) = false and InsideBrick(x, y + dy) then bup = true
		if InsideBrick(x + w - 1, y) = false and InsideBrick(x + w - 1, y + dy) = true then bup = true
	else
		if safeDown
			if InsideBrick(x + w/2, y + h - 1 + dy) then bdown = true
		else
			if InsideBrick(x, y + h - 1) = false and InsideBrick(x, y + h - 1 + dy) = true then bdown = true
			if InsideBrick(x + w - 1, y + h - 1) = false and InsideBrick(x + w - 1, y + h - 1 + dy) = true then bdown = true
		endif
	endif

	if bup
		y = y/16
		y = y*16
	elseif bdown
		y = y + h + dy
		y = y/16
		y = y*16
		y = y - h
	else
		y = y + dy
	endif

	return [x, y, bdown, bup]
endfunc

rem ==================================================================
rem Return true if point (x, y) is inside any brick.
rem ==================================================================
function InsideBrick(x, y)
	if x < 0 or x > vLevelWidth*16 then return true
	tx = x/16
	ty = y/16
	if tx < 0 or tx >= vLevelWidth then return true
	if ty < 0 or ty >= 15 then return false
	t = vTiles[tx][ty]
	if t >= 16 and t < 32 then return true
	return false
endfunc

rem ==================================================================
rem Return item id at (x, y).
rem ==================================================================
function ItemAt(x, y)
	tx = x/16
	ty = y/16
	if tx < 0 or tx >= vLevelWidth then return 0
	if ty < 0 or ty >= 15 then return 0
	t = vTiles[tx][ty]
	if t >= 32 then return t - 31
	return 0
endfunc

rem ==================================================================
rem Return tile at (x, y).
rem ==================================================================
function Tile(x, y)
	tx = x/16
	ty = y/16
	if tx < 0 or tx >= vLevelWidth or ty < 0 or ty >= 15
		return 16
	else
		return vTiles[tx][ty]
	endif
endfunc

rem ==================================================================
rem Change tile at (x, y) to tile.
rem ==================================================================
procedure ChangeTile(x, y, tile)
	tx = x/16
	ty = y/16
	if tx < 0 or tx >= vLevelWidth or ty < 0 or ty >= 15 then return
	vTiles[tx][ty] = tile
endproc

rem ==================================================================
rem Add star poff particle effect at (x, y)
rem ==================================================================
procedure AddStarPoff(x, y)
	astep = 360/8
	for i = 0 to 7
		dx# = cos(float(i*astep))
		dy# = sin(float(i*astep))
		proc AddParticle STAR_IMAGE, 0, false, float(x) + dx*4.0, float(y) + dy*4.0, dx, dy, 0.0, 0.0, 0.025, 0.0
	next
endproc

rem ==================================================================
rem Clear enemies.
rem ==================================================================
procedure ClearEnemies()
	for i = 0 to MAX_ENEMIES - 1
		vEnemies[i][ENEMY_TYPE] = 0
	next
endproc

rem ==================================================================
rem Add enemy.
rem ==================================================================
procedure AddEnemy(type, x, y)
	vEnemies[vEnemyCounter][ENEMY_TYPE] = type
	vEnemies[vEnemyCounter][ENEMY_X] = x*16
	vEnemies[vEnemyCounter][ENEMY_Y] = y*16

	rem Snake.
	if type = 1
		vEnemies[vEnemyCounter][ENEMY_DX] = -1
		vEnemies[vEnemyCounter][ENEMY_DY] = 0
	endif
	vEnemyCounter = (vEnemyCounter + 1)%MAX_ENEMIES
	vEnemyFrame = 0
	vEnemyFrameCounter = 0
endproc

rem ==================================================================
rem Update enemies.
rem ==================================================================
procedure UpdateEnemies()
	vEnemyFrameCounter = (vEnemyFrameCounter + 1)%8
	if vEnemyFrameCounter = 0 then vEnemyFrame = 1 - vEnemyFrame

	for i = 0 to MAX_ENEMIES - 1
		type = vEnemies[i][ENEMY_TYPE]
		if type
			if type = 1
				move[] = Move(vEnemies[i][ENEMY_X], vEnemies[i][ENEMY_Y], vEnemies[i][ENEMY_DX], 1, 16, 16, true)
				if vEnemies[i][ENEMY_X] = move[0] or move[2] = false
					vEnemies[i][ENEMY_DX] = - vEnemies[i][ENEMY_DX]
				endif
				vEnemies[i][ENEMY_X] = move[0]
			endif
			rem Remove enemy if it has disappeared to the left.
			if vEnemies[i][ENEMY_X] < vLevelX - 64 then vEnemies[i][ENEMY_TYPE] = 0
		endif
	next
endproc

rem ==================================================================
rem Draw enemies.
rem ==================================================================
procedure DrawEnemies()
	for i = 0 to MAX_ENEMIES - 1
		type = vEnemies[i][ENEMY_TYPE]
		if type
			if type = 1
				if vEnemies[i][ENEMY_DX] > 0
					draw image SNAKE_IMAGE, vEnemies[i][ENEMY_X] - vLevelX, vEnemies[i][ENEMY_Y] - 2, 0 + vEnemyFrame
				else
					draw image SNAKE_IMAGE, vEnemies[i][ENEMY_X] - vLevelX, vEnemies[i][ENEMY_Y] - 2, 2 + vEnemyFrame
				endif
			endif
		endif
	next
endproc

rem ==================================================================
rem Draw score etc.
rem ==================================================================
procedure DrawScoreEtc()
	set color 255, 255, 255
	set caret 4, 4
	set decimal 6, 1
	write "Score:  ", vScore

	draw image TILES_IMAGE, 84, 5, 33
	set caret 103, 4
	set decimal 2, 1
	write "x ", vCoins
endproc


rem ==================================================================
rem SimpleParticle.
rem
rem By Marcus.
rem ==================================================================


rem Init particles.
procedure InitParticles(maxParticles)
	vParticleCounter = 0
	vMaxParticles = maxParticles
	vParticles[vMaxParticles][4]
	vParticlesF#[vMaxParticles][8]
	for i = 0 to vMaxParticles - 1
		vParticles[i][PRT_TYPE] = 0
	next
endproc

rem Clear particles.
procedure ClearParticles()
	for i = 0 to vMaxParticles - 1
		vParticles[i][PRT_TYPE] = 0
	next
	vParticleCounter = 0
endproc

rem Add particle.
procedure AddParticle(img, cel, addMode, x#, y#, srcDX#, srcDY#, dstDX#, dstDY#, speed#, startParam#)
	vParticles[vParticleCounter][PRT_TYPE] = 1
	vParticles[vParticleCounter][PRT_IMAGE] = img
	vParticles[vParticleCounter][PRT_CEL] = cel
	vParticles[vParticleCounter][PRT_ADDITIVE] = addMode
	vParticlesF#[vParticleCounter][PRT_X] = x# - float(width(img))*0.5
	vParticlesF#[vParticleCounter][PRT_Y] = y# - float(height(img))*0.5
	vParticlesF#[vParticleCounter][PRT_PARAM] = startParam#
	vParticlesF#[vParticleCounter][PRT_SPEED] = speed#
	vParticlesF#[vParticleCounter][PRT_SRC_DX] = srcDX#
	vParticlesF#[vParticleCounter][PRT_SRC_DY] = srcDY#
	vParticlesF#[vParticleCounter][PRT_DST_DX] = dstDX#
	vParticlesF#[vParticleCounter][PRT_DST_DY] = dstDY#
	vParticleCounter = (vParticleCounter + 1)%vMaxParticles
endproc

rem Update particles.
procedure UpdateParticles()
	for i = 0 to vMaxParticles - 1
		if vParticles[i][PRT_TYPE] > 0
			prm# = vParticlesF#[i][PRT_PARAM]
			prm# = prm# + vParticlesF#[i][PRT_SPEED]
			if prm# > 1.0
				vParticles[i][PRT_TYPE] = 0
			else
				vParticlesF#[i][PRT_PARAM] = prm#
				dx# = (1.0 - prm#)*vParticlesF#[i][PRT_SRC_DX] + prm#*vParticlesF#[i][PRT_DST_DX]
				dy# = (1.0 - prm#)*vParticlesF#[i][PRT_SRC_DY] + prm#*vParticlesF#[i][PRT_DST_DY]
				vParticlesF#[i][PRT_X] = vParticlesF#[i][PRT_X] + dx#
				vParticlesF#[i][PRT_Y] = vParticlesF#[i][PRT_Y] + dy#
			endif
		endif
	next
endproc

rem Draw particles.
procedure DrawParticles()
	for i = 0 to vMaxParticles - 1
		if vParticles[i][PRT_TYPE] > 0
			set additive vParticles[i][PRT_ADDITIVE]
			set color 255, 255, 255, int((1.0 - vParticlesF#[i][PRT_PARAM])*255.0)
			draw image vParticles[i][PRT_IMAGE], int(vParticlesF#[i][PRT_X]), int(vParticlesF#[i][PRT_Y]), vParticles[i][PRT_CEL]
		endif
	next
	set additive false
	set color 255, 255, 255
endproc


rem ==================================================================
rem Init frame hold
rem ==================================================================
procedure InitFrameHold(speed)
	vNextFrameTime = time()
	vFrameHold = 1000/speed
endproc

rem ==================================================================
rem Hold frame to maintain constant speed.
rem ==================================================================
procedure HoldFrame()
	while time() < vNextFrameTime; wait 1; wend
	vNextFrameTime = vNextFrameTime + vFrameHold
endproc