PureBasic Forums - English

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

Fire effect...

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

Page 1 of 2

Fire effect...

Posted: Sun Apr 27, 2003 10:14 pm
by cederavic
Fire effect is very funny! :D
Look at this screen capture on my forum : http://www.serveurperso.com/~cederavic/ ... ic.php?t=4

Re: Fire effect...

Posted: Sun Apr 27, 2003 10:20 pm
by GPI
cederavic wrote:Fire effect is very funny! :D
Look at this screen capture on my forum : http://www.serveurperso.com/~cederavic/ ... ic.php?t=4
Do you know my set-on-fire-routine.

I think, that a varitation of this can be done with my routine (change the mouse-move-fire to moving-circle-fire)

GPI.

btw: Nice pictures, but where is the code?

Posted: Sun Apr 27, 2003 10:32 pm
by cederavic
I did not see your routine... But it is the same one everywhere (I think). With regard to the code, it will be available when I would have finished my demo because this effect in fact left :wink:

Posted: Mon Apr 28, 2003 12:31 pm
by GPI
My code:

Code: Select all

removed code to make the thread shorter :)

Posted: Mon Apr 28, 2003 12:43 pm
by cederavic
And mind :lol:

Code: Select all

InitSprite() 
InitKeyboard()

OpenScreen(320, 200, 16, "Demo")

Dim Screen(320, 201)
Dim pal(254)

UsePNGImageDecoder()
LoadImage(0, "Media/pal1.png")
StartDrawing(ImageOutput())
  For x = 0 To 254
    pal(x) = Point(x, 0)
  Next
StopDrawing()
  
Repeat
  ExamineKeyboard()
  StartDrawing(ScreenOutput())
  For x = 2 To 318
    Screen(x, 200) = Random(255) + 200
    For y = 0 To 199
      
      c1 = Screen(x, y + 1)
      c2 = Screen(x, y + 2)
      c3 = Screen(x + 1, y)
      c4 = Screen(x - 1, y)
      c = (c1 + c2 + c3 + c4) / 4-1
      If c < 0 : c = 0 : EndIf
      If c > 253 : c = 253 : EndIf
      Screen(x, y) = c   
      Plot(x, y, pal(c))
    Next   
  Next

  StopDrawing()
  FlipBuffers()
  ClearScreen(2, 0, 0)
Until KeyboardPushed(#PB_Key_Escape)
pal1.png is in this *.zip : www.serveurperso.com/~cederavic/fadecirclefire.zip

have fun :wink:

Cederavic

Posted: Mon Apr 28, 2003 3:48 pm
by GPI
look on my code, i dont use point, i draw direct on the screen-memory. This is much faster.

Also

Code: Select all

  c = (c1 + c2 + c3 + c4) / 4-1
better use >>2

Code: Select all

  c=(c1+c2+c3+c4)>>2-1
it is also faster.


btw: Here my true fire-routines:

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
;#realx=320:#realy=470-150

;#aufx=320:#aufy=200
;#aufx=640:#aufy=480
;#aufx=512:#aufy=384
;#aufx=400:#aufy=300
;#aufx=#realx:#aufy=#realy
;#aufx=479-100:#aufy=470-150
;#aufx=128:#aufy=128
#aufx=#realx : #aufy=#realy

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

#mouselen=100 ; waittime, before the old mousepoints are deleted

#hotspotadd=0 ; Change the brightness of the hotspots

#dodownmax=0  ; high of the flames (0=small 2=very big)
#downsub=3    ; dito+flicker (0=high flames, no flicker ,10=small high flicker)

text$="Set on Fire by GPI" ; the text ;""=nowtext
#line=1

Structure long
  l.l
EndStructure
  
If #realx<#aufx Or #realy<#aufy
  MessageRequester("Fire","auflösung",0)
  End
EndIf

Dim col(#aufx,#aufy)
Dim hotspot(#aufx,#aufy)

If InitSprite()=0
  MessageRequester("Fire","sprite",0)
  Debug "sprite"
  End
EndIf
If InitKeyboard()=0
  MessageRequester("Fire","keyboard",0)
  Debug "keyboard"
  End
EndIf
If InitMouse()=0
  MessageRequester("Fire","maus",0)
  Debug "maus"
  End
EndIf

OpenWindow(0,0,0,#realx,#realy,0,"hallo")
If OpenScreen(#realx,#realy,32,"PureFire")=0
  MessageRequester("Fire","open",0)
  Debug "open"
  End
EndIf


omx=#aufx/2:omy=#aufy/2
MouseLocate(omx,omy-1)

Structure xy
  x.l
  y.l
  c.l
EndStructure

NewList M.xy()

Dim color(255)
Procedure setcolor(i,r,g,b)
  result=0
  If DrawingBufferPixelFormat()=#PB_PixelFormat_32Bits_RGB
    result=b<<16+g<<8+r
  ElseIf DrawingBufferPixelFormat()=#PB_PixelFormat_32Bits_BGR
    result=r<<16+g<<8+b
  Else
    result=RGB(r,g,b)
  EndIf
  color(i)=result
EndProcedure

StartDrawing(ScreenOutput())
For i=0 To 84
  setColor(i,Int(250/84*i),0,0)
  setcolor(i+85,250,Int(250/84*i),0)
  setColor(i+85+85,250,250,Int(250/84*i))
Next
setColor(255,255,255,255)
StopDrawing()



;draw the flame-points
;ClearScreen(0,0,0)
StartDrawing(ScreenOutput())
DrawingMode(1)
If text$<>""
  LoadFont(0,"Van Dijk",30)
  DrawingFont(FontID())
  DrawingMode(1)
  FrontColor(255,255,255)
  Locate((#aufx-TextLength(text$))>>1,#aufy-1-Int(60/200*#aufy) )
  DrawText(text$)
  CloseFont(0)
EndIf
CompilerIf #line
  LineXY(0,#aufy-1,#aufx-1,#aufy-1)
CompilerEndIf

For y=0 To #aufy-1
  For x=0 To #aufx-1
    If Point(x,y)>0
      hotspot(x,y)=1
    EndIf
  Next
Next
StopDrawing()
;FlipBuffers()
     
dodown=0:count=0
Repeat
  CompilerIf #dodownmax>0
    dodown+1:If dodown>#dodownmax:dodown=0:EndIf
  CompilerEndIf
  count+1:If count>#mouselen:count=0:EndIf
  
  ;mouse
  quit=0
  While FirstElement(m())>0 And quit=0
    If m()\c=count
      hotspot(m()\x,m()\y)=0
      DeleteElement(m())
    Else
      quit=1
    EndIf
  Wend    
  mx=MouseX():my=MouseY()
  If mx>#aufx-1:mx=#aufx-1:EndIf
  If my>#aufy-1:my=#aufy-1:EndIf
  If omx<>mx Or omy<>my
    ax=omx-mx:If ax<0 :ax=-ax:EndIf
    ay=omy-my:If ay<0 :ay=-ay:EndIf
    If ax>ay:ab=ax:Else:ab=ay:EndIf
    ax=omx-mx:ay=omy-my
    For i=1 To ab
      xx=mx+Int(ax*i/ab)
      yy=my+Int(ay*i/ab)
      If hotspot(xX,yY)=0
        LastElement(m())
        AddElement(m())
        m()\x=xx
        m()\y=yy
        m()\c=count
        hotspot(xX,yY)=col(xX,yY)+1
      EndIf
    Next
    omx=mx:omy=my
  EndIf
   
  StartDrawing(ScreenOutput())
  ClearScreen(0,0,0)
  
  CompilerIf #updown
    add=DrawingBufferPitch()
    adr=DrawingBuffer()
    If adr=0 Or add=0
      Debug "adr=0"
      MessageRequester("Fire","adr=0",0)
      End
    EndIf
    
    For NY=0 To #aufy-1
    
  CompilerElse
    sub=DrawingBufferPitch()
    adr=DrawingBuffer()+sub*(#aufy-1)
    If adr=0 Or sub=0
      Debug "adr=0"
      MessageRequester("Fire","adr=0",0)
      End
    EndIf
    
    For NY=#aufy-1 To 0 Step -1
    
  CompilerEndIf
  
    ny1 =ny+1:If ny1 >#aufy-1:ny1=#aufy-1:EndIf
    ny2 =ny+2:If ny2 >#aufy-1:ny2=#aufy-1:EndIf
    ny3 =ny+3:If ny3 >#aufy-1:ny3=#aufy-1:EndIf
    
    *adr2.long=adr
    
    
    For NX=0 To #aufx-1
      nx1=nx-1:If nx1<0:nx1=0:EndIf
      nx3=nx+1:If nx3>#aufx-1:nx3=#aufx-1:EndIf 
        
      i=Int( (col(nx1,ny1)+col(NX,ny1)+col(nx3,ny1)+col(nx1,ny2)+col(NX,ny2)+col(nx3,ny2))/6 )
      ;i= (col(NX,ny1)+col(NX,ny3)+col(nx1,ny2)+col(nx3,ny2))>>2
      If dodown=0
        CompilerIf #downsub=<0
          i-1
        CompilerElse
          i-Random(#downsub)
        CompilerEndIf
      EndIf
      If i<0:i=0:EndIf
      ;If i>254:i=254:EndIf
        
      If hotspot(nx,ny)
        a=col(nx,ny)
        b=hotspot(nx,ny)
        If a=b : b=Random(330)+20:hotspot(nx,ny)=b:EndIf
        If a+10<b:b=a+10:EndIf
        If a-10>b:b=a-10:EndIf
        col(nx,ny)=b
        
        i+#hotspotadd
        If i<0:i=0:EndIf
        If i>255:i=255:EndIf
        
      Else  
        col(nx,ny)=i
        
        If i>254:i=254:EndIf
      EndIf
      
      If i<0
        c=color(0)
      ElseIf i>255
        c=color(255)
      Else
        c=color(i)
      EndIf
      *adr2\l=c
      *adr2+4
      
    Next 
    CompilerIf #updown
      adr+add
    CompilerElse
      adr-sub
    CompilerEndIf
    
  Next 
    
  StopDrawing()
  
  ExamineMouse()  
  ExamineKeyboard() 
  FlipBuffers() 
Until KeyboardPushed(#PB_Key_All)
Debug "normal end"

End
p.s.: Mark you code with {code} and {/code} (note:instead of {} use [], but when i write it in the exampe, you can see it here :)

Posted: Mon Apr 28, 2003 4:25 pm
by Fred
GPI wrote: Also

Code: Select all

  c = (c1 + c2 + c3 + c4) / 4-1
better use >>2

Code: Select all

  c=(c1+c2+c3+c4)>>2-1
it is also faster.
I don't think as PB already do this optimization for you... Here is the generated code:

Code: Select all

; c = (c1 + c2 + c3 + c4) / 4-1
  MOV    ebx,dword [v_c1]
  ADD    ebx,dword [v_c2]
  ADD    ebx,dword [v_c3]
  ADD    ebx,dword [v_c4]
  MOV    edi,ebx
  SAR    edi,2
  ADD    edi,-1
  MOV    dword [v_c],edi

Posted: Mon Apr 28, 2003 4:33 pm
by freak
Hehe, PB is getting smart 8)

Also directmemoryaccess is not really faster than Plot() anymore.
Some guy tested it and he said, the results were nearly the same now.

Good work Fred :D

Timo

Posted: Mon Apr 28, 2003 4:34 pm
by GPI
>I don't think as PB already do this optimization for you... Here is the generated code:

Oh, is this new?

@cederavic:
I want to see the complete code. Your EXE is fast, too fast for plot...
(my programms who use plot is slow, very, very slow)

GPI

Posted: Mon Apr 28, 2003 5:29 pm
by Fred
GPI wrote:>I don't think as PB already do this optimization for you... Here is the generated code:

Oh, is this new?

@cederavic:
I want to see the complete code. Your EXE is fast, too fast for plot...
(my programms who use plot is slow, very, very slow)

GPI
No, the << optimisation was here since 2.00 :). It's a very basic but powerful trick.

About the Plot():

- Plot(x,y) is NOT accelerated
- Plot(x,y, color) is accelerated

The accelerated one is fast, but a direct memory access can be much faster if well used (especially you save a CALL and a MULIPLITY which is much overhead for 800*600 = 480000 plots...

Posted: Mon Apr 28, 2003 5:46 pm
by THCM
This was the reason you implemented it, Fred! I did a realtime Mandelbrot-Zoomer which is a lot! faster than the earlier plot version!

Also your Fire-Routines can be a lot faster! I did a similar routine for a 40k Intro (Neoplasia) on Amiga with a few optimisations! Perhaps i do a little conversion and post the result here!

Posted: Mon Apr 28, 2003 6:01 pm
by Fred
haaa, I remember now, you was the guy which asked the direct buffer access. Nice mandelbrot BTW :)

Posted: Mon Apr 28, 2003 6:04 pm
by cederavic
With the result that my code is fast, it is that I do not use Point(), that I find very slow, but I puts all the data in a table and it is very fast ;)

The code of Fire Circle :

Code: Select all


InitSprite() 
InitKeyboard()

OpenScreen(320, 200, 16, "Demo")

Dim Screen(320, 201)
Dim pal(254)

UsePNGImageDecoder()
LoadImage(0, "Media/pal1.png")
StartDrawing(ImageOutput())
  For x = 0 To 254
    pal(x) = Point(x, 0)
  Next
StopDrawing()

Dim costab(51, 880)
Dim sintab(51, 880)

For ht = 10 To 51
  For t = 0 To 880
    costab(ht, t) = ht * Cos(t) 
    sintab(ht, t) = ht * Sin(t)
  Next
Next

tkx  = 55
tky  = 55
ht   = 10
tks  = 0
tks2 = 0
tkh  = 0
Repeat
  ExamineKeyboard()
  
  StartDrawing(ScreenOutput())
  
  If tks  = 0 : tkx + 3 : EndIf
  If tks  = 1 : tkx - 3 : EndIf
  If tks2 = 0 : tky + 3 : EndIf
  If tks2 = 1 : tky - 3 : EndIf
  If tkh  = 0 : ht  + 1 : EndIf
  If tkh  = 1 : ht  - 1 : EndIf

  If tkx < ht + 3 : tkx = ht + 3 : tks  = 0 : EndIf
  If tkx > 320 - ht - 3 : tkx = 320 - ht - 3 : tks  = 1 : EndIf
  If tky < ht + 3 : tky = ht  + 3 : tks2 = 0 : EndIf
  If tky > 200 - ht - 3 : tky = 200 - ht - 3 : tks2 = 1 : EndIf
  If ht  < 10  : ht  = 10  : tkh  = 0 : EndIf
  If ht  > 51  : ht  = 51  : tkh  = 1 : EndIf
  
  
  For t = 0 To 880
    Screen(costab(ht, t) + tkx, sintab(ht, t) + tky) = Random(255) + 200
  Next
  
  For x = 2 To 318
    If KeyboardPushed(#PB_Key_Space)
      Screen(x, 200) = Random(255) + 200
    EndIf
    For y = 0 To 199
      
      c1 = Screen(x, y + 1)
      c2 = Screen(x, y + 2)
      c3 = Screen(x + 1, y)
      c4 = Screen(x - 1, y)
      c = (c1 + c2 + c3 + c4) / 4-1
      If c < 0 : c = 0 : EndIf
      If c > 253 : c = 253 : EndIf
      Screen(x, y) = c   
      Plot(x, y, pal(c))
    Next   
  Next

  StopDrawing()
  FlipBuffers()
  ClearScreen(2, 0, 0)
Until KeyboardPushed(#PB_Key_Escape)
Have fun, Cederavic

Posted: Mon Apr 28, 2003 6:07 pm
by THCM
It can be done faster.... i'll give it a try.... so wait.....

Posted: Mon Apr 28, 2003 6:11 pm
by cederavic
:wink:
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited