'TShader class
'Special thx to Tom Speed and ChrisC


Global ProgramObjectList:TList = CreateList()
Global ShaderObjectList:TList = CreateList()

Global clog2:Byte[65535]' = MemAlloc(linked)
'Shader Object Type
Type tShaderObject
	Field ShaderObject:Int
	Field ShaderType:Int			' 1 = Vert, 2 = Frag
	Field Attached:TList			' Shaders can be attached, or 'referenced by', more than 1 ProgramObject
	Field shaderName:String
End Type

'Program Object Type
Type tProgramObject
	Field Program:Int		' The ProgramObject
	Field vList:TList		' Vertex shader list. A List of what Vert shaders are attached to this ProgramObject
	Field fList:TList		' Frag shader list. A List of what Frag shaders are attached to this ProgramObject
	Field progName:String
	
	Field vertShaderCount:Int
	Field fragShaderCount:Int



	'----------------------------------------------------
	'tProgramObject.Create(name:String)
	'
	'Creates a new Shader Program Object to which
	'multiple Vert and/or Frag Shaders can be attached to
	'
	'Returns: The newly created Program Objects ID if
	'         successful, or Null if it failed.
	'----------------------------------------------------
	Function Create:tProgramObject(name:String = "null")
		Local p:tProgramObject = New tProgramObject
		
		'Create a new GL ProgramObject
		p.Program = glCreateProgramObjectARB()
		Print p.program
		If p.Program = Null
			p = Null
			?Debug
				Print "Error: glCreateProgramObjectARB() failed"
			?
			Return Null
		End If
		
		'---------------------------------
		'The amount of Vert & Frag Shaders
		'attached to this Program Object
		'---------------------------------
		p.vertShaderCount = 0
		p.fragShaderCount = 0
	
		'---------------------------------------
		'These lists contain any Vert or Frag
		'Shader Objects Attached to this Program
		'---------------------------------------
		p.vList:TList = CreateList()
		p.fList:TList = CreateList()
		
		'This Program Objects Name
		p.progName = name
		
		'------------------------------
		'Add this Program Object to the
		'Global list of ProgramObjects
		'------------------------------
		ListAddLast ProgramObjectList, p
		Return p
	End Function

	
	'---------------------------------
	'tProgramObject.Activate()
	'
	'Activates (uses!) a ProgramObject
	'---------------------------------
	Method Activate()
		glUseProgramObjectARB(Program)
	End Method


	'----------------------------
	'tProgramObject.DeActivate()
	'
	'Turns off this ProgramObject
	'----------------------------
	Method DeActivate()
		glUseProgramObjectARB(0)
	End Method



	' Get the Uniform Variable Location from a ProgramObject
	Method GetUniLoc:Int(name:String)
		Return glGetUniformLocationARB(Program, Varptr name)
	End Method

	' Get the Attribute Variable Location from a ProgramObject
	Method GetAttribLoc:Int(name:String)
		Return glGetAttribLocationARB(Program, Varptr name)
	End Method
	

	' Set Uniform Variable Integer(s)
	Method SetUI1(name:String,val:Int)
		Local loc:Int = glGetUniformLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Uniform Var Location '"+name+"' in Method setUI1"
				Return
			End If
		?
		glUniform1iARB(loc,val)
	End Method

	Method SetUI2(name:String,val1:Int,val2:Int)
		Local loc:Int = glGetUniformLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Uniform Var Location '"+name+"' in Method setUI2"
				Return
			End If
		?
		glUniform2iARB(loc,val1,val2)
	End Method

	Method SetUI3(name:String,val1:Int,val2:Int,val3:Int)
		Local loc:Int = glGetUniformLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Uniform Var Location '"+name+"' in Method setUI3"
				Return
			End If
		?
		glUniform3iARB(loc,val1,val2,val3)
	End Method

	Method SetUI4(name:String,val1:Int,val2:Int,val3:Int,val4:Int)
		Local loc:Int = glGetUniformLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Uniform Var Location '"+name+"' in Method setUI4"
				Return
			End If
		?
		glUniform4iARB(loc,val1,val2,val3,val4)
	End Method

	Method getUI1:Int(name:String)
		Local loc:Int = glGetUniformLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Uniform Var Location '"+name+"' in Method getUI1"
				Return
			End If
		?
		Local val:Int = 10
		glGetUniformivARB(Program, loc, Varptr(val))
		Return val
	End Method
	
	
	' Set Uniform Variable Float(s)
	Method SetUF1(name:String,val:Float)
		Local loc:Int = glGetUniformLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Uniform Var Location '"+name+"' in Method setUF1"
				Return
			End If
		?
		glUniform1fARB(loc,val)
	End Method

	Method SetUF2(name:String,val1:Float,val2:Float)
		Local loc:Int = glGetUniformLocationARB(Program, name.ToCString() )
		?Debug
			If loc<0
				Print ">Error getting Uniform Var Location '"+name+"' in Method setUF2"
				Return
			End If
		?
		glUniform2fARB(loc,val1,val2)
	End Method

	Method SetUF3(name:String,val1:Float,val2:Float,val3:Float)
		Local loc:Int = glGetUniformLocationARB(Program, name.ToCString())

		?Debug
			If loc<0
				Print "Error getting Uniform Var Location '"+name+"' in Method setUF3"
				Return
			End If
		?
		glUniform3fARB(loc, val1, val2, val3)
	End Method

	Method SetUF4(name:String,val1:Float,val2:Float,val3:Float,val4:Float)
		Local loc:Int = glGetUniformLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Uniform Var Location '"+name+"' in Method setUF4"
				Return
			End If
		?
		glUniform4fARB(loc,val1,val2,val3,val4)
	End Method

	' Set Attribute Variable Short(s)
	Method SetAS1(name:String, val1:Short)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Attribute Var Location '"+name+"' in Method setAS1"
				Return
			End If
		?
		glVertexAttrib1sARB(loc, val1)
	End Method

	Method SetAS2(name:String, val1:Short, val2:Short)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Attribute Var Location '"+name+"' in Method setAS2"
				Return
			End If
		?
		glVertexAttrib2sARB(loc, val1, val2)
	End Method

	Method SetAS3(name:String, val1:Short, val2:Short, val3:Short)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Attribute Var Location '"+name+"' in Method setAS3"
				Return
			End If
		?
		glVertexAttrib3sARB(loc, val1, val2, val3)
	End Method

	Method SetAS4(name:String, val1:Short, val2:Short, val3:Short, val4:Short)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Attribute Var Location '"+name+"' in Method setAS4"
				Return
			End If
		?
		glVertexAttrib4sARB(loc, val1, val2, val3, val4)
	End Method
	
	' Set Attribute Variable Float(s)
	Method SetAF1(name:String, val1:Float)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Attribute Var Location '"+name+"' in Method setAF1"
				Return
			End If
		?
		glVertexAttrib1fARB(loc, val1)
	End Method

	Method SetAF2(name:String, val1:Float, val2:Float)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Attribute Var Location '"+name+"' in Method setAF2"
				Return
			End If
		?
		glVertexAttrib2fARB(loc, val1, val2)
	End Method

	Method SetAF3(name:String, val1:Float, val2:Float, val3:Float)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Attribute Var Location '"+name+"' in Method setAS3"
				Return
			End If
		?
		glVertexAttrib3fARB(loc, val1, val2, val3)
	End Method

	Method SetAF4(name:String, val1:Float, val2:Float, val3:Float, val4:Float)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Attribute Var Location '"+name+"' in Method setAF4"
				Return
			End If
		?
		glVertexAttrib4fARB(loc, val1, val2, val3, val4)
	End Method

	' Set Attribute Variable Double(s)
	Method SetAD1(name:String, val1:Double)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Attribute Var Location '"+name+"' in Method setAD1"
				Return
			End If
		?
		glVertexAttrib1fARB(loc, val1)
	End Method

	Method SetAD2(name:String, val1:Double, val2:Double)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Attribute Var Location '"+name+"' in Method setAD2"
				Return
			End If
		?
		glVertexAttrib2fARB(loc, val1, val2)
	End Method

	Method SetAD3(name:String, val1:Double, val2:Double, val3:Double)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Attribute Var Location '"+name+"' in Method setAD3"
				Return
			End If
		?
		glVertexAttrib3fARB(loc, val1, val2, val3)
	End Method

	Method SetAD4(name:String, val1:Double, val2:Double, val3:Double, val4:Double)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Attribute Var Location '"+name+"' in Method setAD4"
				Return
			End If
		?
		glVertexAttrib4fARB(loc, val1, val2, val3, val4)
	End Method
	
	Method SetM2(name:String, matrix:Float[,],trans:Int)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Uniform Var Location '"+name+"' in Method setM2"
				Return
			End If
		?
		glUniformMatrix2fvARB(Loc, 4,Trans,Matrix)
	End Method
	
	Method SetM3(name:String, matrix:Float[,],trans:Int)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Uniform Var Location '"+name+"' in Method setM3"
				Return
			End If
		?
		glUniformMatrix3fvARB(Loc, 9,Trans,Matrix)
	End Method

	Method SetM4(name:String, matrix:Float[,],trans:Int)
		Local loc:Int = glGetAttribLocationARB(Program, name.ToCString())
		?Debug
			If loc<0
				Print "Error getting Uniform Var Location '"+name+"' in Method setM4"
				Return
			End If
		?
		glUniformMatrix4fvARB(Loc, 16,Trans,Matrix)
	End Method




	'----------------------------------------------------------
	'Attach & Link a Vertex Shader Object to this ProgramObject
	'----------------------------------------------------------
	Method AttachVertShader:Int(myShader:tShaderObject)
		?Debug
			If Program = 0
				Print "Error: Invalid tProgramObject in method AddVertShader()"
				Print "-------------------------------------------------------"
				Print
			Else If Not myShader
				Print "Error: Invalid tShaderObject passed to method AddVertShader()"
				Print "-------------------------------------------------------------"
				Print
				Return
			End If
		?


		'--------------------------
		'Attach & Link a VertShader
		'--------------------------
		glAttachObjectARB(Program, myShader.ShaderObject)
		glLinkProgramARB(Program)


		'-------------------------------
		'Check if it Linked successfully
		'-------------------------------
		Local linked:Int
		glGetObjectParameterivARB(Program,GL_OBJECT_LINK_STATUS_ARB, Varptr(linked))
		
		If Not linked
			?Debug
				'An Error occured during Linking
				'dump the error logfile to console
'				Local clog2:Byte Ptr
				Local slen:Int = 0

				glGetInfoLogARB(Program,1023,Varptr slen, Varptr clog2[0])
				Local err:String
				Local i:Int
				For i = 0 To slen-1
					err:+Chr(clog2[i])
				Next

				Print
				Print "Failed to link VertexShader "+myShader.shaderName
				Print
				Print err+"  "+slen
			?
'			FlushMem
			Return 0
		End If
		?Debug
			Print "VertexShader "+myShader.shaderName+" attached & linked ok!"
			Print
		?
	
		'Add this VertShaderObject to this ProgramObjects list
		ListAddLast vList, myShader

		'Add this ProgramObject to this Shaders 'attached to' list
		ListAddLast myShader.Attached, Self
		Return 1
	End Method

	'------------------------------------------------------------
	'Attach & Link a Fragment Shader Object to this ProgramObject
	'------------------------------------------------------------
	Method AttachFragShader:Int(myShader:tShaderObject)
		?Debug
			If Program = 0
				Print "Error: Invalid tProgramObject in method AddFragShader()"
				Print "-------------------------------------------------------"
				Print
			Else If Not myShader
				Print "Error: Invalid tShaderObject passed to method AddFragShader()"
				Print "-------------------------------------------------------------"
				Print
				Return
			End If
		?


		'--------------------------
		'Attach & Link a FragShader
		'--------------------------
		glAttachObjectARB(Program, myShader.ShaderObject)
		glLinkProgramARB(Program)


		'-------------------------------
		'Check if it Linked successfully
		'-------------------------------
		Local linked:Int
		glGetObjectParameterivARB(Program,GL_OBJECT_LINK_STATUS_ARB, Varptr(linked))

		If Not linked
			?Debug
				'An Error occured during Linking
				'dump the error logfile to console
				Local slen:Int = 0

				glGetInfoLogARB(Program,1023,Varptr slen, Varptr clog2[0])
				Local err:String
				Local i:Int
				For i = 0 To slen-1
					err:+Chr(clog2[i])
				Next

				Print
				Print "Failed to link FragShader '"+myShader.shaderName+"'"
				Print
				Print err
			?
			
			Return 0
		End If

		?Debug
			Print "FragShader '"+myShader.shaderName+"' attached & linked ok!"
			Print
		?
		
		'Add this FragShaderObject to this ProgramObjects list
		ListAddLast fList, myShader
		
		'Add this ProgramObject to this Shaders 'attached to' list
		ListAddLast myShader.Attached, Self
		
		'Return Ok!
		Return 1
	End Method	

	'-------------------------------------------------------
	'Detach a VertShader:tShaderObject from a tProgramObject
	'-------------------------------------------------------
	Method DetachVertShader(vShader:tShaderObject)
		If ListContains(vList,vShader)
			glDetachObjectARB(Program, vShader.ShaderObject)
			RemoveLink(ListFindLink(vList,vShader))
			RemoveLink(ListFindLink(vShader.Attached, Self))
			?Debug
				Print "Detached '"+vShader.shaderName+"' from ProgramObject '"+Self.progName+"'"
			?
		End If
	End Method

	'-------------------------------------------------------
	'Detach a FragShader:tShaderObject from a tProgramObject
	'-------------------------------------------------------
	Method DetachFragShader(fShader:tShaderObject)
		If ListContains(fList,fShader)
			glDetachObjectARB(Program, fShader.ShaderObject)
			RemoveLink(ListFindLink(fList,fShader))
			RemoveLink(ListFindLink(fShader.Attached, Self))
			?Debug
				Print "Detached '"+fShader.shaderName+"' from ProgramObject '"+Self.progName+"'"			
			?
		End If
	End Method
	
	'------------------------------------------------------
	'Dump a list of Shaders attached to this tProgramObject
	'------------------------------------------------------
	Method ListAttachedShaders()
		Print "Vertex Shader(s) attached to ProgramObject '"+Self.progName+"'"
		Print "----------------------------------------------------------------------"
		If vList.Count() = 0
			Print "No Vertex Shaders attached"
		Else
			For Local v:tShaderObject = EachIn vList
				Print v.shaderName
			Next
		End If
		
		Print
		Print "Fragment Shader(s) attached to ProgramObject '"+Self.progName+"'"
		Print "-----------------------------------------------------------------------"
		If fList.Count() = 0
			Print "No Fragment Shaders attached"
		Else
			For Local f:tShaderObject = EachIn fList
				Print f.shaderName
			Next
		End If
		Print
	End Method
End Type




'-----------------------------------------------------------
'CreateVertShader:tShaderObject(shaderFileName:String)
'
'Creates a Vertex Shader Object from a File
'
'Returns: A tShaderObject if successful, or Null if it fails
'-----------------------------------------------------------
Function CreateVertShader:tShaderObject(shaderFileName:String)
	' Load the shader and dump it into a Byte Array
	Local file:TStream = ReadFile(shaderFileName)
	If Not file
		?Debug
			Print "Error, can not load file: "+shaderFileName
		?
		Return Null
	End If
	
	Local tempShaderName:String = StripAll(shaderfileName)+"."+ExtractExt(shaderfileName)
	Local FileLength:Int = FileSize(shaderFileName)
	Local ShaderObject:Int
	Local myShader:tShaderObject = New tShaderObject
	
	myShader.ShaderObject = glCreateShaderObjectARB(GL_VERTEX_SHADER_ARB)
	myShader.shaderType = 1 ' 1 = Vert, 2 = Frag/Pixel

	Local i:Int = 0
	Local shaderSrc:Byte[FileLength+1]

	While Not Eof(file)
		shaderSrc[i] = ReadByte(file)
		i:+1
		If i>FileLength Then i = FileLength
	Wend
	CloseFile(file)

	' Null terminate it
	shaderSrc[i] = 0 'Null terminate (important!)
	
	Local shaderLen:Int[1]
	shaderLen[0] = i

	Local shaderPtr:Byte Ptr[1]
	shaderPtr[0] = Varptr(shaderSrc[0])

	' Send shader to ShaderObject, then compile it
	glShaderSourceARB(myShader.ShaderObject,1, shaderPtr, Null)
	Local time:Int = MilliSecs()
	glCompileShaderARB(myShader.ShaderObject)
	time = (MilliSecs()-time)

	' Did the shader compile successfuly?
	Local compiled:Int
	glGetObjectParameterivARB(myShader.ShaderObject,GL_OBJECT_COMPILE_STATUS_ARB, Varptr(compiled))

	If Not compiled

		?Debug
		' Get the cause of the error
		Local logLength:Int
		glGetObjectParameterivARB(myShader.ShaderObject,GL_OBJECT_INFO_LOG_LENGTH_ARB, Varptr(logLength))

		Print "Failed to compile "+tempShaderName
		Print

		Local slen:Int = 0

		glGetInfoLogARB(myShader.ShaderObject,1023,Varptr(slen), Varptr clog2[0])
		Local err:String
		For i = 0 To logLength-1
			err:+Chr(clog2[i])
		Next
		Print err
		?
		

		myShader = Null
		Return Null
	End If
	
	?Debug
		Print "Compiled: "+tempShaderName+" successfuly in "+time+"ms"
		Print
	?

	myShader.Attached = New TList
	myShader.shaderName = tempShaderName
	ListAddLast ShaderObjectList, myShader
	
	Return myShader
End Function


'-----------------------------------------------------------
'CreateFragShader:tShaderObject(shaderFileName:String)
'
'Creates a Fragment Shader Object from a File
'
'Returns: A tShaderObject if successful, or Null if it fails
'-----------------------------------------------------------
Function CreateFragShader:tShaderObject(shaderFileName:String)
	
	'Check the File exists
	Local file:TStream = ReadFile(shaderFileName)
	If Not file
		?Debug
			Print "Error: Could not Load File: "+shaderFileName
		?
		Return Null
	End If
	
	Local tempShaderName:String = StripAll(shaderfileName)+"."+ExtractExt(shaderfileName)
	Local FileLength:Int = FileSize(shaderFileName)
	Local ShaderObject:Int
	Local myShader:tShaderObject = New tShaderObject
	
	myShader.ShaderObject = glCreateShaderObjectARB(GL_FRAGMENT_SHADER_ARB)
	myShader.shaderType = 2

	Local i:Int = 0
	
	'Create a Byte Array to which the Shader Source will be copied to
	'The extra Array Byte (FileLength+1) is so we can Null terminate the array
	Local shaderSrc:Byte[FileLength+1]

	While Not Eof(file)
		shaderSrc[i] = ReadByte(file)
		i:+1
		If i>FileLength Then i = FileLength
	Wend
	CloseFile(file)

	'Null terminate it
	shaderSrc[i] = 0 'Null terminate (important!)
	
	'The Length of the Source
	Local shaderLen:Int[1]
	shaderLen[0] = i

	'A Byte Pointer Array that points to the Shader Source
	Local shaderPtr:Byte Ptr[1]
	shaderPtr[0] = Varptr(shaderSrc[0])

	'Send the Shader to the ShaderObject, then Compile it
	glShaderSourceARB(myShader.ShaderObject,1, shaderPtr, Null)
	Local time:Int = MilliSecs()
	glCompileShaderARB(myShader.ShaderObject)
	time = (MilliSecs()-time)

	'Did the shader compile successfuly?
	Local compiled:Int
	glGetObjectParameterivARB(myShader.ShaderObject,GL_OBJECT_COMPILE_STATUS_ARB, Varptr(compiled))

	If Not compiled

		?Debug
			'Get the cause of the error
			Local logLength:Int
			glGetObjectParameterivARB(myShader.ShaderObject,GL_OBJECT_INFO_LOG_LENGTH_ARB, Varptr(logLength))

			Print "Failed to compile "+tempShaderName
			Print	

			Local slen:Int = 0

			glGetInfoLogARB(myShader.ShaderObject,1024,Varptr(slen), Varptr clog2[0])
			Local err:String

			For i = 0 To logLength-1
				err:+Chr(clog2[i])
			Next
			Print err
		?
		
		myShader = Null
'		FlushMem
		Return Null
	End If
	?Debug
	Print "Compiled: "+tempShaderName+" successfuly in "+time+"ms"
	Print
	?

	'Create a list of what ProgramObjects this Shader is Attached to
	myShader.Attached = New TList
	myShader.shaderName = tempShaderName
	ListAddLast ShaderObjectList, myShader
	
	Return myShader
End Function


Function DeleteVertShader(vShader:tShaderObject Var)
	If Not vShader Return

	RemoveLink(ListFindLink(ShaderObjectList,vShader))
	
	' Detach this ShaderObject from all ProgramObjects it was attached to
	For Local p:tProgramObject = EachIn ProgramObjectList
		If ListContains(p.vList, vShader)
			p.DetachVertShader(vShader)
		End If
	Next
	
	' Delete the shader
	glDeleteObjectARB(vShader.ShaderObject)
	?Debug
		Print "Deleted ShaderObject '"+vShader.shaderName+"'"
		Print
	?
	vShader = Null
End Function
	
Function DeleteFragShader(fShader:tShaderObject Var)
	If Not fShader Return
	
	RemoveLink(ListFindLink(ShaderObjectList,fShader))
		
	' Detach this ShaderObject from all ProgramObjects it was attached to
	For Local p:tProgramObject = EachIn ProgramObjectList
		If ListContains(p.fList, fShader)
			p.DetachFragShader(fShader)
		End If
	Next
	
	' Delete the shader
	glDeleteObjectARB(fShader.ShaderObject)
	?Debug
		Print "Deleted ShaderObject '"+fShader.shaderName+"'"
		Print
	?
	fShader = Null
End Function

