rem ==================================================================
rem Mode 7 library, Java version.
rem
rem It's all fake.
rem
rem By Marcus.
rem ==================================================================

constant:
	M7_MAX_OBJECTS 200
	rem int.
	M7_OBJ_ID	0
	M7_OBJ_IMG	1
	M7_OBJ_CEL	2
	M7_OBJ_XZ	3

	rem float.
	M7_OBJ_X		0
	M7_OBJ_Z		1
	M7_OBJ_Y		2
	M7_OBJ_TX	3
	M7_OBJ_TZ	4
	M7_OBJ_W		5; rem unused.
	M7_OBJ_H		6
	M7_OBJ_D		7

	M7_X			0
	M7_Z			1
	M7_ANGLE		2
	M7_FLAG		2

visible:
	rem Objects.
	m7_Objects[M7_MAX_OBJECTS][4]
	m7_ObjectsF#[M7_MAX_OBJECTS][8]
	m7_ObjOrder[M7_MAX_OBJECTS]
	m7_ObjCount = 0

	rem Fog.
	m7_FogR
	m7_FogG
	m7_FogB
	m7_FogMin#
	m7_FogMax#
	m7_FogSpread#

	rem View.
	m7_ViewW
	m7_ViewH
	m7_MaxZ#

	rem Map.
	m7_MapW
	m7_MapH
	m7_Floor[][]
	m7_Flag[][]
	m7_Item[][]

hidden:

rem ==================================================================
rem Init view.
rem ==================================================================
procedure M7_Init(w, h, zMax#)
	m7_Objects[M7_MAX_OBJECTS][4]
	m7_ObjectsF#[M7_MAX_OBJECTS][8]
	m7_ObjOrder[M7_MAX_OBJECTS]
	m7_ObjCount
	rc_FogR
	rc_FogG
	rc_FogB
	rc_FogMin#
	rc_FogMax#
	rc_FogSpread#
	m7_ViewW = w
	m7_ViewH = h
	m7_MapW
	m7_MapH
	m7_Floor[][]
	m7_Flag[][]
	m7_Item[][]
	m7_MaxZ = zMax
endproc

function M7_GetMapWidth()
	return m7_MapW
endfunc

function M7_GetMapHeight()
	return m7_MapH
endfunc

rem ==================================================================
rem Render view.
rem ==================================================================
procedure M7_Render(viewx#, viewz#, viewy#, angle#, pitch, fov#)
	dx#
	dz#
	d#
	screenxstart#
	screendx#
	screendz#
	xi
	zi
	oldxi
	oldzi
	ustart#
	vstart#
	xf#
	zf#
	xk#
	zk#
	uend#
	vend#
	screenxend#
	screenzend#
	id

	viewy = max#(viewy, 0.01)
	
	fov = fov*0.5
	vfov# =  fov*float(m7_ViewH)/float(m7_ViewW)
	unit# = float(m7_ViewH/2)/tan(vfov)

	cosl# = cos(angle - fov)
	cosr# = cos(angle + fov)
	sinl# = sin(angle - fov)
	sinr# = sin(angle + fov)
	
	alpha
	h = m7_ViewH - 1
	for y = 0 to h
		if y - m7_ViewH/2 - pitch > 0
			z# = unit*viewy/float(y - m7_ViewH/2 - pitch)
			z = z/cos(fov)
			if z < m7_MaxZ
				alpha = int((z - m7_FogMin)*m7_FogSpread)
				if alpha < 255			
					set color m7_FogR, m7_FogG, m7_FogB, alpha
				else
					set color 255, 255, 255, 0
				endif

				xstart# = cosl*z + viewx
				xend# = cosr*z + viewx
				zstart# = sinl*z + viewz
				zend# = sinr*z + viewz

				dx = xend - xstart
				dz = zend - zstart

				d# = sqr(dx*dx + dz*dz)

				k# = 1.0/d
				dx = dx*k
				dz = dz*k

				screenxstart = 0.0
				screendx = float(m7_ViewW)/d

				if xstart < 0.0
					xi = int(xstart) - 1
				else
					xi = int(xstart)
				endif
				if zstart < 0.0
					zi = int(zstart) - 1
				else
					zi = int(zstart)
				endif

				ustart = xstart - float(int(xstart))
				vstart = zstart - float(int(zstart))
				rowDone = false
				do; rem r_row_loop
					oldxi = xi
					oldzi = zi

					rem dx step.
					if dx < 0.0
						if oldxi < 0
							break
						else
							xi = xi - 1
							xf = float(xi + 1)
							xk = (xf - xstart)/dx; rem byta ut dx mot 1/dx så det blir mul?
						endif
					elseif dx > 0.0
						if oldxi >= m7_MapW
							break
						else
							xi = xi + 1
							xf = float(xi)
							xk = (xf - xstart)/dx
						endif
					else
						xk = 100000.0
					endif
					
					rem dz step.
					if dz < 0.0
						if oldzi < 0
							break
						else
							zi = zi - 1
							zf = float(zi + 1)
							zk = (zf - zstart)/dz; rem byta ut dx mot 1/dx så det blir mul?
						endif
					elseif dz > 0.0
						if oldzi >= m7_MapH
							break
						else
							zi = zi + 1
							zf = float(zi)
							zk = (zf - zstart)/dz
						endif
					else
						zk = 100000.0
					endif

					if xk < zk
						if dz < 0.0
							zi = zi + 1
						elseif dz > 0.0
							zi = zi - 1
						endif

						if dx <= 0.0
							uend = 0.0
						else
							uend = 1.0
						endif

						xend = xf
						zend = xk*dz + zstart
						vend = zend - float(int(zend))
						screenxend = xk*screendx + screenxstart
					else
						if dx < 0.0
							xi = xi + 1
						elseif dx > 0.0
							xi = xi - 1
						endif

						if dz <= 0.0
							vend = 0.0
						else
							vend = 1.0
						endif

						zend = zf
						xend = zk*dx + xstart
						uend = xend - float(int(xend))
						screenxend = zk*screendx + screenxstart

					endif

					if oldxi >= 0 and oldxi < m7_MapW and oldzi >= 0 and oldzi < m7_MapH
						if m7_Floor[oldxi][oldzi] > 0
							draw hraster m7_Floor[oldxi][oldzi], y, int(screenxstart), int(screenxend), ustart, vstart, uend, vend
						endif
					endif
	
					xstart = xend
					zstart = zend
					screenxstart = screenxend

					if uend = 0.0
						ustart = 1.0
					elseif uend = 1.0
						ustart = 0.0
					else
						ustart = uend
					endif	

					if vend = 0.0
						vstart = 1.0
					elseif vend = 1.0
						vstart = 0.0
					else
						vstart = vend
					endif	

					if screenxend >= float(m7_ViewW) then break
				until rowDone
			endif
		endif
	next

  	proc M7_RenderObjects viewx, viewz, viewy, angle, pitch, fov*2.0
endproc

rem ==================================================================
rem Render objects.
rem ==================================================================
procedure M7_RenderObjects(viewx#, viewz#, viewy#, angle#, pitch, fov#)
	proc M7_ProcessObjects viewx, viewz, angle

	vfov# =  fov*float(m7_ViewH)/float(m7_ViewW)
	unit# = float(m7_ViewW/2)/tan(fov*0.5)

	index
	img
	cel
	for i = 0 to m7_ObjCount - 1
		index = m7_ObjOrder[i]
		rem Check if object is active.
		if m7_Objects[index][M7_OBJ_ID] = 0
			break
		else
			img = m7_Objects[index][M7_OBJ_IMG]
			cel = m7_Objects[index][M7_OBJ_CEL]

			u_x# = cos(angle)
			u_z# = sin(angle)
			v_x# = m7_ObjectsF[index][M7_OBJ_X] - viewx
			v_z# = m7_ObjectsF[index][M7_OBJ_Z] - viewz
			hyp# = sqr(v_x*v_x + v_z*v_z)
			if hyp > 0.0
				k# = 1.0/hyp
				v_x = v_x*k
				v_z = v_z*k

				dp# = v_x*u_x + v_z*u_z
				if dp > 0.1
					if dp >= 1.0
						a# = 0.0
					else
						a# = acos(dp)
					endif

	
					d# = hyp*cos(a)

					if d < m7_MaxZ
						if u_x*v_z - u_z*v_x < 0.0
							tx# = float(m7_ViewW/2) - unit*tan(a)
						else
							tx# = float(m7_ViewW/2) + unit*tan(a)
						endif

						unit# = float(m7_ViewH/2)/tan(vfov*0.5)
	
						ystart = int(unit*(viewy - m7_ObjectsF[index][M7_OBJ_Y] - m7_ObjectsF[index][M7_OBJ_H])/d + float(m7_ViewH/2 + pitch))
						yend = int(unit*(viewy - m7_ObjectsF[index][M7_OBJ_Y])/d + float(m7_ViewH/2 + pitch))
	
						w = width(img)*(yend - ystart)/height(img)

						proc M7_DrawImage img, int(tx) - w/2, ystart, w, yend - ystart, cel%cols(img), cel/cols(img), d

					endif
				endif
			endif
		endif
	next
endproc

procedure MSG(msg$)
	set color 0, 0 ,0
	cls
	set color 255, 255, 255
	set caret 0, 0
	wln msg
	redraw
	wait keydown
endproc

procedure M7_DrawImage(img, imgx, imgy, w, h, col, row, z#)
	alpha = int((z - m7_FogMin)*m7_FogSpread)

	if alpha < 255
		set color m7_FogR, m7_FogG, m7_FogB, alpha
	else
		set color 255, 255, 255, 0
	endif

	celw# = 1.0/float(cols(img))
	celh# = 1.0/float(rows(img))
	u# = float(col)*celw
	uend# = u + celw
	v# = float(row)*celh
	vend# = v + celh

	ustep# = celw#/float(w)

	if imgx < 0
		u = u + ustep*float(-imgx)
		w = w + imgx
		imgx = 0
	endif

	xend = min(imgx + w, m7_ViewW - 1)
	
	h = imgy + h
	

	for x = imgx to xend
		draw vraster img, x, imgy, h, u, v, u, vend
		u = u + ustep
	next
endproc


rem ==================================================================
rem Clear objects.
rem ==================================================================
procedure M7_ClearObjects()
	m7_ObjCount = 0
	for i = 0 to M7_MAX_OBJECTS - 1
		m7_Objects[i][M7_OBJ_ID] = 0
		m7_ObjOrder[i] = 0
	next
endproc

rem ==================================================================
rem 
rem ==================================================================
procedure M7_AddObject(id, img, x#, z#, y#, h#, cel, item_x, item_z)
	index = - 1
	for i = 0 to M7_MAX_OBJECTS - 1
		if m7_Objects[i][M7_OBJ_ID] = 0
			index = i
			break
		endif
	next

	if index >= 0
		m7_Objects[index][M7_OBJ_ID] = id
		m7_Objects[index][M7_OBJ_IMG] = img
		m7_Objects[index][M7_OBJ_CEL] = cel
		if item_x >= 0
			m7_Objects[index][M7_OBJ_XZ] = item_z*m7_MapW + item_x
		else
			m7_Objects[index][M7_OBJ_XZ] = -1
		endif
		m7_ObjectsF[index][M7_OBJ_X] = x
		m7_ObjectsF[index][M7_OBJ_Z] = z
		m7_ObjectsF[index][M7_OBJ_Y] = y
		m7_ObjectsF[index][M7_OBJ_H] = h
		m7_ObjOrder[m7_ObjCount] = index
		m7_ObjCount = m7_ObjCount + 1

	endif
endproc

rem ==================================================================
rem 
rem ==================================================================
procedure M7_ModifyObject(id, img, x#, z#, y#, h#, cel)
	index = -1
	for i = 0 to M7_MAX_OBJECTS - 1
		if m7_Objects[i][M7_OBJ_ID] = id
			index = i
			break
		endif
	next

	if index >= 0
		m7_Objects[index][M7_OBJ_IMG] = img
		m7_Objects[index][M7_OBJ_CEL] = cel
		m7_ObjectsF[index][M7_OBJ_X] = x
		m7_ObjectsF[index][M7_OBJ_Z] = z
		m7_ObjectsF[index][M7_OBJ_Y] = y
		m7_ObjectsF[index][M7_OBJ_H] = h
	endif
endproc

rem ==================================================================
rem 
rem ==================================================================
procedure M7_RemoveObject(id)
	index = -1
	for i = 0 to M7_MAX_OBJECTS - 1
		if m7_Objects[i][M7_OBJ_ID] = id
			index = i
			break
		endif
	next

	if index >= 0
		m7_Objects[index][M7_OBJ_ID] = 0
		if m7_Objects[index][M7_OBJ_XZ] >= 0
			m7_Items[m7_Objects[index][M7_OBJ_XZ]%m7_MapW][m7_Objects[index][M7_OBJ_XZ]/m7_MapW] = 0
		endif

		for i = 0 to M7_MAX_OBJECTS - 1
			if m7_ObjOrder[i] = index
				for j = i to m7_ObjCount - 2
					m7_ObjOrder[j] = m7_ObjOrder[j + 1]
				next
				m7_ObjCount = m7_ObjCount - 1
				break
			endif
		next
	endif
endproc

procedure M7_RemoveObjectByIndex(index)
	m7_Objects[index][M7_OBJ_ID] = 0

	for i = 0 to M7_MAX_OBJECTS - 1
		if m7_ObjOrder[i] = index
			for j = i to m7_ObjCount - 2
				m7_ObjOrder[j] = m7_ObjOrder[j + 1]
			next
			m7_ObjCount = m7_ObjCount - 1
			break
		endif
	next
endproc

rem ==================================================================
rem 
rem ==================================================================
function M7_HasObject(id)
	index = -1
	for i = 0 to M7_MAX_OBJECTS - 1
		if m7_Objects[i][M7_OBJ_ID] = id
			index = i
			break;
		endif
	next
	if index >= 0 then return true
	return false
endfunc

rem ==================================================================
rem Process objects before rendering.
rem ==================================================================
procedure M7_ProcessObjects(xpos#, zpos#, angle#)
	for i = 0 to M7_MAX_OBJECTS - 1
		if m7_Objects[i][M7_OBJ_ID] <> 0
			dx# = m7_ObjectsF[i][M7_OBJ_X] - xpos
			dz# = m7_ObjectsF[i][M7_OBJ_Z] - zpos
			m7_ObjectsF[i][M7_OBJ_D] = dx*dx + dz*dz
		endif
	next
	proc M7_SortObjects
endproc

rem ==================================================================
rem Sort objects.
rem    Yes, bubble sort is used, since the changes in the list are
rem usually very small.
rem ==================================================================
procedure M7_SortObjects()
	beg = 0
	endi = m7_ObjCount - 2
	do
		noswap = true
		for i = beg to endi
			if m7_ObjectsF[m7_ObjOrder[i]][M7_OBJ_D] < m7_ObjectsF[m7_ObjOrder[i + 1]][M7_OBJ_D]
				tmp = m7_ObjOrder[i]
				m7_ObjOrder[i] = m7_ObjOrder[i + 1]
				m7_ObjOrder[i + 1] = tmp
				noswap = false
			endif
		next
		beg = beg + 1
	until noswap
endproc

rem ==================================================================
rem 
rem ==================================================================
function M7_LoadMap[][](filename$)
	flags[][]

	open file 0, filename$
	if not file(0) then return flags

	for i = len(filename) - 1 downto 0
		if mid$(filename, i) = "/"
			pos = i + 1
			break
		endif
	next
	path$ = left$(filename, pos)

	rem Images.
	count = read(0)
	for i = 0 to count - 1
		index = read(0)
		load image index + 1000, path + read$(0)
		ck = read(0)
		ckr = read(0)
		ckg = read(0)
		ckb = read(0)
		if ck then set image colorkey index + 1000, ckr, ckg, ckb
	next

	rem Objects.
	objects[64][4]
	count = read(0)
	for i = 0 to count - 1
		index = read(0)
		objects[index][0] = read(0)
		objects[index][1] = read(0)
		objects[index][2] = read(0)
		objects[index][3] = read(0)
	next

	rem Fog.
	fogActive = read(0)
	fogR = read(0)
	fogG = read(0)
	fogB = read(0)
	fogZMin# = read#(0)
	fogZMax# = read#(0)

	rem Map.
	mapW = read(0)
	mapH = read(0)
	map[mapW][mapH][6]

	for i = 0 to 5
		for z = 0 to mapH - 1
			for x = 0 to mapW - 1
				map[x][z][i] = read(0)
			next
		next
	next
	playerX = read(0)
	playerZ = read(0)
	playerAngle = read(0)
	free file 0

	if fogActive
		proc M7_SetFog fogR, fogG, fogB, fogZMin, fogZMax
	endif

	proc M7_InitMap mapW, mapH

	WALL			= 0
	FLOOR			= 1
	CEILING		= 2
	OBJECT		= 3
	GAME_FLAG	= 4
	LOADER_FLAG	= 5
	flagCount = 0

	for z = 0 to mapH - 1
		for x = 0 to mapW - 1
			if map[x][z][LOADER_FLAG] then flagCount = flagCount + 1
			if map[x][z][FLOOR]
				proc M7_SetFloor x, z, map[x][z][FLOOR] + 1000
			endif
			proc M7_SetFlag x, z, map[x][z][GAME_FLAG]
			if map[x][z][OBJECT]

				obj = map[x][z][OBJECT]
				rem [index][image, align, obstacle, size]
				img = objects[obj][0]
				if img and image(img + 1000)
					img = img + 1000
					h# = float(objects[obj][3])/1000.0
					proc M7_AddObject -1, img, float(x) + 0.5, float(z) + 0.5, 0.0, h, 0, x, z
					proc M7_SetItem x, z, map[x][z][OBJECT]
				endif

			endif
		next
	next

	flags[flagCount + 1][3]
	flags[0][0] = playerX
	flags[0][1] = playerZ
	flags[0][2] = playerAngle
	index = 1
	for z = 0 to mapH - 1
		for x = 0 to mapW - 1
			if map[x][z][LOADER_FLAG]
				flags[index][0] = x
				flags[index][1] = z
				flags[index][2] = map[x][z][LOADER_FLAG]
				index = index + 1
			endif
		next
	next

	return flags	
endfunc

rem ==================================================================
rem 
rem ==================================================================
procedure M7_InitMap(w, h)
	m7_MapW = w
	m7_MapH = h
	m7_Floor[w][h]
	m7_Flag[w][h]
	m7_Item[w][h]
	proc M7_ClearObjects
endproc

rem ==================================================================
rem 
rem ==================================================================
procedure M7_SetFog(r, g, b, zMin#, zMax#)
	m7_FogR = r
	m7_FogG = g
	m7_FogB = b
	m7_FogMin = zMin#
	m7_FogMax = zMax#
	m7_FogSpread = 255.0/(zMax - zMin)
	m7_MaxZ = zMax
endproc

rem ==================================================================
rem 
rem ==================================================================
procedure M7_SetFloor(x, z, img)
	m7_Floor[x][z] = img
endproc

rem ==================================================================
rem 
rem ==================================================================
procedure M7_SetFlag(x, z, flag)
	m7_Flag[x][z] = flag
endproc

rem ==================================================================
rem 
rem ==================================================================
procedure M7_SetItem(x, z, item)
	m7_Item[x][z] = item
endproc

procedure M7_RemoveItem(x, z)
	m7_Item[x][z] = 0
	xz = z*m7_MapW + x
	s = M7_MAX_OBJECTS - 1
	for i = 0 to s
		id = m7_Objects[i][M7_OBJ_ID]
		if id <> 0
			if m7_Objects[i][M7_OBJ_XZ] = xz
				proc M7_RemoveObjectByIndex(i)
				break
			endif
		endif
	next
endproc

rem ==================================================================
rem 
rem ==================================================================
function M7_GetFloor(x, z)
	return m7_Floor[x][z] - 1000
endfunc

function M7_GetFloorImage(x, z)
	return m7_Floor[x][z]
endfunc

function M7_GetImage(img_index)
	return img_index + 1000
endfunc

rem ==================================================================
rem 
rem ==================================================================
function M7_GetFlag(x, z)
	return m7_Flag[x][z]
endfunc

rem ==================================================================
rem 
rem ==================================================================
function M7_GetItem(x, z)
	return m7_Item[x][z]
endfunc

function M7_GetFlagPos[](flag)
	pos[]
	if sizeof(m7_Flag) = 0 then return pos
	for z = 0 to m7_MapH - 1
		for x = 0 to m7_MapW - 1
			if m7_Flag[x][z] = flag
				pos[] = [x, z]
				break
			endif
		next
	next
	return pos
endfunc