;----------------------------------
;           Bloom Filter          ;
;        Made by StepTiger        ;
;----------------------------------
;                                 ;
;            Main Code            ;
;          Global Things          ;
;----------------------------------

Graphics3D 800,600,32,2
SetBuffer BackBuffer()

;Consants
Const TYPE_NORMAL=0
Const TYPE_LASER=1

;Dims
Dim farbr(1)
Dim farbg(1)
Dim farbb(1)

;Types
Type Objekt
   Field obj
   Field typ
End Type

;Cams
cam=CreateCamera()
CameraRange cam,.5,1000

;Light
Light=CreateLight(2)
PositionEntity light,2,200,0

;Bloom Sprite and Tex
BloomSprite=CreateSprite(cam)
BloomTex=CreateTexture(64,64,8)
MoveEntity BloomSprite,-(GraphicsWidth()-TextureWidth(BloomTex)*6)*.00005,-TextureHeight(BloomTex)*.0005+(GraphicsHeight())*.0001,1
EntityTexture BloomSprite,BloomTex
EntityBlend BloomSprite,3
TextureBlend BloomTex,5

;Test Cube
cube=CreateCube()
PositionEntity cube,0,0,5
RegisterObject(cube,TYPE_NORMAL)

;Laser Beam
beam=CreateCylinder()
ScaleEntity beam,.02,1,.02
PositionEntity beam,0,0,2
EntityAlpha beam,.99
EntityColor beam,255,0,0
RegisterObject(beam,TYPE_LASER)

;While Loop
While Not KeyDown(1)
   
   Bloom(cam,BloomSprite,BloomTex)
   
   UpdateWorld
   RenderWorld
   
   fps#=(19.*fps#+1000./(MilliSecs()-LastFPS))/20.:LastFPS=MilliSecs()
   
   Text 1,1,fps#
   
   Flip
   
Wend

;Functions

;Register an Object
Function RegisterObject(obj,typ)
   
   r.Objekt=New Objekt
   r\obj=obj
   r\typ=typ
   
End Function

;The Main Bloom Function
Function Bloom(Cam,Sprite,Tex)
   
   HideEntity Sprite
   
   For f.Objekt=Each Objekt
      If f\typ<>TYPE_LASER Then HideEntity f\obj
   Next
   
   wid=TextureWidth(Tex)
   hei=TextureHeight(Tex)
   
   gfxwid=GraphicsWidth()
   gfxhei=GraphicsHeight()
   
   CameraViewport Cam,0,0,wid,hei
   RenderWorld
   
   CopyRect 0,0,wid,hei,0,0,BackBuffer(),TextureBuffer(Tex)
   Blur(Tex,1)
   
   CameraViewport Cam,0,0,gfxwid,gfxhei
   
   For f.Objekt=Each Objekt
      ShowEntity f\obj
   Next
   
   ShowEntity Sprite
   
End Function

;Blur an Image or Texture
Function Blur(Bild,tex)
   
   If tex=1
      
      LockBuffer TextureBuffer(Bild)
      wid=TextureWidth(Bild)
      hei=TextureHeight(Bild)
      
   ElseIf tex=2
      
      LockBuffer ImageBuffer(Bild)
      wid=ImageWidth(Bild)
      hei=ImageHeight(Bild)
      
   EndIf
   
   Dim farbr(wid*(hei+1)+hei)
   Dim farbg(wid*(hei+1)+hei)
   Dim farbb(wid*(hei+1)+hei)
   
   For x=0 To wid-1
      For y=0 To hei-1
         
         pos=x*(hei+1)+y
         
         If tex=1
            
            farb=ReadPixelFast(x,y,TextureBuffer(Bild))
            
         ElseIf tex=2
            
            farb=ReadPixelFast(x,y,ImageBuffer(Bild))
            
         EndIf
         
         farbr(pos)=farb Shr 16 And 255
         farbg(pos)=farb Shr 8 And 255
         farbb(pos)=farb And 255
         
      Next
   Next
   
   For x=0 To wid-1
      For y=0 To wid-1
         
         pos=x*(hei+1)+y
         
         c=0
         
         cr=0
         cg=0
         cb=0
         
         For px=-1 To 1
            For py=-1 To 1
               
               tx=x+px
               ty=y+py
               tpos=tx*(hei+1)+ty
               
               If tx>=0 And tx<wid And ty>=0 And ty<hei
                  
                  c=c+1
                  cr=cr+farbr(tpos)
                  cg=cg+farbg(tpos)
                  cb=cb+farbb(tpos)
                  
               EndIf
               
            Next
         Next
         
         cr=cr/c
         cg=cg/c
         cb=cb/c
         
         col=(cr Shl 16) + (cg Shl 8) + (cb)
         
         If tex=1
            
            WritePixelFast x,y,col,TextureBuffer(Bild)
            
         ElseIf tex=2
            
            WritePixelFast x,y,col,ImageBuffer(Bild)
            
         EndIf
         
      Next
   Next
   
   If tex=1
      
      UnlockBuffer TextureBuffer(Bild)
   
   ElseIf tex=2
      
      UnlockBuffer ImageBuffer(Bild)
      
   EndIf
   
End Function