Fire effect...

Everything else that doesn't fall into one of the other PB categories.
Post Reply
GPI
PureBasic Expert
PureBasic Expert
Posts: 1394
Joined: Fri Apr 25, 2003 6:41 pm

Post by GPI »

Ok, i know now, why i have use direct-access to the screen. Before i have a 8-Bit-color-depth and there is direct-access faster.

ok, my new Circle-Fire:

Code: Select all

;#realx=1024:#realy=768
;#realx=800:#realy=600
;#realx=640:#realy=480
;#realx=512:#realy=384
;#realx=400:#realy=300
;#realx=320:#realy=240
#realx=320:#realy=200

;#aufx=1024:#aufy=768
;#aufx=800:#aufy=600
;#aufx=640:#aufy=480
;#aufx=512:#aufy=384
;#aufx=400:#aufy=300
;#aufx=320:#aufy=240
;#aufx=320:#aufy=200

#aufx=#realx : #aufy=#realy

#bigmax=50
#bigmin=0

#speed=3

#updown=1 ; 0 or 1 Calculate from up to down (1) or down to up (0)


Structure long
  l.l
EndStructure
Dim color(255)
Dim col(#aufx,#aufy)
Dim KreisPointx(50,50,800)
Dim KreisPointy(50,50,800)
Procedure.f deg(rad)
  ProcedureReturn 3.1415926*rad/180
EndProcedure
  
If #realx<#aufx Or #realy<#aufy
  MessageRequester("Fire","auflösung",0)
  End
EndIf
If InitSprite()=0
  MessageRequester("Fire","sprite",0)
  End
EndIf
If InitKeyboard()=0
  MessageRequester("Fire","keyboard",0)
  End
EndIf
OpenWindow(0,0,0,#realx,#realy,0,"hallo")
If OpenScreen(#realx,#realy,32,"PureFire")=0
  MessageRequester("Fire","open",0)
  End
EndIf

For x=0 To 50
  For y=0 To 50
    cxx=0:cyy=0:a=-1
    For i=0 To 360
      cx=Int(Cos(deg(i))*x)
      cy=Int(Sin(deg(i))*y)
      If cx<>cxx Or cy<>cyy
        a+1
        KreisPointx(x,y,a)=cx
        KreisPointy(x,y,a)=cy
      EndIf
    Next
  Next
Next


For i=0 To 84
  color(i)      =RGB(Int(250/84*i),0,0)
  color(i+85)   =RGB(250,Int(250/84*i),0)
  color(i+85+85)=RGB(250,250,Int(250/84*i))
Next
color(255)=RGB(255,255,255)


bigx=#bigmin:dbigx=1
bigy=#bigmax:dbigy=-1

kx=Random(#aufx):ky=Random(#aufy)
dx=#speed:dy=#speed

ClearScreen(0,0,0)
FlipBuffers()
ClearScreen(0,0,0)

Repeat
  bigx+dbigx
  If bigx>=#bigmax
    bigx=#bigmax
    dbigx=-Random(#speed)
  ElseIf bigx<=#bigmin
    bigx=#bigmin
    dbigx=Random(#speed)
  EndIf

  bigy+dbigy
  If bigy>=#bigmax
    bigy=#bigmax
    dbigy=-Random(#speed)
  ElseIf bigy<=#bigmin
    bigy=#bigmin
    dbigy=Random(#speed)
  EndIf    
  
  kx+dx:ky+dy
  
  If kx<=bigx
    kx=bigx
    dx=Random(#speed)
  ElseIf kx>=#aufx-bigx
    kx=#aufx-bigx
    dx=-Random(#speed)
  EndIf
  
  If ky<=bigy
    ky=bigy
    dy=Random(#speed)
  ElseIf ky>=#aufy-bigy
    ky=#aufy-bigy
    dy=-Random(#speed)
  EndIf

  *cx.long=@KreisPointx(bigx,bigy,0)
  *cy.long=@KreisPointy(bigx,bigy,0)
  While *cx\l<>0 Or *cy\l<>0
    x=kx+*cx\l:y=ky+*cy\l
    If x>0 And x<#aufx-1 And y>0 And y<#aufy-1
      col(x,y)+Random(100)
    EndIf
    *cx+4
    *cy+4
  Wend
   
  StartDrawing(ScreenOutput())
  
  CompilerIf #updown
    For NY=1 To #aufy-2
    
  CompilerElse
    For NY=#aufy-2 To 1 Step -1
    
  CompilerEndIf
    
    For NX=1 To #aufx-2
      If NY=#aufy-2
        If KeyboardPushed(#PB_Key_space)
          col(NX,NY)+Random(255*4)
        EndIf
      EndIf
      c1=col(NX,NY)
      c2=col(NX,NY+1)
      c3=col(NX-1,NY+1)
      c4=col(NX+1,NY+1)
      i= (c1+c2+c3+c4)>>2
      
      If i<0:i=0:EndIf
      
     
      col(NX,NY)=i
      
      If i>255
        Plot(NX,NY,color(255))
      Else
        Plot(NX,NY,color(i))
      EndIf
    Next 
  Next 
    
  StopDrawing()
  
  ExamineKeyboard() 
  FlipBuffers() 
Until KeyboardPushed(#PB_Key_escape)
Debug "normal end"
End
Top
GPI
PureBasic Expert
PureBasic Expert
Posts: 1394
Joined: Fri Apr 25, 2003 6:41 pm

Post by GPI »

And a faster version, but with slowdowns... on my PC, but faster than fullredraw!

Code: Select all

#realx=1024:#realy=768
;#realx=800:#realy=600
;#realx=640:#realy=480
;#realx=512:#realy=384
;#realx=400:#realy=300
;#realx=320:#realy=240
;#realx=320:#realy=200

;#aufx=1024:#aufy=768
;#aufx=800:#aufy=600
;#aufx=640:#aufy=480
;#aufx=512:#aufy=384
;#aufx=400:#aufy=300
;#aufx=320:#aufy=240
;#aufx=320:#aufy=200

#aufx=#realx : #aufy=#realy

#bigmax=50
#bigmin=0

#speed=3

#updown=1 ; 0 or 1 Calculate from up to down (1) or down to up (0)

NewList punkte.point()
NewList NewPunkte.point()
NewList delpunkte.point()

Structure long
  l.l
EndStructure
Dim color(255)
Dim col(#aufx,#aufy)
Dim in(#aufx,#aufy)
Dim KreisPointx(50,50,800)
Dim KreisPointy(50,50,800)
Procedure.f deg(rad)
  ProcedureReturn 3.1415926*rad/180
EndProcedure
Procedure addpoint(xx,yy)
  For x=xx-1 To xx+1
    For y=yy-1 To yy
      If x>0 And x<#aufx-1 And y>0 And y<#aufy-1
        If in(x,y)=0
          AddElement(punkte())
          punkte()\x=x
          punkte()\y=y
          in(x,y)=1
        EndIf
      EndIf
    Next
  Next
EndProcedure
  
If #realx<#aufx Or #realy<#aufy
  MessageRequester("Fire","auflösung",0)
  End
EndIf
If InitSprite()=0
  MessageRequester("Fire","sprite",0)
  End
EndIf
If InitKeyboard()=0
  MessageRequester("Fire","keyboard",0)
  End
EndIf
OpenWindow(0,0,0,#realx,#realy,0,"hallo")
If OpenScreen(#realx,#realy,32,"PureFire")=0
  MessageRequester("Fire","open",0)
  End
EndIf

For x=0 To #aufx-1
  in(x,0)=1
  in(x,#aufy-1)=1
Next
For y=0 To #aufy-1
  in(0,y)=1
  in(#aufx-1,y)=1
Next

For x=0 To 50
  For y=0 To 50
    cxx=0:cyy=0:a=-1
    For i=0 To 360
      cx=Int(Cos(deg(i))*x)
      cy=Int(Sin(deg(i))*y)
      If cx<>cxx Or cy<>cyy
        a+1
        KreisPointx(x,y,a)=cx
        KreisPointy(x,y,a)=cy
      EndIf
    Next
  Next
Next


For i=0 To 84
  color(i)      =RGB(Int(250/84*i),0,0)
  color(i+85)   =RGB(250,Int(250/84*i),0)
  color(i+85+85)=RGB(250,250,Int(250/84*i))
Next
color(255)=RGB(255,255,255)


bigx=#bigmin:dbigx=1
bigy=#bigmax:dbigy=-1

kx=Random(#aufx):ky=Random(#aufy)
dx=#speed:dy=#speed

ClearScreen(0,0,0)
FlipBuffers()
ClearScreen(0,0,0)


Repeat
  ;ClearScreen(0,0,0)
  
  bigx+dbigx
  If bigx>=#bigmax
    bigx=#bigmax
    dbigx=-Random(#speed)
  ElseIf bigx<=#bigmin
    bigx=#bigmin
    dbigx=Random(#speed)
  EndIf

  bigy+dbigy
  If bigy>=#bigmax
    bigy=#bigmax
    dbigy=-Random(#speed)
  ElseIf bigy<=#bigmin
    bigy=#bigmin
    dbigy=Random(#speed)
  EndIf    
  
  kx+dx:ky+dy
  
  If kx<=bigx
    kx=bigx
    dx=Random(#speed)
  ElseIf kx>=#aufx-bigx
    kx=#aufx-bigx
    dx=-Random(#speed)
  EndIf
  
  If ky<=bigy
    ky=bigy
    dy=Random(#speed)
  ElseIf ky>=#aufy-bigy
    ky=#aufy-bigy
    dy=-Random(#speed)
  EndIf

  *cx.long=@KreisPointx(bigx,bigy,0)
  *cy.long=@KreisPointy(bigx,bigy,0)
  While *cx\l<>0 Or *cy\l<>0
    x=kx+*cx\l:y=ky+*cy\l
    If x>0 And x<#aufx-1 And y>0 And y<#aufy-1
      addpoint(x,y)      
      col(x,y)+Random(100)
    EndIf
    *cx+4
    *cy+4
  Wend
   
  StartDrawing(ScreenOutput())

  If fast
    Plot(10,10,RGB(255,255,255))
  EndIf
  
  ResetList(punkte())
  While NextElement(punkte())
    NX=punkte()\x
    NY=punkte()\y
    
    c1=col(NX,NY)
    c2=col(NX,NY+1)
    c3=col(NX-1,NY+1)
    c4=col(NX+1,NY+1)
    i= (c1+c2+c3+c4)>>2
    If i<0:i=0:EndIf
    If i>255:i=255:EndIf
       
    If i 
      addpoint(NX,NY)
    Else
      DeleteElement(punkte())
      in(NX,NY)=0
    EndIf
    col(NX,NY)=i
    Plot(NX,NY,color(i))
    
  Wend 
    
  StopDrawing()
  
  ExamineKeyboard() 
  FlipBuffers() 
Until KeyboardPushed(#PB_Key_escape)
Debug "normal end"
End
Top
Post Reply

Return to “General Discussion”