CameraRange

Const GWIDTH = 800
Const GHEIGHT = 600

Graphics GWIDTH, GHEIGHT, 0, 2
SetBuffer BackBuffer()

Const ANGLEOFVIEW = 60
Const CASTINGSTEP# = ANGLEOFVIEW/Float( GWIDTH )
Const DIST_NEAR	= 1
Const DIST_FAR	= 196
Const STEPSIZE# = 0.8

Dim HeightMap( 0, 0 )
Dim MapColor( 0, 0 )
Dim YBuffer( GWIDTH - 1 )

Global CamX# = 106, CamY# = 200, CamHeight# = 0, CamAngle# = -37, CamScale# = 1, ScaleY# = 200
Global MapWidth, MapHeight, Interpolate = True

LoadHeightMap( "Heightmap2.png" )
LoadColorMap( "Albedo.jpg" )

Timer = CreateTimer( 60 )

While Not KeyHit( 1 )
	Cls
	
	LockBuffer BackBuffer()
	RenderMap()
	UnlockBuffer BackBuffer()
	
	UserInput()
	
	Flip 0
	WaitTimer Timer
Wend
End

Function UserInput()
	CamX# = CamX# + Cos( CamAngle# )*( KeyDown( 200 ) - KeyDown( 208 ) )
	CamY# = CamY# - Sin( CamAngle# )*( KeyDown( 200 ) - KeyDown( 208 ) )
	
	CamHeight# = 500
	If CamX# >= 0 And CamX# < MapWidth Then
		If CamY# >= 0 And CamY# < MapHeight Then
			CamHeight# = HeightMap( CamX#, CamY# ) + 500
		EndIf
	EndIf
	
	CamAngle# = CamAngle# + KeyDown( 205 ) - KeyDown( 203 )
	
	Interpolate = Interpolate Xor KeyHit( 57 )
End Function

Function LoadHeightMap( Path$ )
	Image = LoadImage( Path$ )
	
	If Image Then
		MapWidth = ImageWidth( Image )
		MapHeight = ImageHeight( Image )
		
		Dim HeightMap( MapWidth - 1, MapHeight - 1 )
		
		LockBuffer ImageBuffer( Image )
		For X = 0 To MapWidth - 1
			For Y = 0 To MapHeight - 1
				HeightMap( X, Y ) = ( ReadPixelFast( X, Y, ImageBuffer( Image ) ) And $FF )*ScaleY#
			Next
		Next
		
		FreeImage Image
	Else
		RuntimeError "Heightmap does not exist!"
	EndIf
End Function

Function LoadColorMap( Path$ )
	Image = LoadImage( Path$ )
	
	If Image Then
		Dim MapColor( MapWidth - 1, MapHeight - 1 )
		
		LockBuffer ImageBuffer( Image )
		For X = 0 To MapWidth - 1
			For Y = 0 To MapHeight - 1
				MapColor( X, Y ) = ReadPixelFast( X, Y, ImageBuffer( Image ) ) And $FFFFFF
			Next
		Next
		
		FreeImage Image
	Else
		RuntimeError "Colormap does not exist!"
	EndIf
End Function

Function RenderMap()
	For X = 0 To GWIDTH - 1
		Angle# = -ANGLEOFVIEW/2 + X*CASTINGSTEP# + CamAngle#
		
		VX# = Cos( Angle# )
		VY# = -Sin( Angle# )
		
		XStart# = CamX# + VX#*DIST_NEAR
		YStart# = CamY# + VY#*DIST_NEAR
		XEnd# = CamX# + VX#*DIST_FAR
		YEnd# = CamY# + VY#*DIST_FAR
		
		TraceHeightMap( XStart#, YStart#, XEnd#, YEnd#, X )
	Next
	
	Dim YBuffer( GWIDTH - 1 )
End Function

Function TraceHeightMap( StartX#, StartY#, EndX#, EndY#, Column )
	DX = EndX# - StartX#
	DY = EndY# - StartY#
	
	ADX = Abs( DX )
	ADY = Abs( DY )
	
	SDX = Sgn( DX )
	SDY = Sgn( DY )
	
	If ADX > ADY Then
		PDX = SDX
		PDY = 0
		
		DDX = SDX
		DDY = SDY
		ErrorFast = ADY
		ErrorSlow = ADX
	Else
		PDX = 0
		PDY = SDY
		DDX = SDX
		DDY = SDY
		ErrorFast = ADX
		ErrorSlow = ADY
	EndIf
	
	X# = StartX#
	Y# = StartY#
	
	Error# = ErrorSlow/2
	
	For i = 1 To ErrorSlow/STEPSIZE
		Error = Error - ErrorFast*STEPSIZE
				
		If Error < 0 Then
			Error = Error + ErrorSlow*STEPSIZE
			
			X = X + DDX*STEPSIZE
			Y = Y + DDY*STEPSIZE
		Else
			X = X + PDX*STEPSIZE
			Y = Y + PDY*STEPSIZE
		EndIf
		
		If X >= 0 And X < MAPWIDTH Then
			If Y >= 0 And Y < MAPHEIGHT Then
				Z# = Sqr( ( X - CamX# )*( X - CamX# ) + ( Y - CamY# )*( Y - CamY# ) )
				
				If Interpolate Then
					Height# = ( HeightMap( Int( X# - 0.5 ), Int( Y# - 0.5 ) ) + HeightMap( Int( X# + 0.5 ), Int( Y# - 0.5 ) ) + HeightMap( Int( X# - 0.5 ), Int( Y# + 0.5 ) ) + HeightMap( Int( X# + 0.5 ), Int( Y# + 0.5 ) ) )/4.
					ProjY# = ( Height# - CamHeight# )*CamScale#/Z# + GHEIGHT/2
				Else
					ProjY# = ( HeightMap( X, Y ) - CamHeight# )*CamScale#/Z# + GHEIGHT/2
				EndIf
				
				If ProjY# > YBuffer( Column ) Then
					If Interpolate Then
						R = ( ( MapColor( Int( X# - 0.5 ), Int( Y# - 0.5 ) ) Shr 16 ) + ( MapColor( Int( X# + 0.5 ), Int( Y# - 0.5 ) ) Shr 16 ) + ( MapColor( Int( X# - 0.5 ), Int( Y# + 0.5 ) ) Shr 16 ) + ( MapColor( Int( X# + 0.5 ), Int( Y# + 0.5 ) ) Shr 16 ) )/4
						G = ( ( ( MapColor( Int( X# - 0.5 ), Int( Y# - 0.5 ) ) Shr 8 ) And $FF ) + ( ( MapColor( Int( X# + 0.5 ), Int( Y# - 0.5 ) ) Shr 8 ) And $FF ) + ( ( MapColor( Int( X# - 0.5 ), Int( Y# + 0.5 ) ) Shr 8 ) And $FF ) + ( ( MapColor( Int( X# + 0.5 ), Int( Y# + 0.5 ) ) Shr 8 ) And $FF ) )/4
						B = ( ( MapColor( Int( X# - 0.5 ), Int( Y# - 0.5 ) ) And $FF ) + ( MapColor( Int( X# + 0.5 ), Int( Y# - 0.5 ) ) And $FF ) + ( MapColor( Int( X# - 0.5 ), Int( Y# + 0.5 ) ) And $FF ) + ( MapColor( Int( X# + 0.5 ), Int( Y# + 0.5 ) ) And $FF ) )/4
						Color R, G, B
					Else
						Color MapColor( X, Y ) Shr 16, ( MapColor( X, Y ) Shr 8 ) And $FF, MapColor( X, Y ) And $FF
					EndIf
					
					Line Column, GHEIGHT - ProjY#, Column, GHEIGHT - YBuffer( Column )
					YBuffer( Column ) = ProjY#
				EndIf
			EndIf
		EndIf
	Next
End Function