PureBasic Forums - English

Code: Select all

; Hroudtwolf
; 09/10/2008
; PureBasic 4.2x
; Linux, OS X, Windows
#D3DBLEND_ONE             = 2
#D3DBLEND_SRCALPHA        = 5

#UPDATETIME               = 25

Structure tParticle
   lRadius  .l
   fAngle   .f
   lPartSize.l
EndStructure

Structure tParticleSprite
   *Sprite2D
   *Sprite3D
EndStructure

Declare.f gSin                   ( fAngle.f )
Declare.f gCos                   ( fAngle.f )
Declare.l CreateBlackHole        ( Particles.tParticle () , lAmount.l )
Declare.l DisplayBlackHole       ( lX.l , lY.l , *ParticleSprite.tParticleSprite , Particles.tParticle () )
Declare.l CreateParticleSprite   ()

Define.LONG *Window
Define      *Particle
Define      lStartTime  .l
Define      lLatencyTime.l

NewList Particles.tParticle ()

If Not InitSprite () Or Not InitSprite3D ()
   End
EndIf

*Window = OpenWindow ( #PB_Any , #PB_Ignore , #PB_Ignore , 800 , 600 , "CERN :: By Marc-Sven Rudolf 2008 (c) (Hroudtwolf)" , #PB_Window_ScreenCentered | #PB_Window_SystemMenu )
If Not *Window
   End
EndIf

; Just for demonstrative purpose
CompilerSelect #PB_Compiler_OS
   CompilerCase #PB_OS_Windows
   OpenWindowedScreen ( *Window\l , 0 , 0 , 800 , 600 , #False , 0 , 0 )
   CompilerDefault
   OpenWindowedScreen ( WindowID ( *Window ) , 0 , 0 , 800 , 600 , #False , 0 , 0 )
CompilerEndSelect

CreateBlackHole ( Particles () , 600 )
*Particle = CreateParticleSprite  ()

Repeat
   lStartTime = ElapsedMilliseconds ()
   
   Repeat
      Select WindowEvent ()      
         Case #PB_Event_CloseWindow 
         End
         
         Case #Null
         Break 1
      EndSelect
   ForEver
   
   FlipBuffers ()
   ClearScreen ( $000000 )
 
   DisplayBlackHole ( 380 , 290 , *Particle , Particles () )
 
   If lLatencyTime < #UPDATETIME
      Delay ( #UPDATETIME - lLatencyTime )
   EndIf    
ForEver

Procedure.f gSin ( fAngle.f )

   ProcedureReturn Sin ( fAngle * ( 2 * 3.14159265 / 360 ) )
EndProcedure

Procedure.f gCos ( fAngle.f )

   ProcedureReturn Cos ( fAngle * ( 2 * 3.14159265 / 360 ) )
EndProcedure

Procedure.l CreateParticleSprite  ()
   Protected *ParticleSprite  .tParticleSprite = AllocateMemory ( SizeOf ( tParticleSprite ) )
   Protected fD               .f
   Protected lX               .l
   Protected lY               .l
   
   *ParticleSprite\Sprite2D = CreateSprite   ( #PB_Any , 16 , 16 , #PB_Sprite_Texture )
   *ParticleSprite\Sprite3D = CreateSprite3D ( #PB_Any , *ParticleSprite\Sprite2D )
   
   If Not StartDrawing( SpriteOutput ( *ParticleSprite\Sprite2D ) )
      ProcedureReturn #Null
   EndIf
   For lY = -7 To 7
      For lX = -7 To 7
         fD = Sqr( lX * lX + lY * lY )
         If fD < 7.0
            fD = 7.0 - fD
            Plot( 7 + lX , 7 + lY , RGB ( 16 * fD , 16 * fD , 32 * fD ) )
         EndIf
      Next
   Next
   StopDrawing()
 
   ProcedureReturn *ParticleSprite
EndProcedure

Procedure.l CreateBlackHole  ( Particles.tParticle () , lAmount.l )
   Protected lI.l
   
   For lI = 0 To lAmount
      AddElement ( Particles () )
      Particles ()\lRadius   = 100 + Random ( 300 )
      Particles ()\fAngle    = Random ( 359 )
      Particles ()\lPartSize = 48 + Random ( 48 )
   Next lI
   
   ProcedureReturn #Null
EndProcedure

Procedure.l DisplayBlackHole  ( lX.l , lY.l , *ParticleSprite.tParticleSprite , Particles.tParticle () )
   Protected lI.l
   
   Start3D ()
      Sprite3DBlendingMode ( #D3DBLEND_SRCALPHA , #D3DBLEND_ONE )
           
      ForEach Particles ()
         ZoomSprite3D ( *ParticleSprite\Sprite3D , Particles ()\lPartSize , Particles ()\lPartSize )
         DisplaySprite3D ( *ParticleSprite\Sprite3D , lX + gSin ( Particles ()\fAngle ) * Particles ()\lRadius , lY + GCos( Particles ()\fAngle ) * Particles ()\lRadius , 255 - ( Particles ()\lRadius / 2 ) )
         Particles ()\fAngle + ( ( 400 / Particles ()\lRadius ) + 1 )
         If Particles ()\fAngle > 359
            Particles ()\fAngle = 0
            Particles ()\lRadius - 1
         EndIf
         If Particles ()\lRadius < 50
            Particles ()\lRadius = 400
         EndIf
      Next
   Stop3D ()
   
   ProcedureReturn #Null
EndProcedure