Graphics3D 640,480,16,2
SetBuffer BackBuffer()

Type shadowCaster
   Field ent
   Field shadowMesh
End Type

Type shadowEdge
   Field x0#,y0#,z0#
   Field x1#,y1#,z1#   
   Field inside
End Type

Dim sVertex#(3,3)

Function AddShadowCaster.shadowCaster(ent)
   sh.shadowCaster=New shadowCaster
   sh\ent=ent
   Return sh
End Function

Function MakeShadow(lightX#,lightY#,lightZ#, clearShadow=True)

   For sCaster.shadowCaster=Each shadowCaster

      If clearShadow=True
         FreeEntity sCaster\shadowMesh
         sCaster\shadowMesh=CreateMesh()
         sSurf=CreateSurface(sCaster\shadowMesh)
         EntityFX sCaster\shadowMesh,4
         EntityAlpha sCaster\shadowMesh,0.35
         EntityColor sCaster\shadowMesh,255,0,0
      Else
         sSurf=GetSurface(sCaster\shadowMesh,1)   
      EndIf   

      Delete Each shadowEdge

      For cs=1 To CountSurfaces(sCaster\ent)
         s=GetSurface(sCaster\ent,cs)
      For t=0 To CountTriangles(s)-1

         ;berechnen der vertices und normalen
         nx#=0:ny#=0:nz#=0
         vx#=0:vy#=0:vz#=0
         For vn=0 To 2
            v=TriangleVertex(s,t,vn)         
            TFormPoint( VertexX(s,v),VertexY(s,v),VertexZ(s,v) , sCaster\ent,0)
            sVertex(vn,0)=TFormedX()
            sVertex(vn,1)=TFormedY()
            sVertex(vn,2)=TFormedZ()
            vx#=vx#+TFormedX()
            vy#=vy#+TFormedY()
            vz#=vz#+TFormedZ()

            TFormNormal( VertexNX(s,v),VertexNY(s,v),VertexNZ(s,v) , sCaster\ent,0)
            nx=nx+TFormedX()
            ny=ny+TFormedY()
            nz=nz+TFormedZ()
         Next
         vx=vx*0.3333 : vy=vy*0.3333 : vz=vz*0.3333
         nx=nx*0.3333 : ny=ny*0.3333 : nz=nz*0.3333         

         If ((vx-lightX)*nx + (vy-lightY)*ny + (vz-lightZ)*nz) < 0
            ;wenn dreieck zum licht zeigt dreieckskanten speichern
            newShadowEdge(sVertex(0,0),sVertex(0,1),sVertex(0,2) , sVertex(1,0),sVertex(1,1),sVertex(1,2))
            newShadowEdge(sVertex(1,0),sVertex(1,1),sVertex(1,2) , sVertex(2,0),sVertex(2,1),sVertex(2,2))
            newShadowEdge(sVertex(2,0),sVertex(2,1),sVertex(2,2) , sVertex(0,0),sVertex(0,1),sVertex(0,2))                        
         EndIf
      Next
      Next
      
      ;shadowvolume aus umrisskanten generieren
      For edge.shadowEdge=Each shadowEdge
         If Not edge\inside
            x0#=edge\x0+(edge\x0-lightX)*1000
            y0#=edge\y0+(edge\y0-lightY)*1000
            z0#=edge\z0+(edge\z0-lightZ)*1000            
            x1#=edge\x1+(edge\x1-lightX)*1000
            y1#=edge\y1+(edge\y1-lightY)*1000
            z1#=edge\z1+(edge\z1-lightZ)*1000
            
            v0=AddVertex (sSurf,edge\x0,edge\y0,edge\z0)
            v1=AddVertex (sSurf,x0,y0,z0)
            v2=AddVertex (sSurf,x1,y1,z1)
            AddTriangle sSurf, v0,v1,v2
            
            v0=AddVertex (sSurf,x1,y1,z1)
            v1=AddVertex (sSurf,edge\x1,edge\y1,edge\z1)
            v2=AddVertex (sSurf,edge\x0,edge\y0,edge\z0)
            AddTriangle sSurf,v0,v1,v2
         EndIf   
      Next
   Next
   
End Function

Function newShadowEdge(x0#,y0#,z0#, x1#,y1#,z1#)
   ;wenn sich mehrere dreiecke dieselbe kante teilen ist sie keine 'umrisskante'
   For e.ShadowEdge=Each shadowEdge
      If (e\x0=x0 And e\y0=y0 And e\z0=z0) And (e\x1=x1 And e\y1=y1 And e\z1=z1) e\inside=True: Return
      If (e\x0=x1 And e\y0=y1 And e\z0=z1) And (e\x1=x0 And e\y1=y0 And e\z1=z0) e\inside=True: Return
   Next

   e.ShadowEdge=New shadowEdge
   e\x0=x0 : e\y0=y0 :   e\z0=z0
   e\x1=x1 : e\y1=y1 : e\z1=z1
End Function


For t=1 To 20
   c=CreateCube()
   EntityColor c,128,128,128
   scale#=Rnd(1,5)
   ScaleEntity c,1,scale,1
   PositionEntity c,Rnd(-15,15),scale-5,Rnd(5,25)
   TurnEntity c,0,Rnd(360),0

   addShadowCaster(c)
Next

light=CreateLight(2)
LightRange light,20
PositionEntity light,10,8,10
lightPivot=CreateSphere(8,light)

Global camera=CreateCamera()
PositionEntity camera,0,0,-10

Global plane=CreatePlane()
PositionEntity plane,0,-5,0

While Not KeyHit(1)

   w#=(w#+0.5) Mod 360
   PositionEntity light, Sin(w)*10,8,10+Cos(w)*10

   MakeShadow(EntityX(light),EntityY(light),EntityZ(light))

   RenderWorld()
   Flip   
Wend