PureBasic
https://www.purebasic.fr/french/

Flammes pour pas chers
https://www.purebasic.fr/french/viewtopic.php?f=2&t=17281
Page 1 sur 1

Auteur:  Fig [ Mar 15/Mai/2018 21:25 ]
Sujet du message:  Flammes pour pas chers

Image

Code:
#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)

Auteur:  falsam [ Mar 15/Mai/2018 22:25 ]
Sujet du message:  Re: Flammes pour pas chers

Pas vu voir le résultat

■ X64 : IMA sur le commentaire ligne 1 :mrgreen:
Citation:
[23 :22 :40] Attente du démarrage du programme...
[23 :22 :40] Type d'exécutable: Windows - x64 (64bit, Unicode)
[23 :22 :40] Exécutable démarré.
[23 :22 :40] [ERREUR] Ligne: 1
[23 :22 :40] [ERREUR] Accès mémoire invalide. (erreur de lecture à l'adresse 4294967264)

■ X86 : Un hors limite
Citation:
[23 :22 :58] Attente du démarrage du programme...
[23 :22 :58] Type d'exécutable: Windows - x86 (32bit, Unicode)
[23 :22 :58] Exécutable démarré.
[23 :23 :00] [ERREUR] Ligne: 84
[23 :23 :00] [ERREUR] Index de tableau hors limites.
[23 :23 :07] Le programme a été arrêté.

Auteur:  Fig [ Mar 15/Mai/2018 22:32 ]
Sujet du message:  Re: Flammes pour pas chers

Je ne peux pas corriger pour le moment. (Pas d'ordinateur je réponds avec le téléphone). Je n'ai pas dû voir l'erreur sûrement car je le lance sans le debugger activé. Je corrigerai demain.

Ps: Je vois un truc pas catholique dans le code mais je ne comprends pas pourquoi ça fonctionnait chez moi :roll:
À demain, merci. :D

Edit: Corrigé. A vérifier sur PBx64, fonctionne sur X86. Bonne journée à tous. :D

Auteur:  Micoute [ Mer 16/Mai/2018 6:47 ]
Sujet du message:  Re: Flammes pour pas chers

ça fonctionne très bien chez moi, mais ça ressemble plus à de la fumée.

Auteur:  Kwai chang caine [ Mer 16/Mai/2018 9:53 ]
Sujet du message:  Re: Flammes pour pas chers

Marche aussi pour moi W7 X86
C'est vrai que pour des flemmes c'est un peu blanc, un peu mou et un peu vague
En tout cas merci 8)

Auteur:  falsam [ Mer 16/Mai/2018 10:09 ]
Sujet du message:  Re: Flammes pour pas chers

PB 5.62 X64 - Toujours la meme erreur ligne 1.

PB 5.62 X86 - Plus de bug. Par contre dire que c'est des flammes ....... heureusement que tu le dis. Mais c'est joli :)

Auteur:  comtois [ Mer 16/Mai/2018 11:30 ]
Sujet du message:  Re: Flammes pour pas chers

falsam a écrit:
Par contre dire que c'est des flammes ....... heureusement que tu le dis. Mais c'est joli :)


Remplace
Code:
Plot(i,j,RGB(Buffer(i,j+Buf1),Buffer(i,j+Buf1),Buffer(i,j+Buf1)))

par
Code:
Plot(i,j,RGB(Buffer(i,j+Buf1),0,0))


ça chauffe un peu mieux

Auteur:  Kwai chang caine [ Mer 16/Mai/2018 13:22 ]
Sujet du message:  Re: Flammes pour pas chers

Ah ouaih !!!
On s'les pele un peu moins :mrgreen:
Merci comtois 8)

Auteur:  Fig [ Mer 16/Mai/2018 18:09 ]
Sujet du message:  Re: Flammes pour pas chers

Falsam a écrit:
Par contre dire que c'est des flammes ....... heureusement que tu le dis. Mais c'est joli


J'ai fait une mise à jour de couleur pour les puristes... Oui, on est encore loin de la vraie flambée, je l'admet...


Concernant le bug x64, il semble que ce soit interne à PB. (dim static dans une procedure). (cf forum anglais http://www.purebasic.fr/english/viewtop ... 16&t=70707 )
Ça aura au moins servi à isoler ça.

Edit: bug corrigé en inversant les déclarations des tableaux statiques.
Ajout de la possibilité d'écrire en lettre de feu...

Auteur:  venom [ Jeu 17/Mai/2018 20:41 ]
Sujet du message:  Re: Flammes pour pas chers

Bravo Fig,

Joli résultat en 170 lignes 8)






@++

Auteur:  threedslider [ Mar 03/Juil/2018 22:32 ]
Sujet du message:  Re: Flammes pour pas chers

trop bien en peu de programmation c'est du bon resultat

merci pour ton partage :)

Page 1 sur 1 Heures au format UTC + 1 heure
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/