SuperStrict

Const GWIDTH :Int = 1024
Const GHEIGHT:Int = 768

InitGL()

SeedRnd(15)

New TPolygon.Create(GWIDTH/2, GHEIGHT/2, GWIDTH, 4, 255, 255, 255) 'White background
For Local I:Int = 0 Until 10
	New TPolygon.Create(Rnd(0, GWIDTH), Rnd(0, GHEIGHT), Rnd(20.0, 100.0), Rand(3, 16), Rand(64, 255), Rand(64, 255), Rand(64, 255))
Next

Local Light1:TLight = New TLight.Create(512, 384, 400.0, 180, 180, 180)
Local Light2:TLight = New TLight.Create(512, 384, 200.0, 180, 120, 120)

Local LightEffect:TLightEffect = New TLightEffect.Create(64, 64, 64) 'Adjust the ambient light as you see fit

Local Timer:TTimer = CreateTimer(60)
While Not (KeyHit(KEY_ESCAPE) Or AppTerminate())
	glClear(GL_COLOR_BUFFER_BIT)
	
	Light1.X = MouseX()
	Light1.Y = MouseY()
	
	Light2.X = GWIDTH /2 + Cos(MilliSecs()*0.05)*200.0
	Light2.Y = GHEIGHT/2 + Sin(MilliSecs()*0.05)*200.0
	
	LightEffect.Draw()
	
	Flip 0
	WaitTimer Timer
Wend

End

Function RenderScene()
	TPolygon.DrawAll() 'Replace with your own draw calls
End Function

Function InitGL()
	SetGraphicsDriver GLMax2DDriver()
	Graphics GWIDTH, GHEIGHT
	
	glewInit() 'Really important since the EXT functions won't get loaded otherwise
End Function

Function RoundToPow2:Int(Number:Int)
	Local Result:Int = 1
	
	While Result < Number
		Result :Shl 1
	Wend
	
	Return Result
End Function

Type TPolygonSegment 'A polygon segment is a line that can cast shadows
	Global SegmentList:TList = New TList
	
	Field X1:Float, Y1:Float
	Field X2:Float, Y2:Float
	
	Field NX:Float, NY:Float
	
	Method Create:TPolygonSegment(X1:Float, Y1:Float, X2:Float, Y2:Float, NX:Float, NY:Float)
		Self.X1 = X1
		Self.Y1 = Y1
		Self.X2 = X2
		Self.Y2 = Y2
		Self.NX = NX
		Self.NY = NY
		
		SegmentList.AddLast(Self)
		
		Return Self
	End Method
End Type

Type TPolygon 'Small helper class to draw minimalist polygons. Programmer art ftw
	Global Polygons:TList = New TList
	
	Field X:Float
	Field Y:Float
	Field Radius:Float
	Field Segments:Int
	Field R:Float, G:Float, B:Float
	
	Field VertexCoords:Float[,]
	
	Method Create:TPolygon(X:Float, Y:Float, Radius:Float, Segments:Int, R:Byte, G:Byte, B:Byte)
		Self.X = X
		Self.Y = Y
		Self.Radius = Radius
		Self.Segments = Segments
		Self.R = R/255.0
		Self.G = G/255.0
		Self.B = B/255.0
		Self.VertexCoords = New Float[Segments + 1, 2]
		
		Local AngleStep:Float = 360.0/Segments
		For Local I:Int = 0 To Segments
			VertexCoords[I, 0] = X + Cos(I*AngleStep)*Radius
			VertexCoords[I, 1] = Y + Sin(I*AngleStep)*Radius
			
			If I Then
				New TPolygonSegment.Create( ..
					VertexCoords[I    , 0], ..
					VertexCoords[I    , 1], ..
					VertexCoords[I - 1, 0], ..
					VertexCoords[I - 1, 1], ..
					Cos((I - 0.5)*AngleStep), ..
					Sin((I - 0.5)*AngleStep))
			EndIf
		Next
		
		Polygons.AddLast(Self)
		
		Return Self
	End Method
	
	Method Draw()
		glBegin(GL_TRIANGLE_FAN)
		
		glColor4f(R, G, B, 1.0)
		glVertex2f(X, Y)
		
		For Local I:Int = 0 To Segments
			glVertex2f(VertexCoords[I, 0], VertexCoords[I, 1])
		Next
		
		glEnd()
	End Method
	
	Function DrawAll()
		For Local Polygon:TPolygon = EachIn Polygons
			Polygon.Draw()
		Next
	End Function
End Type

Type TLightEffect
	Field ShaderV:TShader
	Field ShaderH:TShader
	
	Field FBO:TFrameBufferObject
	Field Textures:Int[2]
	
	Field AmbientR:Float, AmbientG:Float, AmbientB:Float
	
	Field UMax:Float, VMax:Float
	Field BlurStepV:Float, BlurStepH:Float
	
	Method Create:TLightEffect(AmbientR:Byte, AmbientG:Byte, AmbientB:Byte)
		Self.AmbientR = AmbientR*(1.0/255.0)
		Self.AmbientG = AmbientG*(1.0/255.0)
		Self.AmbientB = AmbientB*(1.0/255.0)
		
		FBO = New TFrameBufferObject.Create()
		FBO.Bind()
		
		'Textures must have power of two sizes, so we'll have to adjust the screen size if necessary
		Local Pow2Width :Int = RoundToPow2(GWIDTH)
		Local Pow2Height:Int = RoundToPow2(GHEIGHT)
		
		'Since the texture may be bigger than the screen, we'll have to adjust UV-coordinates to avoid stretching
		UMax = GWIDTH /Float(Pow2Width)
		VMax = GHEIGHT/Float(Pow2Height)
		
		'Blur radius is at most 1.5 pixels - adjust this as you see fit
		BlurStepH = 1.5/Float(Pow2Width)
		BlurStepV = 1.5/Float(Pow2Height)
		
		glEnable(GL_TEXTURE_2D)
		glGenTextures(2, Varptr Textures[0])
		For Local I:Int = 0 To 1
			glBindTexture(GL_TEXTURE_2D, Textures[i])
			glTexImage2D(GL_TEXTURE_2D, 0, 4, Pow2Width, Pow2Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, Null)
			
			glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP)
			glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP)
			glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR)
			glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR)
			glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAX_LEVEL, 0)
		Next
		
		glBindTexture(GL_TEXTURE_2D, 0)
		FBO.Unbind()
		
		glDisable(GL_TEXTURE_2D)
		
		ShaderH = New TShader.Load("GaussianBlur_Vertex.txt", "GaussianBlur_FragmentH.txt")
		glUniform1iARB(glGetUniformLocationARB(ShaderH.ProgramObject, "Texture"), 0)
		
		ShaderV = New TShader.Load("GaussianBlur_Vertex.txt", "GaussianBlur_FragmentV.txt")
		glUniform1iARB(glGetUniformLocationARB(ShaderV.ProgramObject, "Texture"), 0)
		
		ShaderV.Disable()
		
		Return Self
	End Method
	
	Method Draw()
		Local OldBlend:Int = GetBlend() 'Since we don't want to mess with the current graphics state too much
		Local OldR:Int, OldG:Int, OldB:Int
		GetColor(OldR, OldG, OldB)
		
		Local OldA:Float = GetAlpha()
		Local OldClsR:Int, OldClsG:Int, OldClsB:Int
		GetClsColor(OldClsR, OldClsG, OldClsB)
		
		Local OldVX:Int, OldVY:Int, OldVW:Int, OldVH:Int
		GetViewport(OldVX, OldVY, OldVW, OldVH)
		
		'All states saved - time to go nuts
		glMatrixMode(GL_PROJECTION)
		glPushMatrix()
		glLoadIdentity()
		glOrtho(0, GWIDTH, GHEIGHT, 0, -1, 1)
		
		glMatrixMode(GL_MODELVIEW)
		glPushMatrix()
		glLoadIdentity()
		
		glEnable(GL_TEXTURE_2D)
		glDisable(GL_BLEND)
		glDisable(GL_SCISSOR_TEST)
		glDisable(GL_ALPHA_TEST)
		
		'Render to our FBO instead of the screen
		FBO.Bind()
		
		'Texture0 contains the final lightmap
		'Clear it before use
		FBO.AttachTexture(Textures[0])
		glClearColor(AmbientR, AmbientG, AmbientB, 0.0)
		glClear(GL_COLOR_BUFFER_BIT)
		
		For Local Light:TLight = EachIn TLight.Lights 'Note: You should add a check to only draw light sources that are visible on the screen for performance reasons
			'Use Texture1 (intermediate lighting results) as render target
			FBO.AttachTexture(Textures[1])
			glClear(GL_COLOR_BUFFER_BIT)
			
			'Draw lights and shadow into Texture1
			Light.Draw()
			Light.DrawShadow()
			
			'Switch to Texture0 again and draw a full screen quad using Texture1
			FBO.AttachTexture(Textures[0])
			glBindTexture(GL_TEXTURE_2D, Textures[1])
			
			glEnable(GL_BLEND)
			glBlendFunc(GL_ONE, GL_ONE) 'Additive blending
			
			glColor4f(Light.R, Light.G, Light.B, 1.0)
			glBegin(GL_QUADS)
				glTexCoord2f( 0.0, VMax); glVertex2f(   0.0,     0.0)
				glTexCoord2f(UMax, VMax); glVertex2f(GWIDTH,     0.0)
				glTexCoord2f(UMax,  0.0); glVertex2f(GWIDTH, GHEIGHT)
				glTexCoord2f( 0.0,  0.0); glVertex2f(   0.0, GHEIGHT)
			glEnd()
			
			glBindTexture(GL_TEXTURE_2D, 0)
			glDisable(GL_BLEND)
		Next
		
		glColor4f(1.0, 1.0, 1.0, 1.0)
		
		'Gaussian blur
		'First to a horizontal blur of the lightmap, then a vertical blur
		'This gives slight aliasing artifacts compared to doing the blur in one go, but is faster
		'since only 14 texture lookups have to be done with this method as opposed to 49
		ShaderH.Enable()
		glUniform1fARB(glGetUniformLocationARB(ShaderH.ProgramObject, "BlurStep"), BlurStepH)
		
		glBindTexture(GL_TEXTURE_2D, Textures[0])
		FBO.AttachTexture(Textures[1])
		glBegin(GL_QUADS)
			glTexCoord2f( 0.0, VMax); glVertex2f(   0.0,     0.0)
			glTexCoord2f(UMax, VMax); glVertex2f(GWIDTH,     0.0)
			glTexCoord2f(UMax,  0.0); glVertex2f(GWIDTH, GHEIGHT)
			glTexCoord2f( 0.0,  0.0); glVertex2f(   0.0, GHEIGHT)
		glEnd()
		
		ShaderV.Enable()
		glUniform1fARB(glGetUniformLocationARB(ShaderV.ProgramObject, "BlurStep"), BlurStepV)
		
		glBindTexture(GL_TEXTURE_2D, Textures[1])
		FBO.AttachTexture(Textures[0])
		glBegin(GL_QUADS)
			glTexCoord2f( 0.0, VMax); glVertex2f(   0.0,     0.0)
			glTexCoord2f(UMax, VMax); glVertex2f(GWIDTH,     0.0)
			glTexCoord2f(UMax,  0.0); glVertex2f(GWIDTH, GHEIGHT)
			glTexCoord2f( 0.0,  0.0); glVertex2f(   0.0, GHEIGHT)
		glEnd()
		
		ShaderV.Disable()
		FBO.Unbind() 'Lighting is done and stored in Texture0, so unbind the FBO and carry on
		
		glBindTexture(GL_TEXTURE_2D, 0)
		glClear(GL_COLOR_BUFFER_BIT)
		
		
		'Restore old graphics state
		SetBlend(Not OldBlend) 'Set the blend mode to something different because otherwise the next SetBlend will get ignored
		SetBlend(OldBlend)
		SetColor(OldR, OldG, OldB)
		SetAlpha(OldA)
		SetClsColor(OldClsR, OldClsG, OldClsB)
		SetViewport(OldVX, OldVY, OldVW, OldVH)
		
		glMatrixMode(GL_PROJECTION)
		glPopMatrix()
		
		glMatrixMode(GL_MODELVIEW)
		glPopMatrix()
		
		RenderScene() 'Draw our scene normally
		
		OldBlend = GetBlend() 'Get current blend mode since it could have changed
		
		glDisable(GL_ALPHA_TEST)
		glEnable(GL_BLEND)
		glBlendFunc(GL_ZERO, GL_SRC_COLOR) 'Multiply lightmap on top
		
		glColor4f(1.0, 1.0, 1.0, 1.0)
		glBindTexture(GL_TEXTURE_2D, Textures[0])
		glBegin(GL_QUADS)
			glTexCoord2f( 0.0, VMax); glVertex2f(   0.0,     0.0)
			glTexCoord2f(UMax, VMax); glVertex2f(GWIDTH,     0.0)
			glTexCoord2f(UMax,  0.0); glVertex2f(GWIDTH, GHEIGHT)
			glTexCoord2f( 0.0,  0.0); glVertex2f(   0.0, GHEIGHT)
		glEnd()
		glBindTexture(GL_TEXTURE_2D, 0)
		
		SetBlend(OldBlend) 'Restore blend mode since we messed with it
	End Method
End Type

Type TLight
	Global Lights:TList = New TList
	
	Global LightTexture:Int
	
	Field X:Float
	Field Y:Float
	Field Radius:Float
	Field R:Float, G:Float, B:Float
	
	Method Create:TLight(X:Float, Y:Float, Radius:Float, R:Byte, G:Byte, B:Byte)
		Self.X = X
		Self.Y = Y
		Self.Radius = Radius
		Self.R = R/255.0
		Self.G = G/255.0
		Self.B = B/255.0
		
		Lights.AddLast(Self)
		
		If Not LightTexture Then
			LightTexture = GLTexFromPixmap(LoadPixmap("PointLight.png")) 'Replace with own texture(s) as needed
			
			glBindTexture(GL_TEXTURE_2D, LightTexture)
			glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE)
			glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE)
			glBindTexture(GL_TEXTURE_2D, 0)
		EndIf
		
		Return Self
	End Method
	
	Method Draw()
		glBindTexture(GL_TEXTURE_2D, LightTexture)
		glBegin(GL_QUADS)
		
		glColor4f(1.0, 1.0, 1.0, 1.0)
		glTexCoord2f(0.5 -           X *0.5/Radius, 0.5 -            Y *0.5/Radius); glVertex2f(   0.0,     0.0)
		glTexCoord2f(0.5 + (GWIDTH - X)*0.5/Radius, 0.5 -            Y *0.5/Radius); glVertex2f(GWIDTH,     0.0)
		glTexCoord2f(0.5 + (GWIDTH - X)*0.5/Radius, 0.5 + (GHEIGHT - Y)*0.5/Radius); glVertex2f(GWIDTH, GHEIGHT)
		glTexCoord2f(0.5 -           X *0.5/Radius, 0.5 + (GHEIGHT - Y)*0.5/Radius); glVertex2f(   0.0, GHEIGHT)
		
		glEnd()
		glBindTexture(GL_TEXTURE_2D, 0)
	End Method
	
	Method DrawShadow()
		glColor4f(0.0, 0.0, 0.0, 0.0)
		glBegin(GL_QUADS)
		For Local Segment:TPolygonSegment = EachIn TPolygonSegment.SegmentList 'Note: Add small check to only cast shadows from polygons that are within the radius of the light source
			Local DX1:Float = X - Segment.X1
			Local DY1:Float = Y - Segment.Y1
			
			If Segment.NX*DX1 + Segment.NY*DY1 < 0.0 Then 'Only consider line segments facing away from the light source
				Local DX2:Float = X - Segment.X2
				Local DY2:Float = Y - Segment.Y2
				
				If Abs(DX1) < 1.0 Or Abs(DY1) < 1.0 Then 'Get rid of erroneous small vectors
					DX1 :* 100.0
					DY1 :* 100.0
				EndIf
				
				If Abs(DX2) < 1.0 Or Abs(DY2) < 1.0 Then
					DX2 :* 100.0
					DY2 :* 100.0
				EndIf
				
				Local OX:Float = -Segment.NX*3.0 'Offset by small amount to get rid off white halo around objects due to shadow blurring
				Local OY:Float = -Segment.NY*3.0
				
				glVertex2f(Segment.X1 - DX1*Radius*2.0 + OX, Segment.Y1 - DY1*Radius*2.0 + OY)
				glVertex2f(Segment.X1                  + OX, Segment.Y1                  + OY)
				glVertex2f(Segment.X2                  + OX, Segment.Y2                  + OY)
				glVertex2f(Segment.X2 - DX2*Radius*2.0 + OX, Segment.Y2 - DY2*Radius*2.0 + OY)
			EndIf
		Next
		glEnd()
	End Method
End Type

Type TFrameBufferObject 'Warning: If FBOs aren't supported, this will most likely crash, since the EXT functions won't get loaded. Check for compatibility before using this type
	Field GLName:Int
	
	Method Create:TFrameBufferObject()
		glGenFramebuffersEXT(1, Varptr GLName)
		
		Return Self
	End Method
	
	Method AttachTexture(Texture:Int)
		glFramebufferTexture2DEXT(GL_FRAMEBUFFER_EXT, GL_COLOR_ATTACHMENT0_EXT, GL_TEXTURE_2D, Texture, 0)
	End Method
	
	Method Bind()
		glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, GLName)
	End Method
	
	Method Unbind()
		glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, 0)
	End Method
	
	Method Delete()
		'FBO reference tells us to get rid of all allocated FBOs by the time the application ends
		'I'm not sure whether this still holds true with today's drivers, but it doesn't hurt to do this
		glDeleteFramebuffersEXT(1, Varptr GLName)
	End Method
	
	Method CheckForErrors()
		Local Error:Int = glCheckFramebufferStatusEXT(GL_FRAMEBUFFER_EXT)
		
		Select Error
			Case GL_FRAMEBUFFER_COMPLETE
				Return
			Case GL_FRAMEBUFFER_INCOMPLETE_ATTACHMENT_EXT
				Throw "Incomplete attachment"
			Case GL_FRAMEBUFFER_INCOMPLETE_MISSING_ATTACHMENT_EXT
				Throw "Missing attachment"
			Case GL_FRAMEBUFFER_INCOMPLETE_DIMENSIONS_EXT
				Throw "Incomplete dimensions"
			Case GL_FRAMEBUFFER_INCOMPLETE_FORMATS_EXT
				Throw "Incomplete formats"
			Case GL_FRAMEBUFFER_INCOMPLETE_DRAW_BUFFER_EXT
				Throw "Incomplete draw buffer"
			Case GL_FRAMEBUFFER_INCOMPLETE_READ_BUFFER_EXT
				Throw "Incomplete read buffer"
			Case GL_FRAMEBUFFER_UNSUPPORTED_EXT
				Throw "Framebufferobjects unsupported"
		End Select
	End Method
End Type

Type TShader
	Field ProgramObject:Int
	
	Method Load:TShader(VertexPath:String, FragmentPath:String)
		Local VertexCode:String, FragmentCode:String
		
		Try
			VertexCode   = LoadText(VertexPath)
			FragmentCode = LoadText(FragmentPath)
		Catch Dummy:Object
			Return Null
		EndTry
		
		Create(VertexCode, FragmentCode)
		
		Return Self
	End Method
	
	Method Create:TShader(VertexCode:String, FragmentCode:String)
		If Not ProgramObject Then ProgramObject = glCreateProgramObjectARB()
		
		Local VertexShader  :Int = glCreateShaderObjectARB(GL_VERTEX_SHADER_ARB)
		Local FragmentShader:Int = glCreateShaderObjectARB(GL_FRAGMENT_SHADER_ARB)
		
		Local ErrorMessage:String
		
		_LoadShader(VertexCode, VertexShader)
		glCompileShaderARB(VertexShader)
		
		If _CheckForErrors(VertexShader, ErrorMessage) Then
			glDeleteObjectARB(VertexShader)
			
			Throw ErrorMessage
		EndIf
		
		_LoadShader(FragmentCode, FragmentShader)
		glCompileShaderARB(FragmentShader)
		
		If _CheckForErrors(FragmentShader, ErrorMessage) Then
			glDeleteObjectARB(VertexShader)
			glDeleteObjectARB(FragmentShader)
			
			Throw ErrorMessage
		EndIf
		
		glAttachObjectARB(ProgramObject, VertexShader)
		glAttachObjectARB(ProgramObject, FragmentShader)
		
		glDeleteObjectARB(VertexShader)
		glDeleteObjectARB(FragmentShader)
		
		glLinkProgramARB(ProgramObject)
		If _CheckForErrors(ProgramObject, ErrorMessage, False) Then Throw ErrorMessage
		
		Return Self
	End Method
	
	Method Enable()
		glUseProgramObjectARB(ProgramObject)
	End Method
	
	Method Disable()
		glUseProgramObjectARB(0)
	End Method
	
	Method GetUniformLocation:Int(Name:String)
		Return glGetUniformLocationARB(ProgramObject, Name)
	End Method
	
	Method Delete()
		glDeleteObjectARB(ProgramObject)
	End Method
	
	Function _LoadShader(ShaderCode:String, ShaderObject:Int)
		Local ShaderCodeC:Byte Ptr = ShaderCode.ToCString()
		Local ShaderCodeLen:Int    = ShaderCode.Length
		
		glShaderSourceARB(ShaderObject, 1, Varptr ShaderCodeC, Varptr ShaderCodeLen)
		
		MemFree(ShaderCodeC)
	End Function
	
	Function _CheckForErrors:Int(ShaderObject:Int, ErrorString:String Var, Compiled:Int = True)
		Local Successful:Int
		
		If Compiled Then
			glGetShaderiv (ShaderObject, GL_COMPILE_STATUS, Varptr Successful)
		Else
			glGetProgramiv(ShaderObject, GL_LINK_STATUS,    Varptr Successful)
		EndIf
		
		If Not Successful Then
			Local ErrorLength:Int
			glGetObjectParameterivARB(ShaderObject, GL_OBJECT_INFO_LOG_LENGTH_ARB, Varptr ErrorLength)
			
			Local Message:Byte Ptr = MemAlloc(ErrorLength), Dummy:Int
			
			glGetInfoLogARB(ShaderObject, ErrorLength, Varptr Dummy, Message)
			
			ErrorString = String.FromCString(Message)
			MemFree(Message)
			
			Return -1
		EndIf
		
		Return 0
	End Function
	
	Function CheckCompability:Int()
		Local Extensions:String = String.FromCString(Byte Ptr glGetString(GL_EXTENSIONS))
		Local GLVersion:String  = String.FromCString(Byte Ptr glGetString(GL_VERSION))
		Local GLVersionInt:Int  = GLVersion[.. 3].Replace(".", "").ToInt()
		
		If Extensions.Find("GL_ARB_shader_objects" ) >= 0 And ..
		   Extensions.Find("GL_ARB_vertex_shader"  ) >= 0 And ..
		   Extensions.Find("GL_ARB_fragment_shader") >= 0 Or GLVersionInt >= 20 Then Return True
		
		Return False
	End Function
End Type