# PureBasic Forum

 It is currently Tue Sep 29, 2020 8:56 pm

 All times are UTC + 1 hour

 Page 2 of 2 [ 19 posts ] Go to page Previous  1, 2
 Print view Previous topic | Next topic
Author Message
 Post subject: Re: Cheap Flames effectPosted: Thu May 17, 2018 12:27 pm
 Moderator

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 1112
Location: Gernsbach (Germany)
Looks nice

_________________

Top

 Post subject: Re: Cheap Flames effectPosted: Thu May 17, 2018 4:35 pm
 Enthusiast

Joined: Thu Apr 30, 2009 5:23 pm
Posts: 328
Location: Côtes d'Azur, France
wilbert wrote:
Fig wrote:
Updated code. Add possibility to write in fire ink...

Looking at the code, I don't understand why you need two buffers.
The buffers don't seem to interact with each other

Well, i first use 2 buffers as specified in the tutorial. Then, i reduced the code and arrived to the one above.
Although, i couldn't manage to use only one buffer despite my effort.

Feel free to give it a try if you want.

_________________
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.71 LTS

Top

 Post subject: Re: Cheap Flames effectPosted: Thu May 17, 2018 8:13 pm
 PureBasic Expert

Joined: Sun Aug 08, 2004 5:21 am
Posts: 3673
Location: Netherlands
Fig wrote:
Well, i first use 2 buffers as specified in the tutorial. Then, i reduced the code and arrived to the one above.
Although, i couldn't manage to use only one buffer despite my effort.

Feel free to give it a try if you want.

I don't know how to get the exact same effect.
This comes close but not exactly.
Code:
;Perlin Noise 1D or 2D return a value between -1 and 1
;Reinit=1 => calcul new initial values
DisableDebugger
Procedure.f Noise(x.f,y.f=0.0,resolution.f=60.0,Reinit.i=0)
#unit = 0.7071067811865475244 ;=1.0/Sqr(2)
Static Dim perm.l(511)
Static.l x0,y0,ii,jj,gi0,gi1,gi2,gi3
Static.f tempX,tempY,s,t,u,v,tmp,Li1,Li2,Cx,Cy
If Reinit
For i=0 To 511
perm(i)=i & 255
Next i
RandomizeArray(perm())
ProcedureReturn
EndIf
x       = x/resolution
y       = y/resolution
x0    = Int(x)
y0    = Int(y)
ii    = x0 & 255
jj    = y0 & 255
gi0   = perm(ii +     perm(jj    )) % 8
gi1   = perm(ii + 1 + perm(jj    )) % 8
gi2   = perm(ii +     perm(jj + 1)) % 8
gi3   = perm(ii + 1 + perm(jj + 1)) % 8
tempX = x-x0
tempY = y-y0
tempX   = x-(x0+1)
tempY   = y-y0
tempX   = x-x0
tempY   = y-(y0+1)
tempX   = x-(x0+1)
tempY   = y-(y0+1)
tmp   = x-x0
Cx    = 3 * tmp * tmp - 2 * tmp * tmp * tmp
Li1   = s + Cx*(t-s)
Li2   = u + Cx*(v-u)
tmp     = y - y0;
Cy    = 3 * tmp * tmp - 2 * tmp * tmp * tmp;
ProcedureReturn Li1 + Cy*(Li2-Li1)
EndProcedure

#X=600:#Y=400:#mouse=0
If InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0 Or OpenWindow(0, 0, 0, #X, #Y, "Fire", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)=0 Or OpenWindowedScreen(WindowID(0),0,0,#X,#Y,0,0,0,#PB_Screen_NoSynchronization )=0
MessageRequester("Error", "Can't open the sprite system", 0)
End
EndIf
Dim Buffer.i(#X,#Y)
Dim coolingmap(#x,#y)

;create cooling map
noise(0,0,0,1)
For j=0 To #Y-1
For i=0 To #X-1
coolingmap(i,j)=Int(noise(i,j)+1)
Next i
Next j

;create mouse sprite
CreateSprite(#mouse,16,16)
StartDrawing(SpriteOutput(#mouse))
Box(0,0,16,16,\$FFFFFF)
Box(4,4,8,8,\$0)
StopDrawing()

;{ Fire color
Dim color.l(255)
pR.f=90
pG.f=0
pB.f=12
For i=0 To 80
;90;0;12
r.f=i*pR/80
g.f=pG
b.f=i*pB/80
color(i)=RGB(r,g,b)
Next i
#deb=81
#fin=140
For i=#deb To #fin
j=i-#deb
;255;144;0
r.f=pR+j*(255-pR)/(#fin-#deb)
g.f=pG+j*(144-pG)/(#fin-#deb)
b.f=pB+j*(0-pB)/(#fin-#deb)
color(i)=RGB(r,g,b)
Next i
#deb3=141
#fin3=220
pR=255:pG=144:pB=0
For i=#deb3 To #fin3
j=i-#deb3
;255;187;0
r.f=pR+j*(255-pR)/(#fin3-#deb3)
g.f=pG+j*(187-pG)/(#fin3-#deb3)
b.f=pB+j*(0-pB)/(#fin3-#deb3)
color(i)=RGB(r,g,b)
Next i

#deb4=221
#fin4=255
pR=255:pG=187:pB=0
For i=#deb4 To #fin4
j=i-#deb4
;255;255;211
r.f=pR+j*(255-pR)/(#fin4-#deb4)
g.f=pG+j*(255-pG)/(#fin4-#deb4)
b.f=pB+j*(211-pB)/(#fin4-#deb4)
color(i)=RGB(r,g,b)
Next i
;}

Repeat
While WindowEvent():Wend
FlipBuffers()
ExamineKeyboard()
ExamineMouse()
If MouseButton(#PB_MouseButton_Left)
For i=1 To 14
For j=1 To 14
If MouseX()+i>#X-2 Or MouseY()+j>#Y-2:Continue:EndIf
buffer(MouseX()+i,MouseY()+j)=255
Next j
Next i
EndIf
For i=0 To #X-1
For j=1 To 3
Buffer(i,#Y-j)=255
Next j
Next i

For j=1 To #Y-2
For i=1 To #X-2
Buffer(i,j-1)=(Buffer(i,j-1)+Buffer(i-1,j)+Buffer(i+1,j)+Buffer(i,j+1))>>2-coolingmap(i,(j+scrollY)%#Y)
If buffer(i,j-1)<0:buffer(i,j-1)=0:EndIf
Next i
Next j

StartDrawing(ScreenOutput())
For j=0 To #Y-1
For i=0 To #X-1
Plot(i,j,color(buffer(i,j)))
Next i
Next j
DrawText(0,0,"[Escape] to Quit")
DrawText(0,20,"[Left clic] to start a fire")
StopDrawing()

DisplayTransparentSprite(#mouse,MouseX(),MouseY())

scrollY+2
Until KeyboardPushed(#PB_Key_Escape)

_________________
macOS 10.15 Catalina, Windows 10

Top

 Post subject: Re: Cheap Flames effectPosted: Fri May 18, 2018 5:19 am
 Enthusiast

Joined: Thu Apr 30, 2009 5:23 pm
Posts: 328
Location: Côtes d'Azur, France
Look the same to me, just a faster scrolling. So it's very nice, thank you Wilbert!

_________________
There are 2 methods to program bugless.
But only the third works fine.

Win10, Pb x64 5.71 LTS

Top

 Display posts from previous: All posts1 day7 days2 weeks1 month3 months6 months1 year Sort by AuthorPost timeSubject AscendingDescending
 Page 2 of 2 [ 19 posts ] Go to page Previous  1, 2

 All times are UTC + 1 hour

#### Who is online

Users browsing this forum: No registered users and 4 guests

 You cannot post new topics in this forumYou cannot reply to topics in this forumYou cannot edit your posts in this forumYou cannot delete your posts in this forum

Search for:
 Jump to:  Select a forum ------------------ PureBasic    Coding Questions    Game Programming    3D Programming    Assembly Programming    The PureBasic Editor    The PureBasic Form Designer    General Discussion    Feature Requests and Wishlists    Tricks 'n' Tips Bug Reports    Bugs - Windows    Bugs - Linux    Bugs - Mac OSX    Bugs - IDE    Bugs - Documentation OS Specific    AmigaOS    Linux    Windows    Mac OSX Miscellaneous    Announcement    Off Topic Showcase    Applications - Feedback and Discussion    PureFORM & JaPBe    TailBite