Shadow Map

This code has been declared by its author to be Public Domain code.

Shadow Map by DareDevil

2009

This is a Shadow Map technique, the method is slowly.

This code is public domain

pleace public the optimization for this code

[codebox]
;===>O=========================o<=================================================================
;===>O=========================o<=================================================================
;===>	Name file: 
;===>
;===>	Programmatore:
;===>	  Caldarulo Vincenzo (Vision&Design Software)
;===>	Descrizione:
;===>
;===>O=========================o<=================================================================
;===>O=========================o<=================================================================
; 

;=================================================================================================================================
;----------------------------------------------------------------------------------------------------------------------------
;=====================================================
;===>

Type SHWS_Shadow 
	Field Caster
	Field ObjOrig
	Field ObjShw
End Type 
;=====================================================
;===>
Const SHWS_LevelTexture% = 1
Const SHWS_TexSize# = 512
Const SHWS_ConstSize# = 1.0 / Float(SHWS_TexSize)
Const SHWS_Far# = 300
Const SHWS_ConstColor# = 1.0/256.0
Const SHWS_FactorZ# = SHWS_Far*SHWS_ConstColor

Dim SHWS_Pix(SHWS_TexSize*SHWS_TexSize)
;=====================================================
;===>
Global SHWS_Camera%
Global SHWS_ShadowCam%
Global SHWS_ENABLE%			= True
Global SHWS_ENABLE_ONE%	= True
Global SHWS_TexLight%
Global SHWS_TexCam%
Global SHWS_TexBase%
Global SHWS_Tollerance% = (8 Shl 16) + (8 Shl 16) + 8
;Global SHWS_Tollerance% = 8


Global txdraw%

	; ===>
	; Create a fullscreen sprite
Global SHWS_ImgSHW_Obj

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_Init.SHWS_Shadow(a_Camera)
	; ===>
	SHWS_Camera		 = a_Camera
	; ===>
	If(GraphicsDepth()<=16) Then 
		;SHWS_Tollerance = 8 
		SHWS_Tollerance% = (8 Shl 16) + (8 Shl 16) + 8
		
	Else 
		;SHWS_Tollerance = 4
		SHWS_Tollerance% = (4 Shl 16) + (4 Shl 16) + 4
		
	EndIf
	; ===>
	SHWS_ShadowCam = CreateCamera() 
	CameraClsColor SHWS_ShadowCam, 255, 255, 255
	CameraViewport SHWS_ShadowCam,0,0,SHWS_TexSize,SHWS_TexSize 	;the viewport the shadows will be rendered through.
	CameraProjMode SHWS_ShadowCam, 1;2														;Orthographic view, sorry, I've only figured out very simple directional shadows.
	HideEntity SHWS_ShadowCam
	; ===>
	SHWS_TexLight = CreateTexture(SHWS_TexSize,SHWS_TexSize,1);+16+32+256)
	TextureBlend SHWS_TexLight,2
	SHWS_TexCam = CreateTexture(SHWS_TexSize,SHWS_TexSize,1);+16+32+256)
	TextureBlend SHWS_TexCam,2
	; ===>
	SHWS_TexBase = CreateTexture(16,16,1+16+32+256)
	TextureBlend SHWS_TexBase,2
	SetBuffer TextureBuffer(SHWS_TexBase) ; 
	ClsColor 255, 255, 255
	Cls 
	ClsColor 0, 0, 0
	SetBuffer BackBuffer()
	; ===>
	Local Dof# = 1;.1
	SHWS_ImgSHW_Obj 	= CreateSprite(a_Camera)
	; ===>
	; Set up the sprites position, scale etc...
	PositionEntity  SHWS_ImgSHW_Obj, -0.0018, 0.0, 1.002
	;EntityBlend SHWS_ImgSHW_Obj,3
	;EntityFX SHWS_ImgSHW_Obj,32
	;EntityAlpha SHWS_ImgSHW_Obj,.1
	
	; ===>
	; Set full colour & additive blend
	EntityFX 		SHWS_ImgSHW_Obj, 1
	EntityBlend SHWS_ImgSHW_Obj, 2
	EntityAlpha SHWS_ImgSHW_Obj,0.5
	; ===>
	; Create blur texture
	EntityTexture SHWS_ImgSHW_Obj, SHWS_TexLight
	HideEntity SHWS_ImgSHW_Obj
	; ===>
	;Local l_Fact# = 200
	;BlurTextureInit(SHWS_TexSize, SHWS_TexSize/l_Fact, SHWS_TexSize/(l_Fact*.75));
	;BlurTextureInit(SHWS_TexSize, 3, 4);
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_AddObject.SHWS_Shadow( Obj, Caster=True, TexAlpha=0)
	; ===>
	Local l_CurModel.SHWS_Shadow = New SHWS_Shadow
	; ===>
	l_CurModel\ObjOrig	= Obj
	l_CurModel\Caster		= Caster
	; ===>
	If (l_CurModel\Caster)
		; ===>
		l_CurModel\ObjShw = CopyMesh(l_CurModel\ObjOrig)
		EntityColor_(	l_CurModel\ObjShw	, 255, 255, 255)
		EntityFX 			l_CurModel\ObjShw	, 2+1;+4+8
		EntityTexture l_CurModel\ObjShw, SHWS_TexBase, 0, 7
		; ===>
		HideEntity l_CurModel\ObjShw
		; ===>
	EndIf
	; ===>
	Return l_CurModel
	; ===>
End Function
; =====================================================
; ===>
;
; ===>
;
Function SHW_Update( s_light)
	; ===>
	If (Not SHWS_ENABLE) Then Return
	; ===>
	Local YSize# = (Float(SHWS_TexSize)*(Float(GraphicsHeight())/Float(GraphicsWidth())))
	Local YUp# = (Float(SHWS_TexSize)-YSize)*.5
	Local YDw# = SHWS_TexSize-YUp
	; ===>
	Local Id_SHWS_TexCam%		= TextureBuffer(SHWS_TexCam)
	Local Id_SHWS_TexLight%	= TextureBuffer(SHWS_TexLight)
	; ===>
	EntityParent SHWS_ImgSHW_Obj,SHWS_Camera
	HideEntity SHWS_ImgSHW_Obj
	AmbientLight	255,255,255
	;===>
	HideEntity SHWS_Camera																				; The in game camera must be hidden,
	ShowEntity SHWS_ShadowCam																			; and the shadow camera must become visable.
	;===>
	SHW_ObjSHW_Show()
	SHW_ObjOrig_Hide()
	;===>
	PositionEntity SHWS_ShadowCam, EntityX(s_light,True), EntityY(s_light,True), EntityZ(s_light,True)
	PointEntity SHWS_ShadowCam, CenterWord
	;===>
	Local l_CurModel.SHWS_Shadow
	Local ObjRecieved, ObjShw
	Local l_ColorZ#, l_TexU#, l_TexV#
	Local l_Vx#, l_Vy#, l_Vz# 
	;===>
	For l_CurModel = Each SHWS_Shadow
		;========================================================================
		;===>
		If (l_CurModel\Caster And SHWS_ENABLE) Then
			;========================================================================
			; ===>
			ObjRecieved = l_CurModel\ObjOrig
			ObjShw 			= l_CurModel\ObjShw;
			; ===>
			EntityTexture ObjShw, SHWS_TexBase, 0, 7
			EntityFX 			ObjShw, 2+1
			; ===>
			PositionEntity	ObjShw, EntityX     (ObjRecieved), EntityY     (ObjRecieved), EntityZ     (ObjRecieved)
			RotateEntity 		ObjShw, EntityPitch (ObjRecieved), EntityYaw   (ObjRecieved), EntityRoll  (ObjRecieved)
			ScaleEntity			ObjShw, EntityScaleX(ObjRecieved), EntityScaleY(ObjRecieved), EntityScaleZ(ObjRecieved)
			; ===>
			; =========================================================
			; Generate texture coordinate
			;	===>
			Local IdSurf%, IdVert%, CurSurf%
			For IdSurf=1 To CountSurfaces(ObjShw) 
				; =========================================================
				; ===>
				CurSurf=GetSurface(ObjShw,IdSurf) 
				For IdVert=0 To CountVertices(CurSurf)-1 
					; =========================================================
					; ===>
					l_Vx = VertexX(CurSurf,IdVert) : l_Vy = VertexY(CurSurf,IdVert) : l_Vz = VertexZ(CurSurf,IdVert)
					; ===>
					TFormPoint l_Vx, l_Vy, l_Vz, ObjRecieved, SHWS_ShadowCam
					l_ColorZ = TFormedZ()*SHWS_FactorZ
					VertexColor CurSurf,IdVert, l_ColorZ, l_ColorZ, l_ColorZ
					; ===>
					TFormPoint l_Vx, l_Vy, l_Vz, ObjRecieved, 0
					CameraProject SHWS_ShadowCam, TFormedX(), TFormedY(), TFormedZ()
					l_TexU# = ProjectedX()*SHWS_ConstSize;/Float(SHWS_TexSize)
					l_TexV# = ProjectedY()*SHWS_ConstSize;/Float(SHWS_TexSize)
					VertexTexCoords CurSurf,IdVert, l_TexU, l_TexV
					; ===>
					; =========================================================
				Next 
				; ===>
				; =========================================================
			Next 
			; ===>
			; =========================================================
		EndIf	
		;===>
		;=========================================================
	Next
	; =========================================================
	; ===>
	;	Costruito il finto zbuffer renderiziamo dal punto di vista della luce
	RenderWorld()
	
;	;=========================================================
;	HideEntity SHWS_ShadowCam	: ShowEntity SHWS_Camera
;	SHW_ObjSHW_Hide(): SHW_ObjOrig_Show()
;	Return
	
	; =========================================================
	; ===>
	; Mi copio l'immagine nell Muffer
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexLight)
	
	;SmoothTexture(SHWS_TexLight)
	
	;Return
	; ===>
	; ora rimetto la telecamera giusta
	PositionEntity SHWS_ShadowCam, EntityX(SHWS_Camera,True)    , EntityY(SHWS_Camera,True)  , EntityZ(SHWS_Camera,True)
	RotateEntity	 SHWS_ShadowCam, EntityPitch(SHWS_Camera,True), EntityYaw(SHWS_Camera,True), EntityRoll(SHWS_Camera,True)
	; =========================================================
	; ===>
	;	Mi metto dal punto di vista normale e vedo lo ZBuffer
	RenderWorld()
	; =========================================================
	; ===>
	; Mi copio l'immagine nell Buffer
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexCam)
	; =========================================================
	;===> 
	
	For l_CurModel = Each SHWS_Shadow
		;===>
		If (l_CurModel\Caster And SHWS_ENABLE) Then 
			EntityTexture l_CurModel\ObjShw, SHWS_TexLight, 0, 7
			EntityFX 			l_CurModel\ObjShw, 1
		EndIf
		;===>
	Next
	; =========================================================
	; ===>
	;	Costruito il finto zbuffer renderiziamo
	RenderWorld()
	; =========================================================
	; ===>
	; Mi copio l'immagine nell Muffer
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexLight)
	; =========================================================
	; ===>
	SHW_ShaderShadow(SHWS_TexLight,SHWS_TexCam)
	; ===>
	; =========================================================
	;===>
	ClsColor 0, 0, 0
	SetBuffer BackBuffer()
	;===>
	HideEntity SHWS_ShadowCam	 : SHW_ObjSHW_Hide()
	
	;SmoothTexture(SHWS_TexLight,6)
	;BlurTexture(SHWS_TexLight)
	;BlurTexturetest(SHWS_TexLight,3,4)
	
	ShowEntity SHWS_Camera : SHW_ObjOrig_Show()
	;===>
	AmbientLight	 AMBIENTLIGHTCOLOR_R, AMBIENTLIGHTCOLOR_G, AMBIENTLIGHTCOLOR_B
	;===>
	If (SHWS_ENABLE) Then SHWS_ENABLE_ONE = False Else SHWS_ENABLE_ONE = True
	;===>
	ShowEntity SHWS_ImgSHW_Obj
	;===>
End Function


;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShaderShadow( a_ImageLight, a_ImageCamera )
	
	; =========================================================
	; ===>
	Local BuffImageLight = TextureBuffer(a_ImageLight)
	Local BuffImageCamera = TextureBuffer(a_ImageCamera)
	; ===>
	Local l_IdX%, l_IdY%,l_Pc% ,l_Pl%
	
	
	Local l_ColAmb%	= (AMBIENTLIGHTCOLOR_R Shl 16)+(AMBIENTLIGHTCOLOR_G Shl 8)+ AMBIENTLIGHTCOLOR_B
	
	Local l_ColAmb_r%	= AMBIENTLIGHTCOLOR_R
	Local l_ColAmb_g%	= AMBIENTLIGHTCOLOR_G
	Local l_ColAmb_b%	= AMBIENTLIGHTCOLOR_B
	
	l_ColAmb_r%	= ( l_ColAmb Shr 16)	And $ff
	l_ColAmb_g%	= ( l_ColAmb Shr 8 )	And $ff
	l_ColAmb_b%	= ( l_ColAmb )				And $ff
	
	Local l_ColNorm%= (255 Shl 24)+(255 Shl 16)+(255 Shl 8)+ 255	
	; ===>
	Local YSize#	= (Float(SHWS_TexSize)*(Float(GraphicsHeight())/Float(GraphicsWidth())))
	Local YUp#		= (Float(SHWS_TexSize)-YSize)*.5
	Local YDw#		= SHWS_TexSize-YUp-1
	Local XDw#		= SHWS_TexSize-1
	
	; ===>
	LockBuffer BuffImageCamera
	LockBuffer BuffImageLight
	SetBuffer BuffImageLight
	; ===>
	For l_IdY = YUp To YDw
		For l_IdX = 0 To XDw
			; ===>
			l_Pc% = ReadPixelFast( l_IdX, l_IdY, BuffImageCamera)
			l_Pl% = ReadPixelFast( l_IdX, l_IdY ) + SHWS_Tollerance
			;===>
			If (l_Pl<l_Pc) Then 
				WritePixelFast l_IdX, l_IdY, l_ColAmb
			Else
				WritePixelFast l_IdX, l_IdY, l_ColNorm
			EndIf
			; ===>
		Next
	Next
	; ===>
	UnlockBuffer BuffImageCamera
	UnlockBuffer BuffImageLight
	SetBuffer BackBuffer()
	; ===>
End Function


;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SmoothTexture_Fast( a_Image, a_Smooth=2)
	; ===>
	Local l_x0%, l_y0%, l_Idy0%
	Local l_x1%, l_y1%, l_Idy1%
	Local l_x1_a%, l_x1_b%
	Local l_Color#, l_NColor#
	Local gfxbuffer=TextureBuffer(a_Image)
	; ===>
	LockBuffer gfxbuffer
	SetBuffer gfxbuffer
	For l_y0=0 To SHWS_TexSize-1
		l_Idy0 = l_y0*SHWS_TexSize
		For l_x0=0 To SHWS_TexSize-1
			; ===>
			SHWS_Pix(l_Idy0+l_x0) = ReadPixelFast( l_x0,l_y0,gfxbuffer) And $FF
			; ===>
		Next
	Next
	; ===>
	
	For l_y0=0 To SHWS_TexSize-1
		l_Idy0 = l_y0*SHWS_TexSize
		For l_x0=0 To SHWS_TexSize-1
			; ===>
			l_Color = 0;
			l_NColor = 0;
			; ===>
			For l_y1=l_y0-a_Smooth To l_y0+a_Smooth
				If (l_y1>=0 And l_y1<=SHWS_TexSize) Then 
					l_Idy1 = l_y1*SHWS_TexSize
					; ===>
					l_x1_a = l_x0-a_Smooth	: If (l_x1<0)						Then l_x1_a = 0
					l_x1_b = l_x0+a_Smooth	: If (l_x1>SHWS_TexSize)Then l_x1_a = SHWS_TexSize-1
					; ===>
					For l_x1=l_x1_a To l_x1_b
						; ===>
						l_NColor = l_NColor+1
						l_Color = l_Color+SHWS_Pix(l_Idy1+l_x1)
						; ===>
					Next
				EndIf
			Next
			; ===>
			l_Color = l_Color / l_NColor
			WritePixelFast l_x0,l_y0,((l_Color Shl 16)+(l_Color Shl 8)+l_Color)
			; ===>
		Next
	Next
	; ===>
	UnlockBuffer gfxbuffer
	SetBuffer BackBuffer()
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SmoothTexture( a_Image, a_Smooth=2)
	; ===>
	Local l_x0%, l_y0%, l_Idy0%
	Local l_x1%, l_y1%, l_Idy1%
	Local l_Color#, l_NColor#
	Local gfxbuffer=TextureBuffer(a_Image)
	; ===>
	LockBuffer gfxbuffer
	SetBuffer gfxbuffer
	For l_y0=0 To SHWS_TexSize-1
		l_Idy0 = l_y0*SHWS_TexSize
		For l_x0=0 To SHWS_TexSize-1
			; ===>
			SHWS_Pix(l_Idy0+l_x0) = ReadPixelFast( l_x0,l_y0,gfxbuffer) And $FF
			; ===>
		Next
	Next
	; ===>
	
	For l_y0=0 To SHWS_TexSize-1
		l_Idy0 = l_y0*SHWS_TexSize
		For l_x0=0 To SHWS_TexSize-1
			; ===>
			l_Color = 0;
			l_NColor = 0;
			; ===>
			For l_y1=l_y0-a_Smooth To l_y0+a_Smooth
				If (l_y1>=0 And l_y1<=SHWS_TexSize) Then 
					l_Idy1 = l_y1*SHWS_TexSize
					; ===>
					For l_x1=l_x0-a_Smooth To l_x0+a_Smooth
						; ===>
						If (l_x1>=0 And l_x1<=SHWS_TexSize) Then 
							l_NColor = l_NColor+1
							l_Color = l_Color+SHWS_Pix(l_Idy1+l_x1)
						EndIf
						; ===>
					Next
				EndIf
			Next
			; ===>
			l_Color = l_Color / l_NColor
			WritePixelFast l_x0,l_y0,((l_Color Shl 16)+(l_Color Shl 8)+l_Color)
			; ===>
		Next
	Next
	; ===>
	UnlockBuffer gfxbuffer
	SetBuffer BackBuffer()
	; ===>
End Function



;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShadowEnable()
	;===>
	SHWS_ENABLE = True
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShadowDisable()
	;===>
	SHWS_ENABLE = False
	;===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjSHW_Hide()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		If (l_CurModel\Caster) Then HideEntity l_CurModel\ObjShw 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjSHW_Show()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		If (l_CurModel\Caster) Then ShowEntity l_CurModel\ObjShw 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjOrig_Hide()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		HideEntity l_CurModel\ObjOrig 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjOrig_Show()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		ShowEntity l_CurModel\ObjOrig 
	Next
	;===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_SmootShadowTexture()
	;===>
	If (SHWS_ENABLE=False) Then Return
	
;	;===>
;	Local l_SHW_Recived.SHWS_Shadow
;	;===>
;	For l_SHW_Recived = Each SHWS_Shadow
;		; ===>
;		If (l_SHW_Recived\Caster) Then BlurTexture( l_SHW_Recived\Tex)
;		; ===>
;	Next
;	;===>
End Function
[/codebox]

Comments

Stevie G

2009

How about some example code?

BIG BUG

2009

Which userlib do one need to run this?

DareDevil

2009

New Version



;===>O=========================o<=================================================================
;===>O=========================o<=================================================================
;===>	Name file: 
;===>
;===>	Programmatore:
;===>	  Caldarulo Vincenzo (Vision&Design Software)
;===>	Descrizione:
;===>
;===>O=========================o<=================================================================
;===>O=========================o<=================================================================
; 

Graphics3D 1024,768,32
;------------------------------------------------------------------
;==============================================================
;


;------------------------------------------------------------------
;==============================================================
Global Camera = CreateCamera() 
SetBuffer BackBuffer()
;HWMultiTex True
SHW_Init(Camera)
; =================================================================================================
; ===>
Global IDCaster.SHWS_Shadow ,IDRecived.SHWS_Shadow
SetAmbientLight( 64, 64, 64)
SeedRnd MilliSecs()

LoadScene2()

Global LightObj = CreateSphere(8)
TurnEntity LightObj,40,90,0 
CreateLight(2,LightObj)
EntityColor LightObj,255,0,0

Global lightRot#=0
Global CenterWord = CreateCube() : EntityColor CenterWord,255,0,0 : HideEntity CenterWord
PositionEntity CenterWord, 0, 0, 0

; =================================================================================================
; ===>
HidePointer()
MoveMouse GraphicsWidth()/2,GraphicsHeight()/2
;===>
PositionEntity Camera, 0, 0, 0
RotateEntity   Camera, 0, 0, 0


PositionEntity Camera,60,60,-60
RotateEntity Camera,30,45,0


Local spd#=0.5

Local OldMillisecs = MilliSecs()

; =================================================================================================
; ===>
Repeat
	;WireFrame True
	AntiAlias 1
	
	
	MoveEntity Camera,(KeyDown(205)-KeyDown(203))*spd,0,(MouseDown(1)-MouseDown(2))*spd
	TurnEntity Camera,-MouseYSpeed()*0.1,-MouseXSpeed()*0.1,0
	RotateEntity Camera,EntityPitch(Camera,True),EntityYaw(Camera,True),0
	
	MoveMouse GraphicsWidth()*.5,GraphicsHeight()*.5
	
	; ===========================================================================
	; ===>
	Local distlight# = 100
	lightRot = lightRot + .1 
	PositionEntity LightObj, distlight*Cos(lightRot), 50+10*Sin(lightRot*10), distlight*Sin(lightRot)
	PointEntity LightObj,CenterWord
	
	
	If KeyDown(63) Then  Stop
	; ===========================================================================
	; ===>
	UpdateWorld() 
	;====>
	SHW_Update(LightObj)
	; ===>
	RenderWorld()
	; ===>
	; ===========================================================================
	; ===>
		; ===>
	Ms=(MilliSecs()-OldMillisecs)
	Text(10,10,"Ms: "+Ms+" FPS: " + 1000/ms)
	OldMillisecs = MilliSecs()
	
	Flip(False)
	; ===>
Until KeyHit(1)

End


Function LoadScene2()
	;===>
	Local Obj;
	;===>
	Local R = 10
	Local x,z
	Local Segment=50
	Local scl=5
	;===>
	Obj = CreateCube() 
	PositionEntity Obj,0,-5,0
	ScaleEntity Obj, scl*10, .1, scl*10
	SHW_AddObject( Obj,True)
	;===>
	;Obj = LoadMesh("media\Beethoven.b3d")
	Obj = CreateSphere(32)
	PositionEntity Obj,-10, 10, -10
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj,True)
	;===>
	Obj = CreateCylinder(16,1)
	PositionEntity Obj,-10, 10, 10
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj,True)
	;===>
	Obj = CreateCube()
	PositionEntity Obj, 10, 10, 10
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj,True)
	;===>
	
End Function

; ================================================== 
; ----------------------------------------------- 
; 

Function DrawTexture(x,y,Texture)
	CopyRect 0,0,TextureWidth(Texture),TextureWidth(Texture),x,y,TextureBuffer(Texture),BackBuffer()
End Function

; ================================================== 
; ----------------------------------------------- 
;this function for internal use only
Function GetScaleValue#(EntityHandle, GetGlobal)
  Local X# = TFormedX()-EntityX(EntityHandle, GetGlobal)
  Local Y# = TFormedY()-EntityY(EntityHandle, GetGlobal)
  Local Z# = TFormedZ()-EntityZ(EntityHandle, GetGlobal)
  Return Sqr(X*X+Y*Y+Z*Z)
End Function 



; ================================================== 
; ----------------------------------------------- 

Function EntityScaleX#(EntityHandle, GetGlobal=True)  
  TFormPoint 1,0,0, EntityHandle, (Not GetGlobal)*GetParent(EntityHandle)  
  Return GetScaleValue#(EntityHandle, GetGlobal)
End Function 
; ================================================== 
; ----------------------------------------------- 

Function EntityScaleY#(EntityHandle, GetGlobal=True)  
  TFormPoint 0,1,0, EntityHandle, (Not GetGlobal)*GetParent(EntityHandle)  
  Return GetScaleValue#(EntityHandle, GetGlobal)
End Function 
; ================================================== 
; ----------------------------------------------- 

Function EntityScaleZ#(EntityHandle, GetGlobal=True)  
  TFormPoint 0,0,1, EntityHandle, (Not GetGlobal)*GetParent(EntityHandle)  
  Return GetScaleValue#(EntityHandle, GetGlobal)
End Function 

; ================================================== 
; ----------------------------------------------- 

Function EntityColor_(mesh,r,g,b)
	Local i,ww
	If mesh<>0
		If EntityClass$(mesh)="Mesh"
			EntityColor mesh,r,g,b
		EndIf
		For i=1 To CountChildren(mesh)
			ww=GetChild(mesh,i)
			EntityColor_(ww,r,g,b)
		Next
	EndIf
End Function
; ================================================== 
; ----------------------------------------------- 

Global AMBIENTLIGHTCOLOR_R# = 0
Global AMBIENTLIGHTCOLOR_G# = 0
Global AMBIENTLIGHTCOLOR_B# = 0

Function SetAmbientLight( a_R#=0.0, a_G#=0.0, a_B#=0.0 )
	; ===>
	AmbientLight a_R, a_G, a_B
	AMBIENTLIGHTCOLOR_R = a_R
	AMBIENTLIGHTCOLOR_G = a_G
	AMBIENTLIGHTCOLOR_B = a_B
	; ===>
End Function

;=================================================================================================================================
;----------------------------------------------------------------------------------------------------------------------------
;=====================================================
;===>

Type SHWS_Shadow 
	Field Caster
	Field ObjOrig
	Field ObjShw
End Type 
;=====================================================
;===>
Const SHWS_LevelTexture% = 1
Const SHWS_TexSize# = 512
Const SHWS_ConstSize# = 1.0 / Float(SHWS_TexSize)
Const SHWS_Far# = 300
Const SHWS_ConstColor# = 1.0/256.0
Const SHWS_FactorZ# = SHWS_Far*SHWS_ConstColor

Dim SHWS_Pix(SHWS_TexSize*SHWS_TexSize)
;=====================================================
;===>
Global SHWS_Camera%
Global SHWS_ShadowCam%
Global SHWS_ENABLE%			= True
Global SHWS_ENABLE_ONE%	= True
Global SHWS_TexLight%
Global SHWS_TexCam%
Global SHWS_TexBase%
Global SHWS_Tollerance% = (8 Shl 16) + (8 Shl 16) + 8
;Global SHWS_Tollerance% = 8


Global txdraw%

	; ===>
	; Create a fullscreen sprite
Global SHWS_ImgSHW_Obj

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_Init.SHWS_Shadow(a_Camera)
	
	; ===>
	SHWS_ENABLE =True
	SHWS_Camera		 = a_Camera
	; ===>
	Local ValueTolA = 24
	Local ValueTolB = ValueTolA/2
	If(GraphicsDepth()<=16) Then 
		SHWS_Tollerance% = (ValueTolA Shl 16) + (ValueTolA Shl 16) + ValueTolA
	Else 
		SHWS_Tollerance% = (ValueTolB Shl 16) + (ValueTolB Shl 16) + ValueTolB
	EndIf
	; ===>
	SHWS_ShadowCam = CreateCamera() 
	CameraClsColor SHWS_ShadowCam, 255, 255, 255
	CameraViewport SHWS_ShadowCam,0,0,SHWS_TexSize,SHWS_TexSize 	;the viewport the shadows will be rendered through.
	CameraProjMode SHWS_ShadowCam, 1;2														;Orthographic view, sorry, I've only figured out very simple directional shadows.
	HideEntity SHWS_ShadowCam
	; ===>
	SHWS_TexLight = CreateTexture(SHWS_TexSize,SHWS_TexSize,1);+16+32+256)
	TextureBlend SHWS_TexLight,2
	SHWS_TexCam = CreateTexture(SHWS_TexSize,SHWS_TexSize,1);+16+32+256)
	TextureBlend SHWS_TexCam,2
	; ===>
	SHWS_TexBase = CreateTexture(16,16,1+16+32+256)
	TextureBlend SHWS_TexBase,2
	SetBuffer TextureBuffer(SHWS_TexBase) ; 
	ClsColor 255, 255, 255
	Cls 
	ClsColor 0, 0, 0
	SetBuffer BackBuffer()
	; ===>
	Local Dof# = 1;.1
	SHWS_ImgSHW_Obj 	= CreateSprite(a_Camera)
	; ===>
	; Set up the sprites position, scale etc...
	PositionEntity  SHWS_ImgSHW_Obj, -0.0018, 0.0, 1.002
	;EntityBlend SHWS_ImgSHW_Obj,3
	;EntityFX SHWS_ImgSHW_Obj,32
	;EntityAlpha SHWS_ImgSHW_Obj,.1
	
	; ===>
	; Set full colour & additive blend
	EntityFX 		SHWS_ImgSHW_Obj, 1
	EntityBlend SHWS_ImgSHW_Obj, 2
	EntityAlpha SHWS_ImgSHW_Obj,0.5
	; ===>
	; Create blur texture
	EntityTexture SHWS_ImgSHW_Obj, SHWS_TexLight
	HideEntity SHWS_ImgSHW_Obj
	; ===>
	;Local l_Fact# = 200
	;BlurTextureInit(SHWS_TexSize, SHWS_TexSize/l_Fact, SHWS_TexSize/(l_Fact*.75));
	;BlurTextureInit(SHWS_TexSize, 3, 4);
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_AddObject.SHWS_Shadow( Obj, Caster=True, TexAlpha=0)
	; ===>
	Local l_CurModel.SHWS_Shadow = New SHWS_Shadow
	; ===>
	l_CurModel\ObjOrig	= Obj
	l_CurModel\Caster		= Caster
	; ===>
	If (l_CurModel\Caster)
		; ===>
		l_CurModel\ObjShw = CopyMesh(l_CurModel\ObjOrig)
		EntityColor_ (	l_CurModel\ObjShw	, 255, 255, 255)
		EntityFX 			l_CurModel\ObjShw	, 2+1;+4+8
		EntityTexture l_CurModel\ObjShw, SHWS_TexBase, 0, 7
		; ===>
		HideEntity l_CurModel\ObjShw
		; ===>
	EndIf
	; ===>
	Return l_CurModel
	; ===>
End Function
; =====================================================
; ===>
;
; ===>
;
Function SHW_Update( s_light)
	; ===>
	If (Not SHWS_ENABLE) Then Return
	; ===>
	Local YSize# = (Float(SHWS_TexSize)*(Float(GraphicsHeight())/Float(GraphicsWidth())))
	Local YUp# = (Float(SHWS_TexSize)-YSize)*.5
	Local YDw# = SHWS_TexSize-YUp
	; ===>
	Local Id_SHWS_TexCam%		= TextureBuffer(SHWS_TexCam)
	Local Id_SHWS_TexLight%	= TextureBuffer(SHWS_TexLight)
	; ===>
	EntityParent SHWS_ImgSHW_Obj,SHWS_Camera
	HideEntity SHWS_ImgSHW_Obj
	AmbientLight	255,255,255
	;===>
	HideEntity SHWS_Camera																				; The in game camera must be hidden,
	ShowEntity SHWS_ShadowCam																			; and the shadow camera must become visable.
	;===>
	SHW_ObjSHW_Show()
	SHW_ObjOrig_Hide()
	;===>
	PositionEntity SHWS_ShadowCam, EntityX(s_light,True), EntityY(s_light,True), EntityZ(s_light,True)
	
	PointEntity SHWS_ShadowCam, CenterWord
	;===>
	Local l_CurModel.SHWS_Shadow
	Local ObjRecieved, ObjShw
	Local l_ColorZ#, l_TexU#, l_TexV#
	Local l_Vx#, l_Vy#, l_Vz# 
	;===>
	For l_CurModel = Each SHWS_Shadow
		;========================================================================
		;===>
		If (l_CurModel\Caster And SHWS_ENABLE) Then
			;========================================================================
			; ===>
			ObjRecieved = l_CurModel\ObjOrig
			ObjShw 			= l_CurModel\ObjShw;
			; ===>
			EntityTexture ObjShw, SHWS_TexBase, 0, 7
			EntityFX 			ObjShw, 2+1
			; ===>
			PositionEntity	ObjShw, EntityX     (ObjRecieved), EntityY     (ObjRecieved), EntityZ     (ObjRecieved)
			RotateEntity 		ObjShw, EntityPitch (ObjRecieved), EntityYaw   (ObjRecieved), EntityRoll  (ObjRecieved)
			ScaleEntity			ObjShw, EntityScaleX(ObjRecieved), EntityScaleY(ObjRecieved), EntityScaleZ(ObjRecieved)
			; ===>
			; =========================================================
			; Generate texture coordinate
			;	===>
			Local IdSurf%, IdVert%, CurSurf%
			For IdSurf=1 To CountSurfaces(ObjShw) 
				; =========================================================
				; ===>
				CurSurf=GetSurface(ObjShw,IdSurf) 
				For IdVert=0 To CountVertices(CurSurf)-1 
					; =========================================================
					; ===>
					l_Vx = VertexX(CurSurf,IdVert) : l_Vy = VertexY(CurSurf,IdVert) : l_Vz = VertexZ(CurSurf,IdVert)
					; ===>
					TFormPoint l_Vx, l_Vy, l_Vz, ObjRecieved, SHWS_ShadowCam
					l_ColorZ = TFormedZ()*SHWS_FactorZ
					VertexColor CurSurf,IdVert, l_ColorZ, l_ColorZ, l_ColorZ
					; ===>
					TFormPoint l_Vx, l_Vy, l_Vz, ObjRecieved, 0
					CameraProject SHWS_ShadowCam, TFormedX(), TFormedY(), TFormedZ()
					l_TexU# = ProjectedX()*SHWS_ConstSize;/Float(SHWS_TexSize)
					l_TexV# = ProjectedY()*SHWS_ConstSize;/Float(SHWS_TexSize)
					VertexTexCoords CurSurf,IdVert, l_TexU, l_TexV
					; ===>
					; =========================================================
				Next 
				; ===>
				; =========================================================
			Next 
			; ===>
			; =========================================================
		EndIf	
		;===>
		;=========================================================
	Next
	; =========================================================
	; ===>
	;	Costruito il finto zbuffer renderiziamo dal punto di vista della luce
	RenderWorld()
	
;	;=========================================================
;	HideEntity SHWS_ShadowCam	: ShowEntity SHWS_Camera
;	SHW_ObjSHW_Hide(): SHW_ObjOrig_Show()
;	Return
	
	; =========================================================
	; ===>
	; Mi copio l'immagine nell Muffer
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexLight)
	
	;SmoothTexture(SHWS_TexLight)
	
	;Return
	; ===>
	; ora rimetto la telecamera giusta
	PositionEntity SHWS_ShadowCam, EntityX(SHWS_Camera,True)    , EntityY(SHWS_Camera,True)  , EntityZ(SHWS_Camera,True)
	RotateEntity	 SHWS_ShadowCam, EntityPitch(SHWS_Camera,True), EntityYaw(SHWS_Camera,True), EntityRoll(SHWS_Camera,True)
	; =========================================================
	; ===>
	;	Mi metto dal punto di vista normale e vedo lo ZBuffer
	RenderWorld()
	; =========================================================
	; ===>
	; Mi copio l'immagine nell Buffer
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexCam)
	; =========================================================
	;===> 
	
	For l_CurModel = Each SHWS_Shadow
		;===>
		If (l_CurModel\Caster And SHWS_ENABLE) Then 
			EntityTexture l_CurModel\ObjShw, SHWS_TexLight, 0, 7
			EntityFX 			l_CurModel\ObjShw, 1
		EndIf
		;===>
	Next
	; =========================================================
	; ===>
	;	Costruito il finto zbuffer renderiziamo
	RenderWorld()
	; =========================================================
	; ===>
	; Mi copio l'immagine nell Muffer
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexLight)
	; =========================================================
	; ===>
	SHW_ShaderShadow(SHWS_TexLight,SHWS_TexCam)
	; ===>
	; =========================================================
	;===>
	ClsColor 0, 0, 0
	SetBuffer BackBuffer()
	;===>
	HideEntity SHWS_ShadowCam	 : SHW_ObjSHW_Hide()
	
	;SmoothTexture(SHWS_TexLight,6)
	;BlurTexture(SHWS_TexLight)
	;BlurTexturetest(SHWS_TexLight,3,4)
	
	ShowEntity SHWS_Camera : SHW_ObjOrig_Show()
	;===>
	AmbientLight	 AMBIENTLIGHTCOLOR_R, AMBIENTLIGHTCOLOR_G, AMBIENTLIGHTCOLOR_B
	;===>
	If (SHWS_ENABLE) Then SHWS_ENABLE_ONE = False Else SHWS_ENABLE_ONE = True
	;===>
	ShowEntity SHWS_ImgSHW_Obj
	;===>
End Function


;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShaderShadow( a_ImageLight, a_ImageCamera )
	
	; =========================================================
	; ===>
	Local BuffImageLight = TextureBuffer(a_ImageLight)
	Local BuffImageCamera = TextureBuffer(a_ImageCamera)
	; ===>
	Local l_IdX%, l_IdY%,l_Pc% ,l_Pl%
	
	
	Local l_ColAmb%	= (AMBIENTLIGHTCOLOR_R Shl 16)+(AMBIENTLIGHTCOLOR_G Shl 8)+ AMBIENTLIGHTCOLOR_B
	
	Local l_ColAmb_r%	= AMBIENTLIGHTCOLOR_R
	Local l_ColAmb_g%	= AMBIENTLIGHTCOLOR_G
	Local l_ColAmb_b%	= AMBIENTLIGHTCOLOR_B
	
	l_ColAmb_r%	= ( l_ColAmb Shr 16)	And $ff
	l_ColAmb_g%	= ( l_ColAmb Shr 8 )	And $ff
	l_ColAmb_b%	= ( l_ColAmb )				And $ff
	
	Local l_ColNorm%= (255 Shl 24)+(255 Shl 16)+(255 Shl 8)+ 255	
	; ===>
	Local YSize#	= (Float(SHWS_TexSize)*(Float(GraphicsHeight())/Float(GraphicsWidth())))
	Local YUp#		= (Float(SHWS_TexSize)-YSize)*.5
	Local YDw#		= SHWS_TexSize-YUp-1
	Local XDw#		= SHWS_TexSize-1
	
	; ===>
	LockBuffer BuffImageCamera
	LockBuffer BuffImageLight
	SetBuffer BuffImageLight
	; ===>
	For l_IdY = YUp To YDw
		For l_IdX = 0 To XDw
			; ===>
			l_Pc% = ReadPixelFast( l_IdX, l_IdY, BuffImageCamera)
			l_Pl% = ReadPixelFast( l_IdX, l_IdY ) + SHWS_Tollerance
			;===>
			If (l_Pl<l_Pc) Then 
				WritePixelFast l_IdX, l_IdY, l_ColAmb
			Else
				WritePixelFast l_IdX, l_IdY, l_ColNorm
			EndIf
			; ===>
		Next
	Next
	; ===>
	UnlockBuffer BuffImageCamera
	UnlockBuffer BuffImageLight
	SetBuffer BackBuffer()
	; ===>
End Function


;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SmoothTexture_Fast( a_Image, a_Smooth=2)
	; ===>
	Local l_x0%, l_y0%, l_Idy0%
	Local l_x1%, l_y1%, l_Idy1%
	Local l_x1_a%, l_x1_b%
	Local l_Color#, l_NColor#
	Local gfxbuffer=TextureBuffer(a_Image)
	; ===>
	LockBuffer gfxbuffer
	SetBuffer gfxbuffer
	For l_y0=0 To SHWS_TexSize-1
		l_Idy0 = l_y0*SHWS_TexSize
		For l_x0=0 To SHWS_TexSize-1
			; ===>
			SHWS_Pix(l_Idy0+l_x0) = ReadPixelFast( l_x0,l_y0,gfxbuffer) And $FF
			; ===>
		Next
	Next
	; ===>
	
	For l_y0=0 To SHWS_TexSize-1
		l_Idy0 = l_y0*SHWS_TexSize
		For l_x0=0 To SHWS_TexSize-1
			; ===>
			l_Color = 0;
			l_NColor = 0;
			; ===>
			For l_y1=l_y0-a_Smooth To l_y0+a_Smooth
				If (l_y1>=0 And l_y1<=SHWS_TexSize) Then 
					l_Idy1 = l_y1*SHWS_TexSize
					; ===>
					l_x1_a = l_x0-a_Smooth	: If (l_x1<0)						Then l_x1_a = 0
					l_x1_b = l_x0+a_Smooth	: If (l_x1>SHWS_TexSize)Then l_x1_a = SHWS_TexSize-1
					; ===>
					For l_x1=l_x1_a To l_x1_b
						; ===>
						l_NColor = l_NColor+1
						l_Color = l_Color+SHWS_Pix(l_Idy1+l_x1)
						; ===>
					Next
				EndIf
			Next
			; ===>
			l_Color = l_Color / l_NColor
			WritePixelFast l_x0,l_y0,((l_Color Shl 16)+(l_Color Shl 8)+l_Color)
			; ===>
		Next
	Next
	; ===>
	UnlockBuffer gfxbuffer
	SetBuffer BackBuffer()
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SmoothTexture( a_Image, a_Smooth=2)
	; ===>
	Local l_x0%, l_y0%, l_Idy0%
	Local l_x1%, l_y1%, l_Idy1%
	Local l_Color#, l_NColor#
	Local gfxbuffer=TextureBuffer(a_Image)
	; ===>
	LockBuffer gfxbuffer
	SetBuffer gfxbuffer
	For l_y0=0 To SHWS_TexSize-1
		l_Idy0 = l_y0*SHWS_TexSize
		For l_x0=0 To SHWS_TexSize-1
			; ===>
			SHWS_Pix(l_Idy0+l_x0) = ReadPixelFast( l_x0,l_y0,gfxbuffer) And $FF
			; ===>
		Next
	Next
	; ===>
	
	For l_y0=0 To SHWS_TexSize-1
		l_Idy0 = l_y0*SHWS_TexSize
		For l_x0=0 To SHWS_TexSize-1
			; ===>
			l_Color = 0;
			l_NColor = 0;
			; ===>
			For l_y1=l_y0-a_Smooth To l_y0+a_Smooth
				If (l_y1>=0 And l_y1<=SHWS_TexSize) Then 
					l_Idy1 = l_y1*SHWS_TexSize
					; ===>
					For l_x1=l_x0-a_Smooth To l_x0+a_Smooth
						; ===>
						If (l_x1>=0 And l_x1<=SHWS_TexSize) Then 
							l_NColor = l_NColor+1
							l_Color = l_Color+SHWS_Pix(l_Idy1+l_x1)
						EndIf
						; ===>
					Next
				EndIf
			Next
			; ===>
			l_Color = l_Color / l_NColor
			WritePixelFast l_x0,l_y0,((l_Color Shl 16)+(l_Color Shl 8)+l_Color)
			; ===>
		Next
	Next
	; ===>
	UnlockBuffer gfxbuffer
	SetBuffer BackBuffer()
	; ===>
End Function



;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShadowEnable()
	;===>
	SHWS_ENABLE = True
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShadowDisable()
	;===>
	SHWS_ENABLE = False
	;===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjSHW_Hide()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		If (l_CurModel\Caster) Then HideEntity l_CurModel\ObjShw 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjSHW_Show()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		If (l_CurModel\Caster) Then ShowEntity l_CurModel\ObjShw 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjOrig_Hide()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		HideEntity l_CurModel\ObjOrig 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjOrig_Show()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		ShowEntity l_CurModel\ObjOrig 
	Next
	;===>
End Function

Nate the Great

2009

nice job daredevil!

A bit buggy but pretty fast for being all native blitz3d

Yasha

2009

For getting the UV coords, I've found it's faster to drop TFormPoint altogether and instead use RotateMesh to spin the receiver around as though the light were at 0,0,1 and then use VertexX and VertexY. Also makes the maths simpler. Could be wrong though, I wasn't able to work out a fair benchmark to test the two methods properly.

I like the smoothing though. Looks pretty good. Nice work.

DareDevil

2009

Yasha send the example for your tecnique

thanks all bye ;)

BUG Fix

Function SHW_Init.SHWS_Shadow(a_Camera)

; ===>
SHWS_ENABLE =True
SHWS_Camera = a_Camera
; ===>
Local ValueTolA = 40
Local ValueTolB = ValueTolA/2
If(GraphicsDepth()<=16) Then
SHWS_Tollerance% = (ValueTolA Shl 16) + (ValueTolA Shl 8) + ValueTolA
Else
SHWS_Tollerance% = (ValueTolB Shl 16) + (ValueTolB Shl 8) + ValueTolB
EndIf

DareDevil

2009

Last Update

;===>O=========================o<=================================================================
;===>O=========================o<=================================================================
;===>	Name file: 
;===>
;===>	Programmatore:
;===>	  Caldarulo Vincenzo (Vision&Design Software)
;===>	Descrizione:
;===>
;===>O=========================o<=================================================================
;===>O=========================o<=================================================================
; 

Graphics3D 1024, 768, 32, 2
;------------------------------------------------------------------
;==============================================================
;
Global TextureTest = LoadTexture("alien.jpg",1+16+32);

;------------------------------------------------------------------
;==============================================================
Global Camera = CreateCamera() 
PositionEntity Camera,60,60,-60
RotateEntity Camera,30,45,0
SetBuffer BackBuffer()
;HWMultiTex True
SHW_Init(Camera)
; =================================================================================================
; ===>
Global IDCaster.SHWS_Shadow ,IDRecived.SHWS_Shadow
SetAmbientLight( 64, 64, 64)
SeedRnd MilliSecs()

LoadScene2()

Global LightObj = CreateSphere(8)
CreateLight(2,LightObj)
EntityColor LightObj,255,0,0
EntityFX LightObj,2

Global lightRot#=0
Global CenterWord = CreateCube() : EntityColor CenterWord,255,0,0 ;: HideEntity CenterWord
PositionEntity CenterWord, 0, 0, 0

; =================================================================================================
; ===>
HidePointer()
MoveMouse GraphicsWidth()/2,GraphicsHeight()/2
;===>


Local spd#=0.5

Local OldMillisecs = MilliSecs()

; =================================================================================================
; ===>
Repeat
	;WireFrame True
	AntiAlias True
	
	
	MoveEntity Camera,(KeyDown(205)-KeyDown(203))*spd,0,(MouseDown(1)-MouseDown(2))*spd
	TurnEntity Camera,-MouseYSpeed()*0.1,-MouseXSpeed()*0.1,0
	RotateEntity Camera,EntityPitch(Camera,True),EntityYaw(Camera,True),0
	
	MoveMouse GraphicsWidth()*.5,GraphicsHeight()*.5
	If KeyDown(46) Then  ;KEY "C"
		;===>
		
		PositionEntity	Camera, EntityX(LightObj), 		EntityY(LightObj), 	EntityZ(LightObj)
		RotateEntity		Camera, EntityPitch(LightObj), EntityYaw(LightObj), EntityRoll(LightObj)
		;===>
	EndIf
	
	; ===========================================================================
	; ===>
	Local distlight# = 50
	lightRot = lightRot + .1 
	PositionEntity LightObj, distlight*Cos(lightRot), 50+10*Sin(lightRot*10), distlight*Sin(lightRot)
	PositionEntity LightObj, distlight*Cos(lightRot), 100, 0
	PositionEntity LightObj, 0, 150, distlight*Sin(lightRot)
	
	PointEntity LightObj,CenterWord
	
	;If KeyDown(63) Then  Stop
	; ===========================================================================
	; ===>
	
	; ===>
	UpdateWorld() 
	SHW_Update(LightObj)
	RenderWorld()
	; ===>
	Local Ms=(MilliSecs()-OldMillisecs)
	OldMillisecs = MilliSecs()
	Text(10,10,"Ms: "+Ms+" FPS: " + 1000/Ms)
	
	
	Flip(False)
	; ===>
Until KeyHit(1)

End


Function LoadScene2()
	;===>
	Local Obj;
	;===>
	Local R = 10
	Local def=32
	Local x,z
	Local Segment=50
	Local scl=5
	;===>
;	Obj = LoadMesh("sponza.3ds")
;	PositionEntity Obj,0,-7,0
;	ScaleMesh Obj, scl*4, scl*3, scl*3
;	SHW_AddObject( Obj )
	;===>
	Obj = CreateCube()
	PositionEntity Obj,0,-5,0
	ScaleMesh Obj, scl*20, 1, scl*20
	SHW_AddObject( Obj )
	;===>
	;Obj = LoadMesh("media\Beethoven.b3d")
	Obj = CreateSphere(def)
	PositionEntity Obj,-R, R, -R
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj )
	;===>
	Obj = CreateCylinder(def,1)
	PositionEntity Obj,-R, R, R
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj )
		;===>
	Obj = CreateCube()
	PositionEntity Obj, R, R, R
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj )
	;===>
	;Obj = LoadMesh("Theodric2.3ds")
	;PositionEntity Obj, R, R,-R
	;ScaleEntity    Obj, scl, scl, scl
	;SHW_AddObject( Obj,True)
	;===>
	
End Function

; ================================================== 
; ----------------------------------------------- 
; 

Function DrawTexture(x,y,Texture)
	CopyRect 0,0,TextureWidth(Texture),TextureWidth(Texture),x,y,TextureBuffer(Texture),BackBuffer()
End Function

; ================================================== 
; ----------------------------------------------- 
;this function for internal use only
Function GetScaleValue#(EntityHandle, GetGlobal)
  Local X# = TFormedX()-EntityX(EntityHandle, GetGlobal)
  Local Y# = TFormedY()-EntityY(EntityHandle, GetGlobal)
  Local Z# = TFormedZ()-EntityZ(EntityHandle, GetGlobal)
  Return Sqr(X*X+Y*Y+Z*Z)
End Function 

; ================================================== 
; ----------------------------------------------- 

Function EntityScaleX#(EntityHandle, GetGlobal=True)  
  TFormPoint 1,0,0, EntityHandle, (Not GetGlobal)*GetParent(EntityHandle)  
  Return GetScaleValue#(EntityHandle, GetGlobal)
End Function 
; ================================================== 
; ----------------------------------------------- 

Function EntityScaleY#(EntityHandle, GetGlobal=True)  
  TFormPoint 0,1,0, EntityHandle, (Not GetGlobal)*GetParent(EntityHandle)  
  Return GetScaleValue#(EntityHandle, GetGlobal)
End Function 
; ================================================== 
; ----------------------------------------------- 

Function EntityScaleZ#(EntityHandle, GetGlobal=True)  
  TFormPoint 0,0,1, EntityHandle, (Not GetGlobal)*GetParent(EntityHandle)  
  Return GetScaleValue#(EntityHandle, GetGlobal)
End Function 

; ================================================== 
; ----------------------------------------------- 

Function EntityColor_(mesh,r,g,b)
	Local i,ww
	If mesh<>0
		If EntityClass$(mesh)="Mesh"
			EntityColor mesh,r,g,b
		EndIf
		For i=1 To CountChildren(mesh)
			ww=GetChild(mesh,i)
			EntityColor_(ww,r,g,b)
		Next
	EndIf
End Function
; ================================================== 
; ----------------------------------------------- 

Global AMBIENTLIGHTCOLOR_R# = 0
Global AMBIENTLIGHTCOLOR_G# = 0
Global AMBIENTLIGHTCOLOR_B# = 0

Function SetAmbientLight( a_R#=0.0, a_G#=0.0, a_B#=0.0 )
	; ===>
	AmbientLight a_R, a_G, a_B
	AMBIENTLIGHTCOLOR_R = a_R
	AMBIENTLIGHTCOLOR_G = a_G
	AMBIENTLIGHTCOLOR_B = a_B
	; ===>
End Function

;=================================================================================================================================
;----------------------------------------------------------------------------------------------------------------------------
;=====================================================
;===>

Type SHWS_Shadow 
	Field Caster
	Field ObjOrig
	Field ObjShw
End Type 
;=====================================================
;===>
Const SHWS_LevelTexture%	= 0
Const SHWS_TexSize# 			= Float(512)
Const SHWS_ConstSize#			= Float(1.0) / Float(SHWS_TexSize)
Const SHWS_Far# 					= Float(300)
Const SHWS_ConstColor# 		= Float(1.0) / Float(255.0)
Const SHWS_FactorZ# 			= Float(SHWS_Far) * Float(SHWS_ConstColor)

Dim SHWS_Pix(Int(SHWS_TexSize*SHWS_TexSize))
;=====================================================
;===>
Global SHWS_Camera%
Global SHWS_ShadowCam%
Global SHWS_ENABLE%			= True
Global SHWS_ENABLE_ONE%	= True
Global SHWS_TexLight%
Global SHWS_TexCam%
Global SHWS_TexBase%
Global SHWS_Tollerance%;

Global txdraw%

; ===>
; Create a fullscreen sprite
Global SHWS_ImgSHW_Obj

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_Init.SHWS_Shadow(a_Camera)
	; ===>
	SHWS_ENABLE = True
	SHWS_Camera	= a_Camera
	; ===>
	Local ValueTolA = 8
	Local ValueTolB = ValueTolA/2
	; ===>
	If(GraphicsDepth() <= 16) Then 
		SHWS_Tollerance% = (ValueTolA Shl 16) + (ValueTolA Shl 8) + ValueTolA
	Else 
		SHWS_Tollerance% = (ValueTolB Shl 16) + (ValueTolB Shl 8) + ValueTolB
	EndIf
	; ===>
	SHWS_ShadowCam = CreateCamera() 
	CameraClsColor	SHWS_ShadowCam, 255, 255, 255
	CameraViewport	SHWS_ShadowCam, 0, 0, SHWS_TexSize, SHWS_TexSize 	;the viewport the shadows will be rendered through.
	CameraZoom			SHWS_ShadowCam, 1.0
	CameraProjMode	SHWS_ShadowCam,1
	;HideEntity 			SHWS_ShadowCam
	; =====================================================================
	; ===>
	SHWS_TexLight = CreateTexture(SHWS_TexSize,SHWS_TexSize,1+16+32);+256)
	SHWS_TexCam		= CreateTexture(SHWS_TexSize,SHWS_TexSize,1+16+32);+256)
	TextureBlend SHWS_TexLight,2
	TextureBlend SHWS_TexCam,2
	
	; =====================================================================
	; ===>
	; Creazione della texture nulla per il pre rendering
	SHWS_TexBase = CreateTexture(16,16,1+16+32);+256)
	TextureBlend SHWS_TexBase,2
	SetBuffer TextureBuffer(SHWS_TexBase) ; 
	ClsColor 255, 255, 255
	Cls 
	ClsColor 0, 0, 0
	SetBuffer BackBuffer()
	; =====================================================================
	; ===>
	SHWS_ImgSHW_Obj 	= CreateSprite(a_Camera)
	; ===>
	PositionEntity  SHWS_ImgSHW_Obj, -0.0018, 0.0, 1.002
	EntityTexture		SHWS_ImgSHW_Obj, SHWS_TexLight
	EntityFX 				SHWS_ImgSHW_Obj, 1
	EntityBlend 		SHWS_ImgSHW_Obj, 2
	EntityAlpha 		SHWS_ImgSHW_Obj, 0.5
	HideEntity 			SHWS_ImgSHW_Obj
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_AddObject.SHWS_Shadow( Obj, Caster=True, TexAlpha=0)
	; ===>
	Local l_CurModel.SHWS_Shadow = New SHWS_Shadow
	; ===>
	l_CurModel\Caster		= Caster	
	l_CurModel\ObjOrig	= Obj
	; ===>
	If (l_CurModel\Caster)
		; ===>
		l_CurModel\ObjShw = CopyMesh(l_CurModel\ObjOrig)
		EntityTexture		l_CurModel\ObjShw, SHWS_TexBase, 0, SHWS_LevelTexture
		EntityFX 				l_CurModel\ObjShw, 1+2+8
		HideEntity l_CurModel\ObjShw
		; ===>
	EndIf
	; ===>
	Return l_CurModel
	; ===>
End Function

; =====================================================
; ===>
;
; ===>
;
Function SHW_Update( s_light)
	; ===>
	If (Not SHWS_ENABLE) Then Return
	; ===>
	Local Id_SHWS_TexCam%		= TextureBuffer(SHWS_TexCam)
	Local Id_SHWS_TexLight%	= TextureBuffer(SHWS_TexLight)
	; ===>
	Dither False
	AmbientLight	255,255,255
	ClsColor 0,0,0
	Viewport 0, 0, SHWS_TexSize, SHWS_TexSize
	CameraViewport	SHWS_ShadowCam, 1, 1, SHWS_TexSize-2, SHWS_TexSize-2 	;the viewport the shadows will be rendered through.
	; ===>
	HideEntity		SHWS_ImgSHW_Obj
	; disable shadow camera
	CameraProjMode SHWS_Camera,0
	CameraProjMode SHWS_ShadowCam,1
	;===>
	SHW_ObjOrig_Hide()
	SHW_ObjSHW_Show()
	;===>
	PositionEntity	SHWS_ShadowCam, EntityX(s_light,True),			EntityY(s_light,True),		EntityZ(s_light,True)
	RotateEntity		SHWS_ShadowCam, EntityPitch(s_light,True),	EntityYaw(s_light,True),	EntityRoll(s_light,True)
	;===>
	Local l_CurModel.SHWS_Shadow
	Local IdSurf%, CurSurf%, IdVert%, CntVert%	
	Local ObjRec%, ObjShw%
	Local l_Vx#, l_Vy#, l_Vz# 
	Local l_ColorZ#, l_TexU#, l_TexV#
	Local ValTest# = 1.0;
	Local l_TSize# = SHWS_TexSize/2;
	;===>
	For l_CurModel = Each SHWS_Shadow
		;========================================================================
		;===>
		If (l_CurModel\Caster And SHWS_ENABLE) Then
			;========================================================================
			; ===>
			ObjRec = l_CurModel\ObjOrig
			ObjShw = l_CurModel\ObjShw;
			; ===>
			PositionEntity	ObjShw, EntityX     (ObjRec, True), EntityY     (ObjRec, True), EntityZ     (ObjRec, True)
			RotateEntity 		ObjShw, EntityPitch (ObjRec, True), EntityYaw   (ObjRec, True), EntityRoll  (ObjRec, True)
			ScaleEntity			ObjShw, EntityScaleX(ObjRec, True), EntityScaleY(ObjRec, True), EntityScaleZ(ObjRec, True)
			EntityTexture		ObjShw, SHWS_TexBase, 0, SHWS_LevelTexture
			EntityFX 				ObjShw, 1+2+8
			; ===>
			; =========================================================
			; Generate texture coordinate
			;	===>
			For IdSurf=1 To CountSurfaces(ObjShw) 
				; =========================================================
				CurSurf = GetSurface( ObjShw, IdSurf ) 
				CntVert = CountVertices(CurSurf)-1
				; =========================================================
				For IdVert=0 To CntVert
					; =========================================================
					TFormPoint( VertexX#( CurSurf, IdVert), VertexY#( CurSurf, IdVert), VertexZ#( CurSurf, IdVert), ObjShw, SHWS_ShadowCam)
					If (TFormedZ()>0) Then 
						VertexColor( CurSurf, IdVert, TFormedZ#()*SHWS_FactorZ, TFormedZ#()*SHWS_FactorZ, TFormedZ#()*SHWS_FactorZ)
					Else
						;VertexColor( CurSurf, IdVert, 255, 255, 255 )
						VertexColor( CurSurf, IdVert, 0, 0, 0 )
					EndIf
					; =========================================================
					TFormPoint( VertexX#( CurSurf, IdVert), VertexY#( CurSurf, IdVert), VertexZ#( CurSurf, IdVert), ObjShw, 0)
					CameraProject( SHWS_ShadowCam, TFormedX#(), TFormedY#(), TFormedZ#())
					
					l_TexU# = (l_TSize+((ProjectedX#()-l_TSize)*ValTest))*SHWS_ConstSize
					l_TexV# = (l_TSize+((ProjectedY#()-l_TSize)*ValTest*2))*SHWS_ConstSize
					
					;l_TexU# = ProjectedX#()/SHWS_TexSize
					;l_TexV# = ProjectedY#()/SHWS_TexSize
					VertexTexCoords( CurSurf, IdVert, l_TexU, l_TexV, 0, 0 )
					; =========================================================
				Next 
				; ===>
			Next 
			; ===>
			; =========================================================
		EndIf	
		;===>
		;=========================================================
	Next
	; =========================================================
	; ===>
	Cls
	RenderWorld()
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexLight)
	
	;SmoothTexture_Fast(SHWS_TexLight)
	;Return
	; =========================================================
	; ===>
	; ora metto la telecamera dal punto di vista di visione normale
	PositionEntity SHWS_ShadowCam, EntityX(SHWS_Camera,True)    , EntityY(SHWS_Camera,True)  , EntityZ(SHWS_Camera,True)
	RotateEntity	 SHWS_ShadowCam, EntityPitch(SHWS_Camera,True), EntityYaw(SHWS_Camera,True), EntityRoll(SHWS_Camera,True)
	; ===>
	;	renderizzo il finto zbuffer calcolato rispetto alla luce
	Cls
	RenderWorld()
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexCam)
	;Return
	; =========================================================
	; ===> 
	; proietto la texture calcolata dal punto di vista della luce su i poligoni
	For l_CurModel = Each SHWS_Shadow
		;===>
		If (l_CurModel\Caster And SHWS_ENABLE) Then 
			EntityTexture l_CurModel\ObjShw, SHWS_TexLight, 0, SHWS_LevelTexture
			EntityFX 			l_CurModel\ObjShw, 1+8
		EndIf
		;===>
	Next
	;Return
	; =========================================================
	; ===>
	RenderWorld()
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexLight)
	;Return
	; =========================================================
	; ===>
	SHW_ShaderShadow(SHWS_TexLight,SHWS_TexCam)
	; ===>
	; =========================================================
	;===>
	ClsColor 0, 0, 0
	SetBuffer BackBuffer()
	;===>
	; disable shadow camera
	CameraProjMode SHWS_Camera,1		: SHW_ObjSHW_Hide()
	CameraProjMode SHWS_ShadowCam,0 : SHW_ObjOrig_Show()
	
;	HideEntity SHWS_ShadowCam	: SHW_ObjSHW_Hide()
;	ShowEntity SHWS_Camera 		: SHW_ObjOrig_Show()
	;===>
	AmbientLight	 AMBIENTLIGHTCOLOR_R, AMBIENTLIGHTCOLOR_G, AMBIENTLIGHTCOLOR_B
	;===>
	If (SHWS_ENABLE) Then SHWS_ENABLE_ONE = False Else SHWS_ENABLE_ONE = True
	;===>
	ShowEntity SHWS_ImgSHW_Obj
	; ===>
	Viewport 0,0,GraphicsWidth(),GraphicsHeight()
	Dither True
	; ===>
End Function


;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShaderShadow( a_ImageLight, a_ImageCamera )
	
	; =========================================================
	; ===>
	Local BuffImageLight = TextureBuffer(a_ImageLight)
	Local BuffImageCamera = TextureBuffer(a_ImageCamera)
	; ===>
	Local l_IdX%, l_IdY%,l_Pc% ,l_Pl%
	
	Local l_ColAmb%	= (AMBIENTLIGHTCOLOR_R Shl 16)+(AMBIENTLIGHTCOLOR_G Shl 8)+ AMBIENTLIGHTCOLOR_B
	
	Local l_ColNorm%= (255 Shl 24)+(255 Shl 16)+(255 Shl 8)+ 255	
	; ===>
	Local YSize#	= (Float(SHWS_TexSize)*(Float(GraphicsHeight())/Float(GraphicsWidth())))
	Local YUp#		= (Float(SHWS_TexSize)-YSize)*.5
	Local YDw#		= SHWS_TexSize-YUp-1
	Local XDw#		= SHWS_TexSize-1
	; ===>
	LockBuffer BuffImageCamera
	LockBuffer BuffImageLight
	SetBuffer BuffImageLight
	; ===>
	For l_IdY = YUp To YDw
		For l_IdX = 0 To XDw
			; ===>
			l_Pc% = ReadPixelFast( l_IdX, l_IdY, BuffImageCamera)
			l_Pl% = ReadPixelFast( l_IdX, l_IdY ) + SHWS_Tollerance
			;===>
			If (l_Pl<l_Pc) Then 
				WritePixelFast l_IdX, l_IdY, l_ColAmb;l_Alpha
			Else
				WritePixelFast l_IdX, l_IdY, l_ColNorm
			EndIf
			; ===>
		Next
	Next
	; ===>
	UnlockBuffer BuffImageCamera
	UnlockBuffer BuffImageLight
	SetBuffer BackBuffer()
	; ===>
End Function


;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SmoothTexture_Fast( a_Image, a_Smooth=2)
	; ===>
	Local l_x0%, l_y0%, l_Idy0%
	Local l_x1%, l_y1%, l_Idy1%
	Local l_x1_a%, l_x1_b%
	Local l_Color#, l_NColor#
	Local gfxbuffer=TextureBuffer(a_Image)
	; ===>
	LockBuffer gfxbuffer
	SetBuffer gfxbuffer
	For l_y0=0 To SHWS_TexSize-1
		l_Idy0 = l_y0*SHWS_TexSize
		For l_x0=0 To SHWS_TexSize-1
			; ===>
			SHWS_Pix(l_Idy0+l_x0) = ReadPixelFast( l_x0+1, l_y0+1, gfxbuffer) And $FF
			; ===>
		Next
	Next
	; ===>
	
	For l_y0=0 To SHWS_TexSize-1
		; ===>
		l_Idy0 = l_y0*SHWS_TexSize
		; ===>
		For l_x0=0 To SHWS_TexSize-1
			; ===>
			l_Color = 0;
			l_NColor = 0;
			; ===>
			For l_y1=l_y0-a_Smooth To l_y0+a_Smooth
				If (l_y1>=0 And l_y1<=SHWS_TexSize) Then 
					l_Idy1 = l_y1*SHWS_TexSize
					; ===>
					l_x1_a = l_x0-a_Smooth	: If (l_x1<0)						Then l_x1_a = 0
					l_x1_b = l_x0+a_Smooth	: If (l_x1>SHWS_TexSize)Then l_x1_a = SHWS_TexSize-1
					; ===>
					For l_x1=l_x1_a To l_x1_b
						; ===>
						l_NColor = l_NColor+1
						l_Color = l_Color+SHWS_Pix(l_Idy1+l_x1)
						; ===>
					Next
				EndIf
			Next
			; ===>
			l_Color = l_Color / l_NColor
			WritePixelFast l_x0,l_y0,((l_Color Shl 16)+(l_Color Shl 8)+l_Color)
			; ===>
		Next
	Next
	; ===>
	UnlockBuffer gfxbuffer
	SetBuffer BackBuffer()
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SmoothTexture( a_Image, a_Smooth=2)
	; ===>
	Local l_x0%, l_y0%, l_Idy0%
	Local l_x1%, l_y1%, l_Idy1%
	Local l_Color#, l_NColor#
	Local gfxbuffer=TextureBuffer(a_Image)
	; ===>
	LockBuffer gfxbuffer
	SetBuffer gfxbuffer
	For l_y0=0 To SHWS_TexSize-1
		l_Idy0 = l_y0*SHWS_TexSize
		For l_x0=0 To SHWS_TexSize-1
			; ===>
			SHWS_Pix(l_Idy0+l_x0) = ReadPixelFast( l_x0,l_y0,gfxbuffer) And $FF
			; ===>
		Next
	Next
	; ===>
	
	For l_y0=0 To SHWS_TexSize-1
		l_Idy0 = l_y0*SHWS_TexSize
		For l_x0=0 To SHWS_TexSize-1
			; ===>
			l_Color = 0;
			l_NColor = 0;
			; ===>
			For l_y1=l_y0-a_Smooth To l_y0+a_Smooth
				If (l_y1>=0 And l_y1<=SHWS_TexSize) Then 
					l_Idy1 = l_y1*SHWS_TexSize
					; ===>
					For l_x1=l_x0-a_Smooth To l_x0+a_Smooth
						; ===>
						If (l_x1>=0 And l_x1<=SHWS_TexSize) Then 
							l_NColor = l_NColor+1
							l_Color = l_Color+SHWS_Pix(l_Idy1+l_x1)
						EndIf
						; ===>
					Next
				EndIf
			Next
			; ===>
			l_Color = l_Color / l_NColor
			WritePixelFast l_x0,l_y0,((l_Color Shl 16)+(l_Color Shl 8)+l_Color)
			; ===>
		Next
	Next
	; ===>
	UnlockBuffer gfxbuffer
	SetBuffer BackBuffer()
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShadowEnable()
	;===>
	SHWS_ENABLE = True
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShadowDisable()
	;===>
	SHWS_ENABLE = False
	;===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjSHW_Hide()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		If (l_CurModel\Caster) Then HideEntity l_CurModel\ObjShw 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjSHW_Show()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		If (l_CurModel\Caster) Then ShowEntity l_CurModel\ObjShw 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjOrig_Hide()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		HideEntity l_CurModel\ObjOrig 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjOrig_Show()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		ShowEntity l_CurModel\ObjOrig 
	Next
	;===>
End Function





;	;========================================================================
;	Color 0,0,255
;	Local plx1#, plx2#, plx3#
;	Local ply1#, ply2#, ply3#
;	
;	For l_CurModel = Each SHWS_Shadow
;		;========================================================================
;		;===>
;		If (l_CurModel\Caster And SHWS_ENABLE) Then
;			;========================================================================
;			; ===>
;			ObjRec = l_CurModel\ObjOrig
;			ObjShw = l_CurModel\ObjShw;
;			; ===>
;			; =========================================================
;			; Generate texture coordinate
;			;	===>
;			For IdSurf=1 To CountSurfaces(ObjShw) 
;				; ===>
;				CurSurf = GetSurface( ObjShw, IdSurf ) 
;				CntVert = CountTriangles(CurSurf)
;				; ===>
;				For IdVert=0 To CntVert-1
;					Local p1 = TriangleVertex( CurSurf, IdVert, 0)
;					Local p2 = TriangleVertex( CurSurf, IdVert, 1) 
;					Local p3 = TriangleVertex( CurSurf, IdVert, 2)
;					; =========================================================
;					l_Vx = VertexX#( CurSurf, p1) : l_Vy = VertexY#( CurSurf, p1) : l_Vz = VertexZ#( CurSurf, p1)
;					; =========================================================
;					; ===>
;					TFormPoint l_Vx, l_Vy, l_Vz, ObjShw, 0
;					CameraProject SHWS_ShadowCam, TFormedX#(), TFormedY#(), TFormedZ#()
;					plx1# = ProjectedX#() : ply1# = ProjectedY#()
;					;VertexTexCoords CurSurf, p1, plx1*SHWS_ConstSize, ply1*SHWS_ConstSize, 0, 0
;					; ===>
;					; =========================================================
;					l_Vx = VertexX#( CurSurf, p2) : l_Vy = VertexY#( CurSurf, p2) : l_Vz = VertexZ#( CurSurf, p2)
;					; =========================================================
;					; ===>
;					TFormPoint l_Vx, l_Vy, l_Vz, ObjShw, 0
;					CameraProject SHWS_ShadowCam, TFormedX#(), TFormedY#(), TFormedZ#()
;					plx2# = ProjectedX#() : ply2# = ProjectedY#()
;					;VertexTexCoords CurSurf, p2, plx2*SHWS_ConstSize, ply2*SHWS_ConstSize, 0, 0
;					; ===>
;					; =========================================================
;					l_Vx = VertexX#( CurSurf, p3) : l_Vy = VertexY#( CurSurf, p3) : l_Vz = VertexZ#( CurSurf, p3)
;					; =========================================================
;					; ===>
;					TFormPoint l_Vx, l_Vy, l_Vz, ObjShw, 0
;					CameraProject SHWS_ShadowCam, TFormedX#(), TFormedY#(), TFormedZ#()
;					plx3# = ProjectedX#() : ply3# = ProjectedY#()
;					;VertexTexCoords CurSurf, p3, plx3*SHWS_ConstSize, ply3*SHWS_ConstSize, 0, 0
;					; =========================================================
;					Line plx1,ply1,plx2,ply2 : Line plx2,ply2,plx3,ply3 : Line plx3,ply3,plx1,ply1
;					; =========================================================
;				Next 
;				; ===>
;			Next 
;			; ===>
;			; =========================================================
;		EndIf	
;		;===>
;	Next
;	If KeyDown(29)Then Stop
;	Color 255,255,255
;	;=========================================================

	;Stop
	; =========================================================
	; ===>
	;	Costruito il finto zbuffer, generiamo la texture dal punto di vista della luce che sar� proiettata sull'oggetto

DareDevil

2009

Hi All
i have update the version for BUG FIX

;===>O=========================o<=================================================================
;===>O=========================o<=================================================================
;===>	Name file: 
;===>
;===>	Programmatore:
;===>	  Caldarulo Vincenzo (Vision&Design Software)
;===>	Descrizione:
;===>
;===>O=========================o<=================================================================
;===>O=========================o<=================================================================
; 

Graphics3D 1024, 768, 32, 2
;------------------------------------------------------------------
;==============================================================
;
Global TextureTest = LoadTexture("alien.jpg",1+16+32);
Dim SHWS_Pix%(512*512)
;------------------------------------------------------------------
;==============================================================
Global Camera = CreateCamera() 
PositionEntity Camera,60,60,-60
RotateEntity Camera,30,45,0
SetBuffer BackBuffer()
;HWMultiTex True
SHW_Init(Camera)
; =================================================================================================
; ===>
Global IDCaster.SHWS_Shadow ,IDRecived.SHWS_Shadow
SetAmbientLight( 64, 64, 64)
SeedRnd MilliSecs()

LoadScene2()

Global LightObj = CreateSphere(8)
CreateLight(2,LightObj)
EntityColor LightObj,255,0,0
EntityFX LightObj,2

Global lightRot#=0
Global CenterWord = CreateCube() : EntityColor CenterWord,255,0,0 ;: HideEntity CenterWord
PositionEntity CenterWord, 0, 0, 0

; =================================================================================================
; ===>
HidePointer()
MoveMouse GraphicsWidth()/2,GraphicsHeight()/2
;===>


Local spd#=0.5

Local OldMillisecs = MilliSecs()

; =================================================================================================
; ===>
Repeat
	;WireFrame True
	AntiAlias True
	
	MoveEntity Camera,(KeyDown(205)-KeyDown(203))*spd,0,(MouseDown(1)-MouseDown(2))*spd
	TurnEntity Camera,-MouseYSpeed()*0.1,-MouseXSpeed()*0.1,0
	RotateEntity Camera,EntityPitch(Camera,True),EntityYaw(Camera,True),0
	
	MoveMouse GraphicsWidth()*.5,GraphicsHeight()*.5
	If KeyDown(46) Then  ;KEY "C"
		;===>
		
		PositionEntity	Camera, EntityX(LightObj), 		EntityY(LightObj), 	EntityZ(LightObj)
		RotateEntity		Camera, EntityPitch(LightObj), EntityYaw(LightObj), EntityRoll(LightObj)
		;===>
	EndIf
	
	; ===========================================================================
	; ===>
	Local distlight# = 50
	lightRot = lightRot + .1 
	PositionEntity LightObj, distlight*Cos(lightRot), 50+10*Sin(lightRot*10), distlight*Sin(lightRot)
	PositionEntity LightObj, distlight*Cos(lightRot), 100, 0
	PositionEntity LightObj, 0, 150, distlight*Sin(lightRot)
	
	PointEntity LightObj,CenterWord
	
	;If KeyDown(63) Then  Stop
	; ===========================================================================
	; ===>
	
	; ===>
	UpdateWorld() 
	SHW_Update(LightObj)
	RenderWorld()
	; ===>
	Local Ms=(MilliSecs()-OldMillisecs)
	OldMillisecs = MilliSecs()
	Text(10,10,"Ms: "+Ms+" FPS: " + 1000/Ms)
	
	
	Flip(False)
	; ===>
Until KeyHit(1)

End


Function LoadScene2()
	;===>
	Local Obj;
	;===>
	Local R = 10
	Local def=32
	Local x,z
	Local Segment=50
	Local scl=5
	;===>
;	Obj = LoadMesh("sponza.3ds")
;	PositionEntity Obj,0,-7,0
;	ScaleMesh Obj, scl*4, scl*3, scl*3
;	SHW_AddObject( Obj )
	;===>
	Obj = CreateCube()
	PositionEntity Obj,0,-5,0
	ScaleMesh Obj, scl*20, 1, scl*20
	SHW_AddObject( Obj )
	;===>
	;Obj = LoadMesh("media\Beethoven.b3d")
	Obj = CreateSphere(def)
	PositionEntity Obj,-R, R, -R
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj )
	;===>
	Obj = CreateCylinder(def,1)
	PositionEntity Obj,-R, R, R
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj )
		;===>
	Obj = CreateCube()
	PositionEntity Obj, R, R, R
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj )
	;===>
	Obj = LoadMesh("Theodric2.3ds")
	PositionEntity Obj, R, R,-R
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj,True)
	;===>
	
End Function

; ================================================== 
; ----------------------------------------------- 
; 

Function DrawTexture(x,y,Texture)
	CopyRect 0,0,TextureWidth(Texture),TextureWidth(Texture),x,y,TextureBuffer(Texture),BackBuffer()
End Function

; ================================================== 
; ----------------------------------------------- 
;this function for internal use only
Function GetScaleValue#(EntityHandle, GetGlobal)
  Local X# = TFormedX()-EntityX(EntityHandle, GetGlobal)
  Local Y# = TFormedY()-EntityY(EntityHandle, GetGlobal)
  Local Z# = TFormedZ()-EntityZ(EntityHandle, GetGlobal)
  Return Sqr(X*X+Y*Y+Z*Z)
End Function 

; ================================================== 
; ----------------------------------------------- 

Function EntityScaleX#(EntityHandle, GetGlobal=True)  
  TFormPoint 1,0,0, EntityHandle, (Not GetGlobal)*GetParent(EntityHandle)  
  Return GetScaleValue#(EntityHandle, GetGlobal)
End Function 
; ================================================== 
; ----------------------------------------------- 

Function EntityScaleY#(EntityHandle, GetGlobal=True)  
  TFormPoint 0,1,0, EntityHandle, (Not GetGlobal)*GetParent(EntityHandle)  
  Return GetScaleValue#(EntityHandle, GetGlobal)
End Function 
; ================================================== 
; ----------------------------------------------- 

Function EntityScaleZ#(EntityHandle, GetGlobal=True)  
  TFormPoint 0,0,1, EntityHandle, (Not GetGlobal)*GetParent(EntityHandle)  
  Return GetScaleValue#(EntityHandle, GetGlobal)
End Function 

; ================================================== 
; ----------------------------------------------- 

Function EntityColor_(mesh,r,g,b)
	Local i,ww
	If mesh<>0
		If EntityClass$(mesh)="Mesh"
			EntityColor mesh,r,g,b
		EndIf
		For i=1 To CountChildren(mesh)
			ww=GetChild(mesh,i)
			EntityColor_(ww,r,g,b)
		Next
	EndIf
End Function
; ================================================== 
; ----------------------------------------------- 

Global AMBIENTLIGHTCOLOR_R# = 0
Global AMBIENTLIGHTCOLOR_G# = 0
Global AMBIENTLIGHTCOLOR_B# = 0

Function SetAmbientLight( a_R#=0.0, a_G#=0.0, a_B#=0.0 )
	; ===>
	AmbientLight a_R, a_G, a_B
	AMBIENTLIGHTCOLOR_R = a_R
	AMBIENTLIGHTCOLOR_G = a_G
	AMBIENTLIGHTCOLOR_B = a_B
	; ===>
End Function

;=================================================================================================================================
;----------------------------------------------------------------------------------------------------------------------------
;=====================================================
;===>

Type SHWS_Shadow 
	Field Caster
	Field ObjOrig
	Field ObjShw
End Type 
;=====================================================
;===>
Const SHWS_LevelTexture%	= 0
Const SHWS_TexSize# 			= Float(512)
Const SHWS_ConstSize#			= Float(1.0) / (SHWS_TexSize-1.0)
Const SHWS_Far# 					= Float(300)
Const SHWS_ConstColor# 		= Float(255.0)
Const SHWS_FactorZ# 			= Float(1.0) /( SHWS_Far / SHWS_ConstColor )
;=====================================================
;===>
Const SHWS_ARRAY% = Int(SHWS_TexSize*SHWS_TexSize)
;Dim SHWS_Pix%(SHWS_ARRAY)
;=====================================================
;===>
Global SHWS_Camera%
Global SHWS_ShadowCam%
Global SHWS_ENABLE%			= True
Global SHWS_ENABLE_ONE%	= True
Global SHWS_TexLight%
Global SHWS_TexCam%
Global SHWS_TexBase%
Global SHWS_Tollerance%;

Global txdraw%

; ===>
; Create a fullscreen sprite
Global SHWS_ImgSHW_Obj

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_Init.SHWS_Shadow(a_Camera)
	; ===>
	SHWS_ENABLE = True
	SHWS_Camera	= a_Camera
	; ===>
	Local ValueTolA% = 8
	; ===>
	If(GraphicsDepth() <= 16) Then 
		SHWS_Tollerance% = (ValueTolA Shl 16) + (ValueTolA Shl 8) + ValueTolA
	Else 
		Local ValueTolB% = ValueTolA/2
		SHWS_Tollerance% = (ValueTolB Shl 16) + (ValueTolB Shl 8) + ValueTolB
	EndIf
	; ===>
	SHWS_ShadowCam = CreateCamera() 
	CameraClsColor	SHWS_ShadowCam, 255, 255, 255
	CameraViewport	SHWS_ShadowCam, 0, 0, SHWS_TexSize, SHWS_TexSize 	;the viewport the shadows will be rendered through.
	CameraZoom			SHWS_ShadowCam, 1.0
	HideEntity 			SHWS_ShadowCam
	; =====================================================================
	; ===>
	SHWS_TexLight = CreateTexture(SHWS_TexSize,SHWS_TexSize,1+16+32);+256)
	SHWS_TexCam		= CreateTexture(SHWS_TexSize,SHWS_TexSize,1+16+32);+256)
	TextureBlend SHWS_TexLight,2
	TextureBlend SHWS_TexCam,2
	
	; =====================================================================
	; ===>
	; Creazione della texture nulla per il pre rendering
	SHWS_TexBase = CreateTexture(16,16,1+16+32);+256)
	TextureBlend SHWS_TexBase,2
	SetBuffer TextureBuffer(SHWS_TexBase) ; 
	ClsColor 255, 255, 255
	Cls 
	ClsColor 0, 0, 0
	SetBuffer BackBuffer()
	; =====================================================================
	; ===>
	SHWS_ImgSHW_Obj 	= CreateSprite(a_Camera)
	; ===>
	PositionEntity  SHWS_ImgSHW_Obj, -0.0018, 0.0, 1.002
	EntityTexture		SHWS_ImgSHW_Obj, SHWS_TexLight
	EntityFX 				SHWS_ImgSHW_Obj, 1
	EntityBlend 		SHWS_ImgSHW_Obj, 2
	EntityAlpha 		SHWS_ImgSHW_Obj, 0.5
	HideEntity 			SHWS_ImgSHW_Obj
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_AddObject.SHWS_Shadow( Obj, Caster=True, TexAlpha=0)
	; ===>
	Local l_CurModel.SHWS_Shadow = New SHWS_Shadow
	; ===>
	l_CurModel\Caster		= Caster	
	l_CurModel\ObjOrig	= Obj
	; ===>
	If (l_CurModel\Caster)
		; ===>
		l_CurModel\ObjShw = CopyMesh(l_CurModel\ObjOrig)
		EntityTexture		l_CurModel\ObjShw, SHWS_TexBase, 0, SHWS_LevelTexture
		EntityFX 				l_CurModel\ObjShw, 1+2+8
		HideEntity l_CurModel\ObjShw
		; ===>
	EndIf
	; ===>
	Return l_CurModel
	; ===>
End Function

; =====================================================
; ===>
;
; ===>
;
Function SHW_Update( s_light)
	; ===>
	If (Not SHWS_ENABLE) Then Return
	; ===>
	Local Id_SHWS_TexCam%		= TextureBuffer(SHWS_TexCam)
	Local Id_SHWS_TexLight%	= TextureBuffer(SHWS_TexLight)
	; ===>
	Dither False
	AmbientLight	255,255,255
	ClsColor 0,0,0
	Viewport 0, 0, SHWS_TexSize, SHWS_TexSize
	;CameraViewport	SHWS_ShadowCam, 1, 1, SHWS_TexSize-2, SHWS_TexSize-2 	;the viewport the shadows will be rendered through.
	; ===>
	HideEntity		SHWS_ImgSHW_Obj
	HideEntity 		SHWS_Camera					; The in game camera must be hidden,
	ShowEntity 		SHWS_ShadowCam			; and the shadow camera must become visable.
	;===>
	SHW_ObjOrig_Hide()
	SHW_ObjSHW_Show()
	;===>
	PositionEntity	SHWS_ShadowCam, EntityX(s_light,True),			EntityY(s_light,True),		EntityZ(s_light,True)
	RotateEntity		SHWS_ShadowCam, EntityPitch(s_light,True),	EntityYaw(s_light,True),	EntityRoll(s_light,True)
	;===>
	Local l_CurModel.SHWS_Shadow
	Local IdSurf%, CurSurf%, IdVert%, CntVert%	
	Local ObjRec%, ObjShw%
	Local l_Vx#, l_Vy#, l_Vz# 
	Local l_ColorZ#, l_TexU#, l_TexV#
	Local ValTest# = 1.0;
	Local l_TSize# = SHWS_TexSize/2;
	;===>
	For l_CurModel = Each SHWS_Shadow
		;========================================================================
		;===>
		If (l_CurModel\Caster And SHWS_ENABLE) Then
			;========================================================================
			; ===>
			ObjRec = l_CurModel\ObjOrig
			ObjShw = l_CurModel\ObjShw;
			; ===>
			PositionEntity	ObjShw, EntityX     (ObjRec, True), EntityY     (ObjRec, True), EntityZ     (ObjRec, True)
			RotateEntity 		ObjShw, EntityPitch (ObjRec, True), EntityYaw   (ObjRec, True), EntityRoll  (ObjRec, True)
			ScaleEntity			ObjShw, EntityScaleX(ObjRec, True), EntityScaleY(ObjRec, True), EntityScaleZ(ObjRec, True)
;			EntityTexture		ObjShw, SHWS_TexBase, 0, SHWS_LevelTexture
;			EntityFX 				ObjShw, 1+2+8
			EntityTextureTree	( ObjShw, SHWS_TexBase, 0, SHWS_LevelTexture)
			EntityFxTree 			(	ObjShw, 1+2+8)
			; ===>
			; =========================================================
			; Generate texture coordinate
			;	===>
			For IdSurf=1 To CountSurfaces(ObjShw) 
				; =========================================================
				CurSurf = GetSurface( ObjShw, IdSurf ) 
				CntVert = CountVertices(CurSurf)-1
				; =========================================================
				For IdVert=0 To CntVert
					; =========================================================
					TFormPoint( VertexX#( CurSurf, IdVert), VertexY#( CurSurf, IdVert), VertexZ#( CurSurf, IdVert), ObjShw, SHWS_ShadowCam)
					If (TFormedZ()>0) Then 
						VertexColor( CurSurf, IdVert, TFormedZ#()*SHWS_FactorZ, TFormedZ#()*SHWS_FactorZ, TFormedZ#()*SHWS_FactorZ)
					Else
						;VertexColor( CurSurf, IdVert, 255, 255, 255 )
						VertexColor( CurSurf, IdVert, 0, 0, 0 )
					EndIf
					; =========================================================
					TFormPoint( VertexX#( CurSurf, IdVert), VertexY#( CurSurf, IdVert), VertexZ#( CurSurf, IdVert), ObjShw, 0)
					CameraProject( SHWS_ShadowCam, TFormedX#(), TFormedY#(), TFormedZ#())
					VertexTexCoords( CurSurf, IdVert, ProjectedX#()*SHWS_ConstSize,  ProjectedY#()*SHWS_ConstSize, 0, 0 )
					
;					l_TexU# = (l_TSize+((ProjectedX#()-l_TSize)*ValTest))*SHWS_ConstSize
;					l_TexV# = (l_TSize+((ProjectedY#()-l_TSize)*ValTest))*SHWS_ConstSize
;					VertexTexCoords( CurSurf, IdVert, l_TexU, l_TexV, 0, 0 )
					; =========================================================
				Next 
				; ===>
			Next 
			; ===>
			; =========================================================
		EndIf	
		;===>
		;=========================================================
	Next
	; =========================================================
	; ===>
	Cls
	RenderWorld()
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexLight)
	;Return
	; =========================================================
	; ===>
	; ora metto la telecamera dal punto di vista di visione normale
	PositionEntity SHWS_ShadowCam, EntityX(SHWS_Camera,True)    , EntityY(SHWS_Camera,True)  , EntityZ(SHWS_Camera,True)
	RotateEntity	 SHWS_ShadowCam, EntityPitch(SHWS_Camera,True), EntityYaw(SHWS_Camera,True), EntityRoll(SHWS_Camera,True)
	; ===>
	;	renderizzo il finto zbuffer calcolato rispetto alla luce
	Cls
	RenderWorld()
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexCam)
	;Return
	; =========================================================
	; ===> 
	; proietto la texture calcolata dal punto di vista della luce su i poligoni
	For l_CurModel = Each SHWS_Shadow
		;===>
		If (l_CurModel\Caster And SHWS_ENABLE) Then 
;			EntityTexture l_CurModel\ObjShw, SHWS_TexLight, 0, SHWS_LevelTexture
;			EntityFX 			l_CurModel\ObjShw, 1+8
			EntityTextureTree (l_CurModel\ObjShw, SHWS_TexLight, 0, SHWS_LevelTexture)
			EntityFxTree 			(l_CurModel\ObjShw, 1+8)
		EndIf
		;===>
	Next
	;Return
	; =========================================================
	; ===>
	RenderWorld()
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexLight)
	;Return
	; =========================================================
	; ===>
	SHW_ShaderShadow(SHWS_TexLight,SHWS_TexCam)
	;SmoothTexture_Fast(SHWS_TexLight,4)
	; ===>
	; =========================================================
	;===>
	ClsColor 0, 0, 0
	SetBuffer BackBuffer()
	;===>
	HideEntity SHWS_ShadowCam	 : SHW_ObjSHW_Hide()
	ShowEntity SHWS_Camera : SHW_ObjOrig_Show()
	;===>
	AmbientLight	 AMBIENTLIGHTCOLOR_R, AMBIENTLIGHTCOLOR_G, AMBIENTLIGHTCOLOR_B
	;===>
	If (SHWS_ENABLE) Then SHWS_ENABLE_ONE = False Else SHWS_ENABLE_ONE = True
	;===>
	ShowEntity SHWS_ImgSHW_Obj
	; ===>
	Viewport 0,0,GraphicsWidth(),GraphicsHeight()
	Dither True
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShaderShadow( a_ImageLight, a_ImageCamera )
	
	; =========================================================
	; ===>
	Local BuffImageLight = TextureBuffer(a_ImageLight)
	Local BuffImageCamera = TextureBuffer(a_ImageCamera)
	; ===>
	Local l_IdX%, l_IdY%,l_Pc% ,l_Pl%
	
	Local l_ColAmb%	= (AMBIENTLIGHTCOLOR_R Shl 16)+(AMBIENTLIGHTCOLOR_G Shl 8)+ AMBIENTLIGHTCOLOR_B
	
	Local l_ColNorm%= (255 Shl 24)+(255 Shl 16)+(255 Shl 8)+ 255	
	; ===>
	Local YSize#	= (Float(SHWS_TexSize)*(Float(GraphicsHeight())/Float(GraphicsWidth())))
	Local YUp#		= (Float(SHWS_TexSize)-YSize)*.5
	Local YDw#		= SHWS_TexSize-YUp-1
	Local XDw#		= SHWS_TexSize-1
	; ===>
	LockBuffer BuffImageCamera
	LockBuffer BuffImageLight
	SetBuffer BuffImageLight
	; ===>
	For l_IdY = YUp To YDw
		For l_IdX = 0 To XDw
			; ===>
			l_Pc% = ReadPixelFast( l_IdX, l_IdY, BuffImageCamera)
			l_Pl% = ReadPixelFast( l_IdX, l_IdY ) + SHWS_Tollerance
			;===>
			If (l_Pl<=l_Pc) Then 
				WritePixelFast l_IdX, l_IdY, l_ColAmb;l_Alpha
			Else
				WritePixelFast l_IdX, l_IdY, l_ColNorm
			EndIf
			; ===>
		Next
	Next
	; ===>
	UnlockBuffer BuffImageCamera
	UnlockBuffer BuffImageLight
	SetBuffer BackBuffer()
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SmoothTexture_Fast( a_Image, a_Smooth=2)
	; ===>
	Local l_x0%, l_y0%, l_Idy0%
	Local l_x1%, l_y1%, l_Idy1%
	Local l_x1_a%, l_x1_b%
	Local l_Color#, l_NColor#
	Local gfxbuffer=TextureBuffer(a_Image)
	; ===>	
	Local l_SHWS_TexSize% = SHWS_TexSize-1;
	; ===>
	LockBuffer gfxbuffer
	SetBuffer gfxbuffer
	; ===>
	For l_y0=0 To l_SHWS_TexSize
		l_Idy0 = l_y0*SHWS_TexSize
		For l_x0=0 To l_SHWS_TexSize
			; ===>
			SHWS_Pix(l_Idy0+l_x0) = ReadPixelFast( l_x0+1, l_y0+1, gfxbuffer) And $FF
			; ===>
		Next
	Next
	; ===>
	For l_y0=0 To l_SHWS_TexSize
		; ===>
		For l_x0=0 To l_SHWS_TexSize
			; ===>
			l_Color = 0;
			l_NColor = 0;
			; ===>
			For l_y1=l_y0-a_Smooth To l_y0+a_Smooth
				If (l_y1>=0 And l_y1<=l_SHWS_TexSize) Then 
					l_Idy1 = l_y1*SHWS_TexSize
					; ===>
					l_x1_a = l_x0-a_Smooth : If (l_x1_a<0)							Then l_x1_a = 0
					l_x1_b = l_x0+a_Smooth : If (l_x1_b>l_SHWS_TexSize)	Then l_x1_b = l_SHWS_TexSize
					l_x1_a = l_x1_a + l_Idy1
					l_x1_b = l_x1_b + l_Idy1
					; ===>
					l_NColor = l_NColor+(l_x1_b-l_x1_a+1)
					For l_x1=l_x1_a To l_x1_b
						; ===>
						l_Color = l_Color+SHWS_Pix(l_x1)
						; ===>
					Next
				EndIf
			Next
			; ===>
			l_Color = l_Color / l_NColor
			WritePixelFast l_x0,l_y0,((l_Color Shl 16)+(l_Color Shl 8)+l_Color)
			; ===>
		Next
	Next
	; ===>
	UnlockBuffer gfxbuffer
	SetBuffer BackBuffer()
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShadowEnable()
	;===>
	SHWS_ENABLE = True
	;===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShadowDisable()
	;===>
	SHWS_ENABLE = False
	;===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjSHW_Hide()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		If (l_CurModel\Caster) Then HideEntity l_CurModel\ObjShw 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjSHW_Show()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		If (l_CurModel\Caster) Then ShowEntity l_CurModel\ObjShw 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjOrig_Hide()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		HideEntity l_CurModel\ObjOrig 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjOrig_Show()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		ShowEntity l_CurModel\ObjOrig 
	Next
	;===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;  Code base By Warner
;===>
;
Function EntityTextureTree(ent, tex, frame=0, Index=0)
	Local i=0
	If EntityClass$(ent) = "Mesh" Then EntityTexture ent, tex, frame, Index
	For i = 1 To CountChildren(ent)
		
		EntityTextureTree( GetChild(ent, i), tex, frame, Index)
	Next
End Function

;=====================================================
;--------------------------------------------------
;===>
;  Code base By Warner
;===>
;
Function EntityFxTree(ent, Fx)
	Local i=0
	If EntityClass$(ent) = "Mesh" Then EntityFX ent, Fx
	For i = 1 To CountChildren(ent)
		EntityFxTree( GetChild(ent, i), Fx)
	Next
End Function
;=====================================================
;--------------------------------------------------
;===>
;  Code base By Warner
;===>
;
Function EntityColorTree(ent, Red, Green, Blue)
	Local i=0
	If EntityClass$(ent) = "Mesh" Then EntityColor ent, Red, Green, Blue
	For i = 1 To CountChildren(ent)
		EntityColorTree( GetChild(ent, i), Red, Green, Blue)
	Next
End Function

Nate the Great

2009

Hi

could you explain how this works. its pretty amazing and I just can't comprehend the shadow engine part of the code.

DareDevil

2009

for include the shadow in the your code, you can copy the my code and repleace the section loop apply in your SHW_Update( ->LightObj<- ) and for all object loaded add SHW_AddObject( ->CurrentObject<- )
this is all

PS: The code have a bug ;)

Bye

excuse for my english

DareDevil

2009

Hi all

the bug is resolved this is a last update


Const SHWS_FactorZoom#    = Float(0.010)

; =====================================================
; ===>
;
; ===>
;
Function SHW_Update( s_light)
	; ===>
	If (Not SHWS_ENABLE) Then Return
	; ===>
	Local Id_SHWS_TexCam%		= TextureBuffer(SHWS_TexCam)
	Local Id_SHWS_TexLight%	= TextureBuffer(SHWS_TexLight)
	; ===>
	Dither False
	AmbientLight	255,255,255
	ClsColor 0,0,0
	; ===>
	HideEntity		SHWS_ImgSHW_Obj
	HideEntity 		SHWS_Camera					; The in game camera must be hidden,
	ShowEntity 		SHWS_ShadowCam			; and the shadow camera must become visable.
	CameraProjMode	SHWS_ShadowCam, 2 : 	CameraZoom			SHWS_ShadowCam, SHWS_FactorZoom
	;===>
	SHW_ObjOrig_Hide()
	SHW_ObjSHW_Show()
	;===>
	PositionEntity	SHWS_ShadowCam, EntityX(s_light,True),			EntityY(s_light,True),		EntityZ(s_light,True)
	RotateEntity		SHWS_ShadowCam, EntityPitch(s_light,True),	EntityYaw(s_light,True),	EntityRoll(s_light,True)
	;===>
	Local l_CurModel.SHWS_Shadow
	Local IdSurf%, CurSurf%, IdVert%, CntVert%	
	Local ObjRec%, ObjShw%
	Local l_Vx#, l_Vy#, l_Vz# 
	Local l_ColorZ#, l_TexU#, l_TexV#
	Local ValTest# = 1.0;
	Local l_TSize# = SHWS_TexSize/2;
	;===>
	For l_CurModel = Each SHWS_Shadow
		;========================================================================
		;===>
		If (l_CurModel\Caster And SHWS_ENABLE) Then
			;========================================================================
			; ===>
			ObjRec = l_CurModel\ObjOrig
			ObjShw = l_CurModel\ObjShw;
			; ===>
			PositionEntity	ObjShw, EntityX     (ObjRec, True), EntityY     (ObjRec, True), EntityZ     (ObjRec, True)
			RotateEntity 		ObjShw, EntityPitch (ObjRec, True), EntityYaw   (ObjRec, True), EntityRoll  (ObjRec, True)
			ScaleEntity			ObjShw, EntityScaleX(ObjRec, True), EntityScaleY(ObjRec, True), EntityScaleZ(ObjRec, True)
;			EntityTexture		ObjShw, SHWS_TexBase, 0, SHWS_LevelTexture
;			EntityFX 				ObjShw, 1+2+8
			EntityTextureTree	( ObjShw, SHWS_TexBase, 0, SHWS_LevelTexture)
			EntityFxTree 			(	ObjShw, 1+2+8)
			; ===>
			; =========================================================
			; Generate texture coordinate
			;	===>
			For IdSurf=1 To CountSurfaces(ObjShw) 
				; =========================================================
				CurSurf = GetSurface( ObjShw, IdSurf ) 
				CntVert = CountVertices(CurSurf)-1
				; =========================================================
				For IdVert=0 To CntVert
					; =========================================================
					TFormPoint( VertexX#( CurSurf, IdVert), VertexY#( CurSurf, IdVert), VertexZ#( CurSurf, IdVert), ObjShw, SHWS_ShadowCam)
					If (TFormedZ()>0) Then 
						VertexColor( CurSurf, IdVert, TFormedZ#()*SHWS_FactorZ, TFormedZ#()*SHWS_FactorZ, TFormedZ#()*SHWS_FactorZ)
					Else
						VertexColor( CurSurf, IdVert, 0, 0, 0 )
					EndIf
					; =========================================================
					TFormPoint( VertexX#( CurSurf, IdVert), VertexY#( CurSurf, IdVert), VertexZ#( CurSurf, IdVert), ObjShw, 0)
					CameraProject( SHWS_ShadowCam, TFormedX#(), TFormedY#(), TFormedZ#())
					VertexTexCoords( CurSurf, IdVert, ProjectedX#()*SHWS_ConstSize,  ProjectedY#()*SHWS_ConstSize, 0, 0 )
					; =========================================================
				Next 
				; ===>
			Next 
			; ===>
			; =========================================================
		EndIf	
		;===>
		;=========================================================
	Next
	; =========================================================
	; ===>
	Cls
	RenderWorld()
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexLight)
	;Return
	; =========================================================
	; ===>
	; Imposto nuovamente la telecaemra sulla prospettiva ;)
	CameraProjMode	SHWS_ShadowCam, 1 : 	CameraZoom	SHWS_ShadowCam, 1.0
	; ora metto la telecamera dal punto di vista di visione normale
	PositionEntity SHWS_ShadowCam, EntityX(SHWS_Camera,True)    , EntityY(SHWS_Camera,True)  , EntityZ(SHWS_Camera,True)
	RotateEntity	 SHWS_ShadowCam, EntityPitch(SHWS_Camera,True), EntityYaw(SHWS_Camera,True), EntityRoll(SHWS_Camera,True)
	; ===>
	;	renderizzo il finto zbuffer calcolato rispetto alla luce
	RenderWorld()
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexCam)
	;Return
	; =========================================================
	; ===> 
	; proietto la texture calcolata dal punto di vista della luce su i poligoni
	For l_CurModel = Each SHWS_Shadow
		;===>
		If (l_CurModel\Caster And SHWS_ENABLE) Then 
			EntityTextureTree (l_CurModel\ObjShw, SHWS_TexLight, 0, SHWS_LevelTexture)
			EntityFxTree 			(l_CurModel\ObjShw, 1+8)
		EndIf
		;===>
	Next
	; =========================================================
	; ===>
	RenderWorld()
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexLight)
	;Return
	; =========================================================
	; ===>
	SHW_ShaderShadow(SHWS_TexLight,SHWS_TexCam)
	;SmoothTexture_Fast(SHWS_TexLight,2)
	; ===>
	; =========================================================
	;===>
	ClsColor 0, 0, 0
	SetBuffer BackBuffer()
	;===>
	HideEntity SHWS_ShadowCam	 : SHW_ObjSHW_Hide()
	ShowEntity SHWS_Camera : SHW_ObjOrig_Show()
	;===>
	AmbientLight	 AMBIENTLIGHTCOLOR_R, AMBIENTLIGHTCOLOR_G, AMBIENTLIGHTCOLOR_B
	;===>
	If (SHWS_ENABLE) Then SHWS_ENABLE_ONE = False Else SHWS_ENABLE_ONE = True
	;===>
	ShowEntity SHWS_ImgSHW_Obj
	; ===>
	Viewport 0,0,GraphicsWidth(),GraphicsHeight()
	Dither True
	; ===>
End Function

DareDevil

2009

Hi all

This a last update

;===>O=========================o<=================================================================
;===>O=========================o<=================================================================
;===>	Name file: 
;===>
;===>	Programmatore:
;===>	  Caldarulo Vincenzo (Vision&Design Software)
;===>	Descrizione:
;===>
;===>O=========================o<=================================================================
;===>O=========================o<=================================================================
; 

Graphics3D 1024, 768, 32, 2
;------------------------------------------------------------------
;==============================================================
;
Global TextureTest = LoadTexture("alien.jpg",1+16+32);
Dim SHWS_Pix%(512*512)
;------------------------------------------------------------------
;==============================================================
Global Camera = CreateCamera() 
PositionEntity Camera,60,60,-60
RotateEntity Camera,30,45,0
SetBuffer BackBuffer()
;HWMultiTex True
SHW_Init(Camera)
; =================================================================================================
; ===>
Global IDCaster.SHWS_Shadow ,IDRecived.SHWS_Shadow
SetAmbientLight( 64, 64, 64)
SeedRnd MilliSecs()

LoadScene2()

Global LightObj = CreateSphere(8)
CreateLight(2,LightObj)
EntityColor LightObj,255,0,0
EntityFX LightObj,2

Global lightRot#=0
Global CenterWord = CreateCube() : EntityColor CenterWord,255,0,0 ;: HideEntity CenterWord
PositionEntity CenterWord, 0, 0, 0

; =================================================================================================
; ===>
HidePointer()
MoveMouse GraphicsWidth()/2,GraphicsHeight()/2
;===>


Local spd#=0.5

Local OldMillisecs = MilliSecs()

; =================================================================================================
; ===>
Repeat
	;WireFrame True
	AntiAlias True
	
	MoveEntity Camera,(KeyDown(205)-KeyDown(203))*spd,0,(MouseDown(1)-MouseDown(2))*spd
	TurnEntity Camera,-MouseYSpeed()*0.1,-MouseXSpeed()*0.1,0
	RotateEntity Camera,EntityPitch(Camera,True),EntityYaw(Camera,True),0
	
	MoveMouse GraphicsWidth()*.5,GraphicsHeight()*.5
	If KeyDown(46) Then  ;KEY "C"
		;===>
		
		PositionEntity	Camera, EntityX(LightObj), 		EntityY(LightObj), 	EntityZ(LightObj)
		RotateEntity		Camera, EntityPitch(LightObj), EntityYaw(LightObj), EntityRoll(LightObj)
		;===>
	EndIf
	
	; ===========================================================================
	; ===>
	Local distlight# = 50
	lightRot = lightRot + .1 
	PositionEntity LightObj, distlight*Cos(lightRot), 50+10*Sin(lightRot*10), distlight*Sin(lightRot)
	PositionEntity LightObj, distlight*Cos(lightRot), 100, 0
	PositionEntity LightObj, 0, 150, distlight*Sin(lightRot)
	
	PointEntity LightObj,CenterWord
	
	;If KeyDown(63) Then  Stop
	; ===========================================================================
	; ===>
	
	; ===>
	UpdateWorld() 
	SHW_Update(LightObj)
	RenderWorld()
	; ===>
	Local Ms=(MilliSecs()-OldMillisecs)
	OldMillisecs = MilliSecs()
	Text(10,10,"Ms: "+Ms+" FPS: " + 1000/Ms)
	
	
	Flip(False)
	; ===>
Until KeyHit(1)

End


Function LoadScene2()
	;===>
	Local Obj;
	;===>
	Local R = 10
	Local def=32
	Local x,z
	Local Segment=50
	Local scl=5
	;===>
;	Obj = LoadMesh("sponza.3ds")
;	PositionEntity Obj,0,-7,0
;	ScaleMesh Obj, scl*4, scl*3, scl*3
;	SHW_AddObject( Obj )
	;===>
	Obj = CreateCube()
	PositionEntity Obj,0,-5,0
	ScaleMesh Obj, scl*20, 1, scl*20
	SHW_AddObject( Obj )
	;===>
	;Obj = LoadMesh("media\Beethoven.b3d")
	Obj = CreateSphere(def)
	PositionEntity Obj,-R, R, -R
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj )
	;===>
	Obj = CreateCylinder(def,1)
	PositionEntity Obj,-R, R, R
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj )
		;===>
	Obj = CreateCube()
	PositionEntity Obj, R, R, R
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj )
	;===>
	Obj = LoadMesh("Theodric2.3ds")
	PositionEntity Obj, R, R,-R
	ScaleEntity    Obj, scl, scl, scl
	SHW_AddObject( Obj,True)
	;===>
	
End Function

; ================================================== 
; ----------------------------------------------- 
; 

Function DrawTexture(x,y,Texture)
	CopyRect 0,0,TextureWidth(Texture),TextureWidth(Texture),x,y,TextureBuffer(Texture),BackBuffer()
End Function

; ================================================== 
; ----------------------------------------------- 
;this function for internal use only
Function GetScaleValue#(EntityHandle, GetGlobal)
	Local X# = TFormedX()-EntityX(EntityHandle, GetGlobal)
	Local Y# = TFormedY()-EntityY(EntityHandle, GetGlobal)
	Local Z# = TFormedZ()-EntityZ(EntityHandle, GetGlobal)
	Return Sqr(X*X+Y*Y+Z*Z)
End Function 

; ================================================== 
; ----------------------------------------------- 

Function EntityScaleX#(EntityHandle, GetGlobal=True)  
	TFormPoint 1,0,0, EntityHandle, (Not GetGlobal)*GetParent(EntityHandle)  
	Return GetScaleValue#(EntityHandle, GetGlobal)
End Function 
; ================================================== 
; ----------------------------------------------- 

Function EntityScaleY#(EntityHandle, GetGlobal=True)  
	TFormPoint 0,1,0, EntityHandle, (Not GetGlobal)*GetParent(EntityHandle)  
	Return GetScaleValue#(EntityHandle, GetGlobal)
End Function 
; ================================================== 
; ----------------------------------------------- 

Function EntityScaleZ#(EntityHandle, GetGlobal=True)  
	TFormPoint 0,0,1, EntityHandle, (Not GetGlobal)*GetParent(EntityHandle)  
	Return GetScaleValue#(EntityHandle, GetGlobal)
End Function 

; ================================================== 
; ----------------------------------------------- 

Function EntityColor_(mesh,r,g,b)
	Local i,ww
	If mesh<>0
		If EntityClass$(mesh)="Mesh"
			EntityColor mesh,r,g,b
		EndIf
		For i=1 To CountChildren(mesh)
			ww=GetChild(mesh,i)
			EntityColor_(ww,r,g,b)
		Next
	EndIf
End Function
; ================================================== 
; ----------------------------------------------- 

Global AMBIENTLIGHTCOLOR_R# = 0
Global AMBIENTLIGHTCOLOR_G# = 0
Global AMBIENTLIGHTCOLOR_B# = 0

Function SetAmbientLight( a_R#=0.0, a_G#=0.0, a_B#=0.0 )
	; ===>
	AmbientLight a_R, a_G, a_B
	AMBIENTLIGHTCOLOR_R = a_R
	AMBIENTLIGHTCOLOR_G = a_G
	AMBIENTLIGHTCOLOR_B = a_B
	; ===>
End Function

;=================================================================================================================================
;----------------------------------------------------------------------------------------------------------------------------
;=====================================================
;===>

Type SHWS_Shadow 
	Field Caster
	Field ObjOrig
	Field ObjShw
End Type 
;=====================================================
;===>
Const SHWS_LevelTexture%	= 0
Const SHWS_TexSize# 			= Float(512)
Const SHWS_ConstSize#			= Float(1.0) / (SHWS_TexSize-1.0)
Const SHWS_Far# 					= Float(300)
Const SHWS_ConstColor# 		= Float(255.0)
Const SHWS_FactorZ# 			= Float(1.0) /( SHWS_Far / SHWS_ConstColor )
Const SHWS_FactorZoom#    = Float(0.010)
;=====================================================
;===>
Const SHWS_ARRAY% = Int(SHWS_TexSize*SHWS_TexSize)
;Dim SHWS_Pix%(SHWS_ARRAY)
;=====================================================
;===>
Global SHWS_Camera%
Global SHWS_ShadowCam%
Global SHWS_ENABLE%			= True
Global SHWS_ENABLE_ONE%	= True
Global SHWS_TexLight%
Global SHWS_TexCam%
Global SHWS_TexBase%
Global SHWS_Tollerance%;

Global txdraw%

; ===>
; Create a fullscreen sprite
Global SHWS_ImgSHW_Obj

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_Init.SHWS_Shadow(a_Camera)
	; ===>
	SHWS_ENABLE = True
	SHWS_Camera	= a_Camera
	; ===>
	Local ValueTolA% = 8
	; ===>
	If(GraphicsDepth() <= 16) Then 
		SHWS_Tollerance% = (ValueTolA Shl 16) + (ValueTolA Shl 8) + ValueTolA
	Else 
		Local ValueTolB% = ValueTolA/2
		SHWS_Tollerance% = (ValueTolB Shl 16) + (ValueTolB Shl 8) + ValueTolB
	EndIf
	; ===>
	SHWS_ShadowCam = CreateCamera() 
	CameraClsColor	SHWS_ShadowCam, 255, 255, 255
	CameraViewport	SHWS_ShadowCam, 0, 0, SHWS_TexSize, SHWS_TexSize 	;the viewport the shadows will be rendered through.
	CameraZoom			SHWS_ShadowCam, 1.0
	HideEntity 			SHWS_ShadowCam
	; =====================================================================
	; ===>
	SHWS_TexLight = CreateTexture(SHWS_TexSize,SHWS_TexSize,1+16+32);+256)
	SHWS_TexCam		= CreateTexture(SHWS_TexSize,SHWS_TexSize,1+16+32);+256)
	TextureBlend SHWS_TexLight,2
	TextureBlend SHWS_TexCam,2
	
	; =====================================================================
	; ===>
	; Creazione della texture nulla per il pre rendering
	SHWS_TexBase = CreateTexture(16,16,1+16+32);+256)
	TextureBlend SHWS_TexBase,2
	SetBuffer TextureBuffer(SHWS_TexBase) ; 
	ClsColor 255, 255, 255
	Cls 
	ClsColor 0, 0, 0
	SetBuffer BackBuffer()
	; =====================================================================
	; ===>
	SHWS_ImgSHW_Obj 	= CreateSprite(a_Camera)
	; ===>
	PositionEntity  SHWS_ImgSHW_Obj, -0.0018, 0.0, 1.002
	EntityTexture		SHWS_ImgSHW_Obj, SHWS_TexLight
	EntityFX 				SHWS_ImgSHW_Obj, 1
	EntityBlend 		SHWS_ImgSHW_Obj, 2
	EntityAlpha 		SHWS_ImgSHW_Obj, 0.5
	HideEntity 			SHWS_ImgSHW_Obj
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_AddObject.SHWS_Shadow( Obj, Caster=True, TexAlpha=0)
	; ===>
	Local l_CurModel.SHWS_Shadow = New SHWS_Shadow
	; ===>
	l_CurModel\Caster		= Caster	
	l_CurModel\ObjOrig	= Obj
	; ===>
	If (l_CurModel\Caster)
		; ===>
		l_CurModel\ObjShw = CopyMesh(l_CurModel\ObjOrig)
		EntityTexture		l_CurModel\ObjShw, SHWS_TexBase, 0, SHWS_LevelTexture
		EntityFX 				l_CurModel\ObjShw, 1+2+8
		HideEntity l_CurModel\ObjShw
		; ===>
	EndIf
	; ===>
	Return l_CurModel
	; ===>
End Function


; =====================================================
; ===>
;
; ===>
;
Function SHW_Update( s_light)
	; ===>
	If (Not SHWS_ENABLE) Then Return
	; ===>
	Local Id_SHWS_TexCam%		= TextureBuffer(SHWS_TexCam)
	Local Id_SHWS_TexLight%	= TextureBuffer(SHWS_TexLight)
	; ===>
	Dither False
	AmbientLight	255,255,255
	ClsColor 0,0,0
	; ===>
	HideEntity		SHWS_ImgSHW_Obj
	HideEntity 		SHWS_Camera					; The in game camera must be hidden,
	ShowEntity 		SHWS_ShadowCam			; and the shadow camera must become visable.
	CameraProjMode	SHWS_ShadowCam, 2 : 	CameraZoom			SHWS_ShadowCam, SHWS_FactorZoom
	;===>
	SHW_ObjOrig_Hide()
	SHW_ObjSHW_Show()
	;===>
	PositionEntity	SHWS_ShadowCam, EntityX(s_light,True),			EntityY(s_light,True),		EntityZ(s_light,True)
	RotateEntity		SHWS_ShadowCam, EntityPitch(s_light,True),	EntityYaw(s_light,True),	EntityRoll(s_light,True)
	;===>
	Local l_CurModel.SHWS_Shadow
	Local IdSurf%, CurSurf%, IdVert%, CntVert%	
	Local ObjRec%, ObjShw%
	Local l_Vx#, l_Vy#, l_Vz# 
	Local l_ColorZ#, l_TexU#, l_TexV#
	Local ValTest# = 1.0;
	Local l_TSize# = SHWS_TexSize/2;
	;===>
	For l_CurModel = Each SHWS_Shadow
		;========================================================================
		;===>
		If (l_CurModel\Caster And SHWS_ENABLE) Then
			;========================================================================
			; ===>
			ObjRec = l_CurModel\ObjOrig
			ObjShw = l_CurModel\ObjShw;
			; ===>
			PositionEntity	ObjShw, EntityX     (ObjRec, True), EntityY     (ObjRec, True), EntityZ     (ObjRec, True)
			RotateEntity 		ObjShw, EntityPitch (ObjRec, True), EntityYaw   (ObjRec, True), EntityRoll  (ObjRec, True)
			ScaleEntity			ObjShw, EntityScaleX(ObjRec, True), EntityScaleY(ObjRec, True), EntityScaleZ(ObjRec, True)
;			EntityTexture		ObjShw, SHWS_TexBase, 0, SHWS_LevelTexture
;			EntityFX 				ObjShw, 1+2+8
			EntityTextureTree	( ObjShw, SHWS_TexBase, 0, SHWS_LevelTexture)
			EntityFxTree 			(	ObjShw, 1+2+8)
			; ===>
			; =========================================================
			; Generate texture coordinate
			;	===>
			For IdSurf=1 To CountSurfaces(ObjShw) 
				; =========================================================
				CurSurf = GetSurface( ObjShw, IdSurf ) 
				CntVert = CountVertices(CurSurf)-1
				; =========================================================
				For IdVert=0 To CntVert
					; =========================================================
					TFormPoint( VertexX#( CurSurf, IdVert), VertexY#( CurSurf, IdVert), VertexZ#( CurSurf, IdVert), ObjShw, SHWS_ShadowCam)
					If (TFormedZ()>0) Then 
						VertexColor( CurSurf, IdVert, TFormedZ#()*SHWS_FactorZ, TFormedZ#()*SHWS_FactorZ, TFormedZ#()*SHWS_FactorZ)
					Else
						VertexColor( CurSurf, IdVert, 0, 0, 0 )
					EndIf
					; =========================================================
					TFormPoint( VertexX#( CurSurf, IdVert), VertexY#( CurSurf, IdVert), VertexZ#( CurSurf, IdVert), ObjShw, 0)
					CameraProject( SHWS_ShadowCam, TFormedX#(), TFormedY#(), TFormedZ#())
					VertexTexCoords( CurSurf, IdVert, ProjectedX#()*SHWS_ConstSize,  ProjectedY#()*SHWS_ConstSize, 0, 0 )
					; =========================================================
				Next 
				; ===>
			Next 
			; ===>
			; =========================================================
		EndIf	
		;===>
		;=========================================================
	Next
	; =========================================================
	; ===>
	Cls
	RenderWorld()
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexLight)
	;Return
	; =========================================================
	; ===>
	; Imposto nuovamente la telecaemra sulla prospettiva ;)
	CameraProjMode	SHWS_ShadowCam, 1 : 	CameraZoom	SHWS_ShadowCam, 1.0
	; ora metto la telecamera dal punto di vista di visione normale
	PositionEntity SHWS_ShadowCam, EntityX(SHWS_Camera,True)    , EntityY(SHWS_Camera,True)  , EntityZ(SHWS_Camera,True)
	RotateEntity	 SHWS_ShadowCam, EntityPitch(SHWS_Camera,True), EntityYaw(SHWS_Camera,True), EntityRoll(SHWS_Camera,True)
	; ===>
	;	renderizzo il finto zbuffer calcolato rispetto alla luce
	RenderWorld()
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexCam)
	;Return
	; =========================================================
	; ===> 
	; proietto la texture calcolata dal punto di vista della luce su i poligoni
	For l_CurModel = Each SHWS_Shadow
		;===>
		If (l_CurModel\Caster And SHWS_ENABLE) Then 
			EntityTextureTree (l_CurModel\ObjShw, SHWS_TexLight, 0, SHWS_LevelTexture)
			EntityFxTree 			(l_CurModel\ObjShw, 1+8)
		EndIf
		;===>
	Next
	; =========================================================
	; ===>
	RenderWorld()
	CopyRect 0,0, SHWS_TexSize, SHWS_TexSize, 0, 0, BackBuffer(), TextureBuffer(SHWS_TexLight)
	;Return
	; =========================================================
	; ===>
	SHW_ShaderShadow(SHWS_TexLight,SHWS_TexCam)
	BlurTexture( SHWS_TexLight, 8, 4)
	;SmoothTexture_Fast(SHWS_TexLight,2)
	; ===>
	; =========================================================
	;===>
	ClsColor 0, 0, 0
	SetBuffer BackBuffer()
	;===>
	HideEntity SHWS_ShadowCam	 : SHW_ObjSHW_Hide()
	ShowEntity SHWS_Camera : SHW_ObjOrig_Show()
	;===>
	AmbientLight	 AMBIENTLIGHTCOLOR_R, AMBIENTLIGHTCOLOR_G, AMBIENTLIGHTCOLOR_B
	;===>
	If (SHWS_ENABLE) Then SHWS_ENABLE_ONE = False Else SHWS_ENABLE_ONE = True
	;===>
	ShowEntity SHWS_ImgSHW_Obj
	; ===>
	Viewport 0,0,GraphicsWidth(),GraphicsHeight()
	Dither True
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShaderShadow( a_ImageLight, a_ImageCamera )
	
	; =========================================================
	; ===>
	Local BuffImageLight = TextureBuffer(a_ImageLight)
	Local BuffImageCamera = TextureBuffer(a_ImageCamera)
	; ===>
	Local l_IdX%, l_IdY%,l_Pc% ,l_Pl%
	
	Local l_ColAmb%	= (AMBIENTLIGHTCOLOR_R Shl 16)+(AMBIENTLIGHTCOLOR_G Shl 8)+ AMBIENTLIGHTCOLOR_B
	
	Local l_ColNorm%= (255 Shl 24)+(255 Shl 16)+(255 Shl 8)+ 255	
	; ===>
	Local YSize#	= (Float(SHWS_TexSize)*(Float(GraphicsHeight())/Float(GraphicsWidth())))
	Local YUp#		= (Float(SHWS_TexSize)-YSize)*.5
	Local YDw#		= SHWS_TexSize-YUp-1
	Local XDw#		= SHWS_TexSize-1
	; ===>
	LockBuffer BuffImageCamera
	LockBuffer BuffImageLight
	SetBuffer BuffImageLight
	; ===>
	For l_IdY = YUp To YDw
		For l_IdX = 0 To XDw
			; ===>
			l_Pc% = ReadPixelFast( l_IdX, l_IdY, BuffImageCamera)
			l_Pl% = ReadPixelFast( l_IdX, l_IdY ) + SHWS_Tollerance
			;===>
			If (l_Pl<=l_Pc) Then 
				WritePixelFast l_IdX, l_IdY, l_ColAmb;l_Alpha
			Else
				WritePixelFast l_IdX, l_IdY, l_ColNorm
			EndIf
			; ===>
		Next
	Next
	; ===>
	UnlockBuffer BuffImageCamera
	UnlockBuffer BuffImageLight
	SetBuffer BackBuffer()
	; ===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SmoothTexture_Fast( a_Image, a_Smooth=2)
	; ===>
	Local l_x0%, l_y0%, l_Idy0%
	Local l_x1%, l_y1%, l_Idy1%
	Local l_x1_a%, l_x1_b%
	Local l_Color#, l_NColor#
	Local gfxbuffer=TextureBuffer(a_Image)
	; ===>	
	Local l_SHWS_TexSize% = SHWS_TexSize-1;
	; ===>
	LockBuffer gfxbuffer
	SetBuffer gfxbuffer
	; ===>
	For l_y0=0 To l_SHWS_TexSize
		l_Idy0 = l_y0*SHWS_TexSize
		For l_x0=0 To l_SHWS_TexSize
			; ===>
			SHWS_Pix(l_Idy0+l_x0) = ReadPixelFast( l_x0+1, l_y0+1, gfxbuffer) And $FF
			; ===>
		Next
	Next
	; ===>
	For l_y0=0 To l_SHWS_TexSize
		; ===>
		For l_x0=0 To l_SHWS_TexSize
			; ===>
			l_Color = 0;
			l_NColor = 0;
			; ===>
			For l_y1=l_y0-a_Smooth To l_y0+a_Smooth
				If (l_y1>=0 And l_y1<=l_SHWS_TexSize) Then 
					l_Idy1 = l_y1*SHWS_TexSize
					; ===>
					l_x1_a = l_x0-a_Smooth : If (l_x1_a<0)							Then l_x1_a = 0
					l_x1_b = l_x0+a_Smooth : If (l_x1_b>l_SHWS_TexSize)	Then l_x1_b = l_SHWS_TexSize
					l_x1_a = l_x1_a + l_Idy1
					l_x1_b = l_x1_b + l_Idy1
					; ===>
					l_NColor = l_NColor+(l_x1_b-l_x1_a+1)
					For l_x1=l_x1_a To l_x1_b
						; ===>
						l_Color = l_Color+SHWS_Pix(l_x1)
						; ===>
					Next
				EndIf
			Next
			; ===>
			l_Color = l_Color / l_NColor
			WritePixelFast l_x0,l_y0,((l_Color Shl 16)+(l_Color Shl 8)+l_Color)
			; ===>
		Next
	Next
	; ===>
	UnlockBuffer gfxbuffer
	SetBuffer BackBuffer()
	; ===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function BlurTexture(tex, quality, radius#)
	Local blur_mesh[64]
	If quality > 0 Then
		Local Blur_Cam = CreateCamera()
		CameraViewport Blur_Cam, 0, 0, TextureWidth(tex), TextureHeight(tex)
		CameraRange Blur_Cam, .1, 100
		CameraZoom Blur_Cam, 8
		RotateEntity Blur_Cam, 90, 0, 0
		PositionEntity Blur_Cam, 65536, 65536, 0
		TextureBlend tex, 2
		Local BlurRadius# = radius# / 256.0
		Local BlurAngleStep# = 360.0 / Float(quality * 4)
		For i = 0 To quality * 4 - 1
      blur_mesh[i] = CreateSprite()
      EntityTexture blur_mesh[i], tex
      EntityFX blur_mesh[i], 9
      EntityAlpha blur_mesh[i], 1.0 / Float(i + 1)
      ScaleSprite blur_mesh[i], 2, 2
      Local BlurAngle# = BlurAngleStep# * i + 180 * (i Mod 2)
      PositionEntity blur_mesh[i], 65536 + BlurRadius# * Cos(BlurAngle#), 65536 - 16, BlurRadius# * Sin(BlurAngle#)
		Next
		RenderWorld
		CopyRect 0, 0, TextureWidth(tex), TextureHeight(tex), 0, 0, BackBuffer(), TextureBuffer(tex)
		For i = 0 To quality * 4 - 1
      FreeEntity blur_mesh[i]
		Next
		FreeEntity Blur_Cam
	EndIf
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShadowEnable()
	;===>
	SHWS_ENABLE = True
	;===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ShadowDisable()
	;===>
	SHWS_ENABLE = False
	;===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjSHW_Hide()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		If (l_CurModel\Caster) Then HideEntity l_CurModel\ObjShw 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjSHW_Show()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		If (l_CurModel\Caster) Then ShowEntity l_CurModel\ObjShw 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjOrig_Hide()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		HideEntity l_CurModel\ObjOrig 
	Next
	;===>
End Function
;=====================================================
;--------------------------------------------------
;===>
;
;===>
;
Function SHW_ObjOrig_Show()
	;===>
	Local l_CurModel.SHWS_Shadow
	;===>
	For l_CurModel = Each SHWS_Shadow 
		ShowEntity l_CurModel\ObjOrig 
	Next
	;===>
End Function

;=====================================================
;--------------------------------------------------
;===>
;  Code base By Warner
;===>
;
Function EntityTextureTree(ent, tex, frame=0, Index=0)
	Local i=0
	If EntityClass$(ent) = "Mesh" Then EntityTexture ent, tex, frame, Index
	For i = 1 To CountChildren(ent)
		
		EntityTextureTree( GetChild(ent, i), tex, frame, Index)
	Next
End Function

;=====================================================
;--------------------------------------------------
;===>
;  Code base By Warner
;===>
;
Function EntityFxTree(ent, Fx)
	Local i=0
	If EntityClass$(ent) = "Mesh" Then EntityFX ent, Fx
	For i = 1 To CountChildren(ent)
		EntityFxTree( GetChild(ent, i), Fx)
	Next
End Function
;=====================================================
;--------------------------------------------------
;===>
;  Code base By Warner
;===>
;
Function EntityColorTree(ent, Red, Green, Blue)
	Local i=0
	If EntityClass$(ent) = "Mesh" Then EntityColor ent, Red, Green, Blue
	For i = 1 To CountChildren(ent)
		EntityColorTree( GetChild(ent, i), Red, Green, Blue)
	Next
End Function

Nate the Great

2009

I didnt mean how do you include it in your projects, I meant how does it make the shadows? Does it do stencils or a raytrace algorithm? or what?

Yasha

2009

It's fundamentally the same principle as behind SSwift's and MixailV's shadow solutions. Render a scene from the perspective of the light with objects painted black, copyrect to a texture, paste this texture over receiver meshes having used TFormPoint to get the correct UV coords. It's actually possible (as SSwift and MixailV have shown) to make lightning fast systems this way, but you need to optimise it pretty hard (or in the case of MixailV, use FastExt) and sacrifice some of the effects DareDevil is adding here.

Nate the Great

2009

oh. I see thanks for the explanation.

is this how devil shadow system works dare devil?

DareDevil

2009

thanks !
the sistem works!
is not completed! work continues!
but this version tested to verify the bug

Bye :D

Code Archives Forum