PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Particle Picasso

https://www.purebasic.fr/english/viewtopic.php?t=19673

Page 1 of 1

Particle Picasso

Posted: Sun Feb 19, 2006 11:26 pm
by Hroudtwolf
A little particlefun by Hellhound, Hades and myself.

Code: Select all

; Particle Picasso
; 2006 Hroudtwolf
; PureBasic-Lounge.de
; PureBasic Version 4.00
; slightly modified by Hades, Hellhound


#D3DBLEND_ZERO            = 1
#D3DBLEND_ONE             = 2
#D3DBLEND_SRCCOLOR        = 3
#D3DBLEND_INVSRCCOLOR     = 4
#D3DBLEND_SRCALPHA        = 5
#D3DBLEND_INVSRCALPHA     = 6
#D3DBLEND_DESTALPHA       = 7
#D3DBLEND_INVDESTALPHA    = 8
#D3DBLEND_DESTCOLOR       = 9
#D3DBLEND_INVDESTCOLOR    = 10
#D3DBLEND_SRCALPHASAT     = 11
#D3DBLEND_BOTHSRCALPHA    = 12
#D3DBLEND_BOTHINVSRCALPHA = 13



If InitSprite() = 0 Or InitSprite3D() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Fehler", "Dein System ist doof.", 0)
  End
EndIf


Structure _ParticlesStruct
  x.l
  y.l
  intens.l 
  ruin.l
  size.l
  smoke.l
EndStructure
Global NewList ParticleList._ParticlesStruct()



Declare CreateParticlesOnMouse (x.l,y.l)
Declare DisplayParticles()


#GrundSprite_0=1
#GrundSprite_1=2
#Sprite3D_0=1
#Sprite3D_1=2

If OpenScreen(1024, 768, 32, "Smooth particles")


  If CreateSprite (#GrundSprite_0,16,16,#PB_Sprite_Texture)
    If StartDrawing(SpriteOutput(#GrundSprite_0))
      For Y.l = -7 To 7
        For X.l = -7 To 7
          d.f = Sqr(X*X + Y*Y)
          If d<7.0
            d = 7.0 - d
            Plot(7+X,7+Y,RGB(32*d,4*d,d))
          EndIf
        Next
      Next
      StopDrawing()
    EndIf
    CreateSprite3D(#Sprite3D_0,#GrundSprite_0)
    
  EndIf   
 
 
  If CreateSprite (#GrundSprite_1,16,16,#PB_Sprite_Texture)
    If StartDrawing(SpriteOutput(#GrundSprite_1))
           For x=1 To 15
             gray.l=Random (40)
             Circle(5+Random(6),5+Random(6),Random (6),RGB(gray.l+5,gray.l,gray.l+10))
           Next x
      StopDrawing()
    EndIf
    CreateSprite3D(#Sprite3D_1,#GrundSprite_1)
  EndIf   


Sprite3DQuality(1)

  Repeat   
    FlipBuffers()   
    ClearScreen($000000)
   
    ExamineMouse ()
    MsX.l=MouseX()
    MsY.l=MouseY()
   
    CreateParticlesOnMouse (MsX.l,MsY.l)
    DisplayParticles()

   
   
    ExamineKeyboard()
    Delay (1)
  Until KeyboardPushed(#PB_Key_Escape)
 

EndIf

End   



Procedure CreateParticlesOnMouse (x.l,y.l)
    If CountList (ParticleList())<1000
      For z=1 To 10+Random(50)
        AddElement (ParticleList())
        ParticleList()\x=x.l+(-6+Random(12))
        ParticleList()\y=y.l+(-6+Random(12))
        ParticleList()\intens=255-Random(100)
        ParticleList()\ruin=1+Random(15)
        ParticleList()\size=Random(16)
        ParticleList()\smoke=Random(1)
      Next z
    EndIf
EndProcedure


Procedure DisplayParticles()
   Start3D()
   Sprite3DBlendingMode(#D3DBLEND_SRCALPHA, #D3DBLEND_ONE)
     ForEach ParticleList()
           
        If ParticleList()\smoke=1
          ZoomSprite3D (#Sprite3D_1,4+ParticleList()\size,4+ParticleList()\size+Random(3))  
          DisplaySprite3D (#Sprite3D_1,ParticleList()\x,ParticleList()\y,Int(ParticleList()\intens/4)) 
          fleet.l=Int(ParticleList()\ruin/2)
          If fleet.l<1:fleet.l=1:EndIf 
          ParticleList()\y-fleet.l
          ParticleList()\x+(-2+(Random(4)))
        Else
         ZoomSprite3D (#Sprite3D_1,4+ParticleList()\size,4+ParticleList()\size+Random(3))  
         DisplaySprite3D (#Sprite3D_0,ParticleList()\x,ParticleList()\y,ParticleList()\intens)
         ParticleList()\y+ParticleList()\ruin
        EndIf     
        
        If ParticleList()\y>1024:DeleteElement (ParticleList()):EndIf     
        ParticleList()\intens-ParticleList()\ruin
        If ParticleList()\intens<0:DeleteElement (ParticleList()):EndIf       
     Next
   Stop3D()
EndProcedure

Posted: Mon Feb 20, 2006 12:38 am
by va!n
very nice work! esp the smoke looks very realistic ;)

Posted: Mon Feb 20, 2006 12:45 am
by Intrigued
Right on cool!

Re: Particle Picasso

Posted: Mon Feb 20, 2006 1:20 am
by NoahPhense
That's freakin great..

Nice work.. wanna see more! ;)

- np

Posted: Mon Feb 20, 2006 2:59 am
by rsts
Nice indeed.

Thanks for sharing with us.

cheers

Posted: Mon Feb 20, 2006 5:18 am
by Hroudtwolf
Thanks.

Now you can burn holes in your screen :D

Code: Select all


; Partikel Picasso
; 2006 Hroudtwolf
; PureBasic-Lounge.de
; PureBasic Version 4.00
; slightly modified by Hades, Hellhound & Hroudtwolf


#D3DBLEND_ZERO            = 1
#D3DBLEND_ONE             = 2
#D3DBLEND_SRCCOLOR        = 3
#D3DBLEND_INVSRCCOLOR     = 4
#D3DBLEND_SRCALPHA        = 5
#D3DBLEND_INVSRCALPHA     = 6
#D3DBLEND_DESTALPHA       = 7
#D3DBLEND_INVDESTALPHA    = 8
#D3DBLEND_DESTCOLOR       = 9
#D3DBLEND_INVDESTCOLOR    = 10
#D3DBLEND_SRCALPHASAT     = 11
#D3DBLEND_BOTHSRCALPHA    = 12
#D3DBLEND_BOTHINVSRCALPHA = 13



If InitSprite() = 0 Or InitSprite3D() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester("Fehler", "Dein System ist doof.", 0)
  End
EndIf



 
Structure _ParticlesStruct
  x.l
  y.l
  intens.l 
  ruin.l
  size.l
  smoke.l
EndStructure
Global NewList ParticleList._ParticlesStruct()



Declare CreateParticlesOnMouse (x.l,y.l)
Declare DisplayParticles()
Declare Movement ()

#Hintergrund=0
#GrundSprite_0=1
#GrundSprite_1=2
#Sprite3D_0=1
#Sprite3D_1=2

If OpenScreen(1024, 768, 32, "Smooth particles")
   
   
  If CreateSprite (#Hintergrund,1024,768)
     If StartDrawing (SpriteOutput (#Hintergrund))
        Box(0,0,1024,768,$165AAC)
        For x=1 To 1024 Step 2
           Line (x,0,0,768,$124268)
        Next x
     StopDrawing ()
     EndIf 
     Else
     End
  EndIf  
   

  If CreateSprite (#GrundSprite_0,16,16,#PB_Sprite_Texture)
    If StartDrawing(SpriteOutput(#GrundSprite_0))
      For Y.l = -7 To 7
        For X.l = -7 To 7
          d.f = Sqr(X*X + Y*Y)
          If d<7.0
            d = 7.0 - d
            Plot(7+X,7+Y,RGB(32*d,4*d,d))
          EndIf
        Next
      Next
      StopDrawing()
    EndIf
    CreateSprite3D(#Sprite3D_0,#GrundSprite_0)
    Else
     End
  EndIf   
 
 
  If CreateSprite (#GrundSprite_1,16,16,#PB_Sprite_Texture)
    If StartDrawing(SpriteOutput(#GrundSprite_1))
           For x=1 To 15
             gray.l=Random (40)
             Circle(5+Random(6),5+Random(6),Random (6),RGB(gray.l+5,gray.l,gray.l+10))
           Next x
      StopDrawing()
    EndIf
    CreateSprite3D(#Sprite3D_1,#GrundSprite_1)
    Else
    End
  EndIf   


Sprite3DQuality(1)

  Repeat   
    FlipBuffers()   
    ClearScreen($000000)
    DisplaySprite (#Hintergrund,0,0)
    
    
    ExamineMouse ()
    MsX.l=MouseX()
    MsY.l=MouseY()

    CreateParticlesOnMouse (MsX.l,MsY.l)
    DisplayParticles()

   
   
    ExamineKeyboard()
    Delay (1)
  Until KeyboardPushed(#PB_Key_Escape)
 

EndIf

End   



Procedure CreateParticlesOnMouse (x.l,y.l)
    If CountList (ParticleList())<1000
      For z=1 To 10+Random(50)
        AddElement (ParticleList())
        ParticleList()\x=x.l+(-6+Random(12))
        ParticleList()\y=y.l+(-6+Random(12))
        ParticleList()\intens=255-Random(100)
        ParticleList()\ruin=1+Random(15)
        ParticleList()\size=Random(16)
        ParticleList()\smoke=Random(1)
        If StartDrawing (SpriteOutput (#Hintergrund))
           If ParticleList()\x>0 And ParticleList()\x<1023 And ParticleList()\y>0 And ParticleList()\y<768              
              heat.l=2+Random(10)
              Offset.l=5+Random(5)
              Color.l=Point(ParticleList()\x+Offset.l,ParticleList()\y+Offset.l)
              NewRed.l=Red(Color.l)-heat.l:NewGreen.l=Green(Color.l)-heat.l:NewBlue.l=Blue(Color.l)-heat.l              
              If NewRed.l<0:NewRed.l=0:EndIf 
              If NewGreen.l<0:NewGreen.l=0:EndIf 
              If NewBlue.l<0:NewBlue.l=0:EndIf 
              Circle (ParticleList()\x+Offset.l,ParticleList()\y+Offset.l,Random(2),RGB(NewRed.l,NewGreen.l,NewBlue.l))
           EndIf 
           StopDrawing ()
        EndIf 
      Next z
    EndIf
EndProcedure


Procedure DisplayParticles()
   Start3D()
   Sprite3DBlendingMode(#D3DBLEND_SRCALPHA, #D3DBLEND_ONE)
     ForEach ParticleList()
           
        If ParticleList()\smoke=1
          ZoomSprite3D (#Sprite3D_1,4+ParticleList()\size,4+ParticleList()\size+Random(3))  
          DisplaySprite3D (#Sprite3D_1,ParticleList()\x,ParticleList()\y,Int(ParticleList()\intens/4)) 
          fleet.l=Int(ParticleList()\ruin/2)
          If fleet.l<1:fleet.l=1:EndIf 
          ParticleList()\y-fleet.l
          ParticleList()\x+(-2+(Random(4)))
        Else
         ZoomSprite3D (#Sprite3D_1,4+ParticleList()\size,4+ParticleList()\size+Random(3))  
         DisplaySprite3D (#Sprite3D_0,ParticleList()\x,ParticleList()\y,ParticleList()\intens)
         ParticleList()\y+ParticleList()\ruin
        EndIf     
        
        If ParticleList()\y>1024:DeleteElement (ParticleList()):EndIf     
        ParticleList()\intens-ParticleList()\ruin
        If ParticleList()\intens<0:DeleteElement (ParticleList()):EndIf       
     Next
   Stop3D()
EndProcedure

Posted: Mon Feb 20, 2006 7:38 am
by SCRJ
Great! :D

Posted: Mon Feb 20, 2006 4:06 pm
by rsts
Really cool -

(but) - after my daughter was "testing" it for a few minutes -

(ERROR) Line:181
(ERROR) The linked list doesn't have a current element.


cheers

Posted: Mon Feb 20, 2006 11:11 pm
by va!n
again very very cool one!
remembers me on the intro sequence by factor5 (turrican) on amiga ;-)

Posted: Mon Feb 20, 2006 11:16 pm
by Fred
Nice one !

Posted: Thu Feb 23, 2006 5:06 am
by Hroudtwolf
Thank you at all !
Image
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited