PureBasic

Code : Tout sélectionner

#X=600:#Y=400:#mouse=0:#Res=55.0
;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=#Res,Reinit.i=0)
    #unit = 0.7071067811865475244 ;=1.0/Sqr(2)
    Static Dim perm.l(511)
    Static Dim gradient2.f(7,1)
    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
        gradient2(0,0)= #unit:gradient2(0,1)= #unit
        gradient2(1,0)=-#unit:gradient2(1,1)= #unit
        gradient2(2,0)= #unit:gradient2(2,1)=-#unit
        gradient2(3,0)=-#unit:gradient2(3,1)=-#unit
        gradient2(4,0)= 1:   gradient2(4,1)= 0
        gradient2(5,0)=-1:   gradient2(5,1)= 0
        gradient2(6,0)= 0:   gradient2(6,1)= 1
        gradient2(7,0)= 0:   gradient2(7,1)=-1
        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
    s     = gradient2(gi0,0)*tempX + gradient2(gi0,1)*tempY    
    tempX   = x-(x0+1)
    tempY   = y-y0
    t     = gradient2(gi1,0)*tempX + gradient2(gi1,1)*tempY
    tempX   = x-x0
    tempY   = y-(y0+1)
    u     = gradient2(gi2,0)*tempX + gradient2(gi2,1)*tempY
    tempX   = x-(x0+1)
    tempY   = y-(y0+1)
    v     = gradient2(gi3,0)*tempX + gradient2(gi3,1)*tempY    
    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

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*2)
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 colors
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))/4
            Buffer(i,j-1)-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)

Code : Tout sélectionner

Plot(i,j,RGB(Buffer(i,j+Buf1),Buffer(i,j+Buf1),Buffer(i,j+Buf1)))

Code : Tout sélectionner

Plot(i,j,RGB(Buffer(i,j+Buf1),0,0))