Const SCRW = 800
Const SCRH = 600

Graphics3D SCRW, SCRH, 32, 2

SeedRnd MilliSecs()

Local camera, shadow.TShadow, shadow2.TShadow, ms
camera = CreateCamera() ; creates camera to render shadows
CameraClsColor camera, 255, 255, 255

shadow = CreateShadow() ; initializes shadow
shadow\light\radius = 300 ; set light radius
;shadow\light\blu = 0 ; set light color to yellow

shadow2 = CreateShadow() ; initializes shadow
shadow2\light\radius = 300 ; set light radius
;shadow2\light\red = 0 ; set light color to blue
;shadow2\light\grn = 0

Local shadow1_tex, shadow2_tex, mesh, surface, v0, v1, v2, v3

shadow1_tex = CreateTexture(1024, 1024)
shadow2_tex = CreateTexture(1024, 1024)
TextureBlend shadow2_tex, 3

mesh = CreateMesh()
surface = CreateSurface(mesh)
PositionEntity mesh, - SCRW / 2 - 0.5, SCRH / 2 + 0.5, SCRW / 2
ScaleEntity mesh, 1, -1, 1
v0 = AddVertex(surface, 0, 0, 0)
v1 = AddVertex(surface, 0, 1024, 0)
v2 = AddVertex(surface, 1024, 1024, 0)
v3 = AddVertex(surface, 1024, 0, 0)
VertexTexCoords(surface, v0, 0, 0)
VertexTexCoords(surface, v1, 0, 1)
VertexTexCoords(surface, v2, 1, 1)
VertexTexCoords(surface, v3, 1, 0)
AddTriangle(surface, v0, v3, v2)
AddTriangle(surface, v0, v2, v1)

EntityFX mesh, 1 + 2
EntityBlend mesh, 2

EntityTexture mesh, shadow1_tex, 0, 0
EntityTexture mesh, shadow2_tex, 0, 1


;CreateRandomObjects() ; create some objects to cast shadows
CreateOrderedObjects(6, 20, 6, 6)

SetBuffer BackBuffer()

Local render2D = True

Repeat
   ms = MilliSecs()
   
   If MouseHit(2)
      render2D = 1 - render2D
   EndIf
   
   shadow\light\x = MouseX() ;set light position
   shadow\light\y = MouseY()
   DrawShadows(shadow) ; draw light and shadows
   RenderToTexture(shadow1_tex)
   ClearSurface shadow\surface
   
   shadow2\light\x = SCRW - MouseX();/ 2 + Cos(MilliSecs() / 20) * 100 ;set light position
   shadow2\light\y = SCRH - MouseY(); SCRH / 2 + Sin(MilliSecs() / 20) * 100
   DrawShadows(shadow2)
   RenderToTexture(shadow2_tex)
   ClearSurface shadow2\surface
   
   RenderWorld ; render
   
   If render2D
      DrawWalls() ; draw walls(slow!)
      Oval shadow\light\x - 5, shadow\light\y - 5, 10, 10, 0
      Oval shadow2\light\x - 5, shadow2\light\y - 5, 10, 10, 0
   EndIf
   
   Text 0, 0, MilliSecs() - ms
   Flip 0
   Delay 17 - MilliSecs() + ms
Until KeyHit(1)

End


Function CreateOrderedObjects(e = 4, r = 25, rows = 5, cols = 5)
   ; creates row * cols ordered objects
   Local j, x#, y#, wall.TWall, row, col
   For col = 1 To cols
      For row = 1 To rows
         x = (row-0.5) * SCRW / rows
         y = (col-0.5) * SCRH / cols
         For j = 1 To e
            CreateWall(x + Cos(j * 360 / e) * r, y + Sin(j * 360 / e) * r, x + Cos((j + 1) * 360 / e) * r, y + Sin((j + 1) * 360 / e) * r)
         Next
      Next
   Next
End Function

Function CreateRandomObjects(n = 50)
   ; creates n random light blocking objects
   Local i, j, x#, y#, a#, e, r#, wall.TWall
   For i = 1 To n
      x = Rnd(SCRW)
      y = Rnd(SCRH)
      a = Rnd(360)
      e = Rand(1, 4)
      e = (e = 1) * 3 + (e = 2) * 4 + (e = 3) * 6 + (e = 4) * 36
      r = Rnd(20, 50)
      For j = 1 To e
         CreateWall(x + Cos(a + j * 360 / e) * r, y + Sin(a + j * 360 / e) * r, x + Cos(a + (j + 1) * 360 / e) * r, y + Sin(a + (j + 1) * 360 / e) * r)
      Next
   Next
End Function

Function DrawWalls()
   ; draws walls
   ;! This function is very slow! Do not use for purposes other than testing or debugging!
   Local wall.TWall
   For wall = Each TWall
      Line wall\x1, wall\y1, wall\x2, wall\y2
   Next
End Function

Function RenderToTexture(texture)
   ; renders and than copies the backbuffer into the texturebuffer
   RenderWorld
   CopyRect 0, 0, SCRW, SCRH, 0, 0, BackBuffer(), TextureBuffer(texture)
End Function

;! ------------------------------------------------------------------------------- !;
;! ------------------------------- LIB STARTS HERE ------------------------------- !;
;! ------------------------------------------------------------------------------- !;


Type TWall
   ; a line that blocks light
   Field x1#
   Field y1#
   Field x2#
   Field y2#
End Type

Type TShadow
   ; a shadow object, needed to cast shadows
   Field mesh
   Field surface
   Field light.TLight
   Field red
   Field grn
   Field blu
End Type

Type TLight
   ; a light, needed to cast shadows
   Field x#
   Field y#
   Field radius#
   Field red
   Field grn
   Field blu
End Type

Function CreateWall.TWall(x1#, y1#, x2#, y2#)
   ; creates a TWall from (x1|y1) to (x2|y2)
   ; returns that TWall
   Local wall.TWall
   wall = New TWall
   wall\x1 = x1
   wall\y1 = y1
   wall\x2 = x2
   wall\y2 = y2
   Return wall
End Function

Function CreateShadow.TShadow(parent = 0, backfaceCulling = True, alignToCamera = True)
   ; creates a TShadow and TLight
   ; returns that TShadow
   ; parent: any entity or 0
   ; backfaceCulling: makes walls opaque from both sides
   ; alignToCamera: aligns shadows to the 2D coordinate system
   Local shadow.TShadow
   shadow = New TShadow
   shadow\mesh = CreateMesh(parent)
   shadow\surface = CreateSurface(shadow\mesh)
   EntityFX shadow\mesh, 1 + 2 + 16 * backfaceCulling
   ;EntityBlend shadow\mesh, 2
   shadow\light = New TLight
   shadow\light\radius = 100
   shadow\light\red = 255
   shadow\light\grn = 255
   shadow\light\blu = 255
   If alignToCamera
      AlignShadowMeshToCamera(shadow)
   EndIf
   Return shadow
End Function

Function AlignShadowMeshToCamera(shadow.TShadow, distance# = 100)
   ; aligns shadows to the 2D coordinate system
   ; shadow: TShadow to align
   ; distance: mesh and therefor triangle distance to the camera
   PositionEntity shadow\mesh, - distance / 2, distance / SCRW * SCRH / 2, distance / 2
   ScaleEntity shadow\mesh, distance / SCRW, - distance / SCRW, 1
End Function

Function DrawShadows(shadow.TShadow, drawLight = True, clear = True, LightDetail = 36)
   ; draws shadows
   ; shadow: TShadow to draw
   ; drawLight: draws light
   ; clear: clears previous shadows (highly recommended!)
   ; lightDetail: triangles used for light mesh
   Local x#, x2#, y#, y2#, wall.TWall
   Local v0, v1, v2, v3
   If clear
      ClearSurface(shadow\surface)
   EndIf
   If drawLight
      DrawShadowLight(shadow, LightDetail)
   EndIf
   For wall = Each TWall
      x = (wall\x1 - shadow\light\x) * 10000 + shadow\light\x
      y = (wall\y1 - shadow\light\y) * 10000 + shadow\light\y
      x2 = (wall\x2 - shadow\light\x) * 10000 + shadow\light\x
      y2 = (wall\y2 - shadow\light\y) * 10000 + shadow\light\y
      v0 = AddVertex(shadow\surface, wall\x1, wall\y1, 0)
      v1 = AddVertex(shadow\surface, wall\x2, wall\y2, 0)
      v2 = AddVertex(shadow\surface, x, y, 0)
      v3 = AddVertex(shadow\surface, x2, y2, 0)
      VertexColor(shadow\surface, v0, shadow\red, shadow\grn, shadow\blu)
      VertexColor(shadow\surface, v1, shadow\red, shadow\grn, shadow\blu)
      VertexColor(shadow\surface, v2, shadow\red, shadow\grn, shadow\blu)
      VertexColor(shadow\surface, v3, shadow\red, shadow\grn, shadow\blu)
      AddTriangle(shadow\surface, v0, v2, v3)
      AddTriangle(shadow\surface, v0, v3, v1)
   Next
End Function

Function DrawShadowLight(shadow.TShadow, detail)
   ; draws light
   ; shadow: shadow which light is to be drawn
   ; detail: triangles used for light mesh
   Local i, v0, v1, v2, v3, v4, v5, v6
   v0 = AddVertex(shadow\surface, shadow\light\x, shadow\light\y, 0)
   VertexColor(shadow\surface, v0, shadow\light\red, shadow\light\grn, shadow\light\blu)
   v1 = AddVertex(shadow\surface, shadow\light\x + shadow\light\radius, shadow\light\y, 0)
   VertexColor(shadow\surface, v1, shadow\red, shadow\grn, shadow\blu)
   v4 = AddVertex(shadow\surface, shadow\light\x + 1000000, shadow\light\y, 0)
   VertexColor(shadow\surface, v4, shadow\red, shadow\grn, shadow\blu)
   v2 = v1
   v5 = v4
   For i = 1 To detail - 1
      v3 = AddVertex(shadow\surface, shadow\light\x + Cos(i * 360 / detail) * shadow\light\radius, shadow\light\y + Sin(i * 10) * shadow\light\radius, 0)
      v6 = AddVertex(shadow\surface, shadow\light\x + Cos(i * 360 / detail) * 1000000, shadow\light\y + Sin(i * 10) * 1000000, 0)
      VertexColor(shadow\surface, v3, shadow\red, shadow\grn, shadow\blu)
      VertexColor(shadow\surface, v5, shadow\red, shadow\grn, shadow\blu)
      AddTriangle(shadow\surface, v0, v2, v3)
      AddTriangle(shadow\surface, v2, v5, v6)
      AddTriangle(shadow\surface, v2, v6, v3)
      v2 = v3
      v5 = v6
   Next
   AddTriangle(shadow\surface, v0, v2, v1)
   
   AddTriangle(shadow\surface, v2, v4, v1)
   AddTriangle(shadow\surface, v2, v6, v4)
End Function

Graphics 1024,768,32,2
SetBuffer BackBuffer()
Const starke = 200
Const starkem2 = starke*2

Global linecount=-1,lineoff=1
Dim fline(10000,4)
For x=0 To 10
   CreateRandomObjects(5)
Next

Dim cutmap(0,0)
Dim workloop((starkem2*starkem2)*2,1)

Dim lightmap(starkem2,starkem2)
For x=0 To starkem2
   For y=0 To starkem2
      If Sqr( (Float(starke) - Float(x)) ^ 2 + (Float(starke)  - Float(starke)) ^ 2) < starke Then
         rgb= Int(255-((Sqr( (Float(starke) - Float(x)) ^ 2 + (Float(starke)  - Float(y)) ^ 2) / starke) * 255))*$10000 + Int(255-((Sqr( (Float(starke) - Float(x)) ^ 2 + (Float(starke)  - Float(y)) ^ 2) / starke) * 255))*$100 + Int(255-((Sqr( (Float(starke) - Float(x)) ^ 2 + (Float(starke)  - Float(y)) ^ 2) / starke) * 255))
         lightmap(x,y)=rgb
      EndIf
   Next
Next

Repeat
   Cls
   start = MilliSecs()
   mx=MouseX()+starke
   my=MouseY()+starke
   If MouseHit(1) Then lineoff=1-lineoff
   
   Dim cutmap(starkem2,starkem2)
   LockBuffer BackBuffer()
   For xl = 0 To linecount
      If Sqr( (MouseX() - fline(xl,0)) ^ 2 + (MouseY() - fline(xl,1)) ^ 2) < starke*1.3 Then collect_info_likehell(starke,starke,mx-fline(xl,0),my-fline(xl,1),mx-fline(xl,2),my-fline(xl,3),starkem2,starkem2,starkem2)
      If lineoff Then Line(fline(xl,0),fline(xl,1),fline(xl,2),fline(xl,3))
   Next
   
   workloop(0,0)=mx-starke
   workloop(0,1)=my-starke
   pointX=workloop(0,0)
   pointY=workloop(0,1)
   maxID=0
   h=0
   go = False
   Repeat
      TX=(pointX-workloop(h,0))+starke
      TY=(pointY-workloop(h,1))+starke
      If TX > 1 And TX < starkem2-1 And TY > 1 And TY < starkem2-1 Then
         If cutmap(TX,TY) = 0  Then
            If workloop(h,0) > 0 And workloop(h,1)  > 0 And  workloop(h,0) < 1023 And workloop(h,1)  < 767 Then WritePixelFast workloop(h,0),workloop(h,1),lightmap(TX,TY)
            cutmap(TX,TY) = 1
            
            If cutmap(TX+1,TY) = 0 And lightmap(TX+1,TY) > 0 Then
               maxID=maxID+1
               workloop(maxID,0)=workloop(h,0)-1
               workloop(maxID,1)=workloop(h,1)
            EndIf
            
            If cutmap(TX-1,TY) = 0 And lightmap(TX-1,TY) > 0 Then
               maxID=maxID+1
               workloop(maxID,0)=workloop(h,0)+1
               workloop(maxID,1)=workloop(h,1)
            EndIf
            
            If cutmap(TX,TY+1) = 0 And lightmap(TX,TY+1) > 0 Then
               maxID=maxID+1
               workloop(maxID,0)=workloop(h,0)
               workloop(maxID,1)=workloop(h,1)-1
            EndIf
            
            If cutmap(TX,TY-1) = 0 And lightmap(TX,TY-1) > 0 Then
               maxID=maxID+1
               workloop(maxID,0)=workloop(h,0)
               workloop(maxID,1)=workloop(h,1)+1
            EndIf
            
         EndIf
      EndIf
      
      If maxID=h Then go = True
      h=h+1
   Until go
   
   UnlockBuffer BackBuffer()
   ende=MilliSecs() - start
   Text 1,1,ende
   Flip 0
   
Until KeyDown(1)
End


Function collect_info_likehell(lx#,ly#,v1x#,v1y#,v2x#,v2y#,range,max,may)
   
   Local winkelV1# = - (ATan2(lx# - v1x#, ly#  - v1y#) +90) Mod 360
   Local winkelV2# = - (ATan2(lx# - v2x#, ly#  - v2y#)+90) Mod 360
   Local winkelV1toV2# = - (ATan2(v1x# - v2x#, v1y#  - v2y#)+90) Mod 360
   
   Local entfernungV1#=Sqr( (lx# - v1x#) ^ 2 + (ly#  - v1y#) ^ 2)
   Local entfernungV2#=Sqr( (lx# - v2x#) ^ 2 + (ly#  - v2y#) ^ 2)
   Local entfernungV1toV2#=Sqr( (v1x# - v2x#) ^ 2 + (v1y#  - v2y#) ^ 2)
   
   
   Local V1ex# = lx# + Cos(winkelV1#) * entfernungV1#
   Local V1ey# = ly# + Sin(winkelV1#) * entfernungV1#
   For eV1#=entfernungV1# To (range*1.5) Step 1
      If V1ex# < max And V1ey# < may And V1ex# > 0 And V1ey# > 0 Then cutmap(Int(V1ex#),Int(V1ey#))=1
      V1ex# = V1ex# + Cos(winkelV1#) * 1
      V1ey# = V1ey# + Sin(winkelV1#) * 1
   Next
   
   Local V2ex# = lx# + Cos(winkelV2#) * entfernungV2#
   Local V2ey# = ly# + Sin(winkelV2#) * entfernungV2#
   For eV2#=entfernungV2# To (range*1.5) Step 1
      If V2ex# < max And V2ey# < may And V2ex# > 0 And V2ey# > 0 Then cutmap(Int(V2ex#),Int(V2ey#))=1
      V2ex# = V2ex# + Cos(winkelV2#) * 1
      V2ey# = V2ey# + Sin(winkelV2#) * 1
   Next
   
   Local V1toV2ex# = v1x#
   Local V1toV2ey# = v1y#
   For eV1toV2#=0 To entfernungV1toV2# Step 1
      If V1toV2ex# < max And V1toV2ey# < may And V1toV2ex# > 0 And V1toV2ey# > 0 Then cutmap(Int(V1toV2ex#),Int(V1toV2ey#))=1
      V1toV2ex# = V1toV2ex# + Cos(winkelV1toV2#) * 1
      V1toV2ey# = V1toV2ey# + Sin(winkelV1toV2#) * 1
   Next
   
End Function


Function add_lines(sx,sy,zx,zy)
   linecount=linecount+1
   fline(linecount,0)=sx
   fline(linecount,1)=sy
   fline(linecount,2)=zx
   fline(linecount,3)=zy
End Function

Function CreateRandomObjects(n = 50)
   ; creates n random light blocking objects
   Local i, j, x#, y#, a#, e, r#
   For i = 1 To n
      x = Rnd(1024)
      y = Rnd(768)
      a = Rnd(360)
      e = Rand(1, 4)
      e = (e = 1) * 3 + (e = 2) * 4 + (e = 3) * 6 + (e = 4) * 36
      r = Rnd(20, 50)
      For j = 1 To e
         add_lines(x + Cos(a + j * 360 / e) * r, y + Sin(a + j * 360 / e) * r, x + Cos(a + (j + 1) * 360 / e) * r, y + Sin(a + (j + 1) * 360 / e) * r)
      Next
   Next
End Function

e = (e = 1) * 3 + (e = 2) * 4 + (e = 3) * 6 + (e = 4) * 36