PureBasic

Forums PureBasic
Nous sommes le Lun 20/Aoû/2018 9:46

Heures au format UTC + 1 heure




Poster un nouveau sujet Répondre au sujet  [ 11 messages ] 
Auteur Message
 Sujet du message: Flammes pour pas chers
MessagePosté: Mar 15/Mai/2018 21:25 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 14/Oct/2004 19:48
Messages: 1092
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)

_________________
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 5.45LTS - 32 bits


Dernière édition par Fig le Ven 18/Mai/2018 17:40, édité 11 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Flammes pour pas chers
MessagePosté: Mar 15/Mai/2018 22:25 
En ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6668
Localisation: IDF (Yvelines)
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é.

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.45 LTS & PB 5.62
➽ Je papote aussi sur http://purebasic.chat & http://purebasic.chat/forum

➽ Restez informé Image Pure Basic Francophone Community

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne réponds pas aux MP


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Flammes pour pas chers
MessagePosté: Mar 15/Mai/2018 22:32 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 14/Oct/2004 19:48
Messages: 1092
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

_________________
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 5.45LTS - 32 bits


Dernière édition par Fig le Jeu 17/Mai/2018 19:47, édité 1 fois.

Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Flammes pour pas chers
MessagePosté: Mer 16/Mai/2018 6:47 
Hors ligne
Avatar de l’utilisateur

Inscription: Dim 02/Oct/2011 16:17
Messages: 1970
Localisation: 50200 Coutances
ça fonctionne très bien chez moi, mais ça ressemble plus à de la fumée.

_________________
Microsoft Windows 10 Famille 64 bits : Carte mère : ASRock 970 Extreme3 R2.0 : Carte Graphique NVIDIA GeForce GT 640 : Processeur AMD FX 6300 6 cœurs 12 threads 3,50 GHz PB 5.62, 5.70 LTS
Un homme doit être poli, mais il doit aussi être libre !


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Flammes pour pas chers
MessagePosté: Mer 16/Mai/2018 9:53 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6536
Localisation: Isere
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)

_________________
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Flammes pour pas chers
MessagePosté: Mer 16/Mai/2018 10:09 
En ligne
Avatar de l’utilisateur

Inscription: Dim 22/Aoû/2010 15:24
Messages: 6668
Localisation: IDF (Yvelines)
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 :)

_________________

➽ Config PureBasic : i3, RAM 4Go, NVidia (1024 Mo), Windows 10 - PB 5.45 LTS & PB 5.62
➽ Je papote aussi sur http://purebasic.chat & http://purebasic.chat/forum

➽ Restez informé Image Pure Basic Francophone Community

➽ Sites personnels http://falsam.com & EasySprite.js

➽ Je ne réponds pas aux MP


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Flammes pour pas chers
MessagePosté: Mer 16/Mai/2018 11:30 
Hors ligne

Inscription: Mer 21/Jan/2004 17:48
Messages: 5144
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

_________________
http://purebasic.developpez.com/
Je ne réponds à aucune question technique en PV, utilisez le forum, il est fait pour ça, et la réponse peut profiter à tous.


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Flammes pour pas chers
MessagePosté: Mer 16/Mai/2018 13:22 
Hors ligne
Avatar de l’utilisateur

Inscription: Sam 23/Sep/2006 18:32
Messages: 6536
Localisation: Isere
Ah ouaih !!!
On s'les pele un peu moins :mrgreen:
Merci comtois 8)

_________________
ImageLe bonheur est une route...
Pas une destination

PureBasic Forum Officiel - Site PureBasic


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Flammes pour pas chers
MessagePosté: Mer 16/Mai/2018 18:09 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 14/Oct/2004 19:48
Messages: 1092
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...

_________________
Il y a deux méthodes pour écrire des programmes sans erreurs. Mais il n’y a que la troisième qui marche.
Version de PB : 5.45LTS - 32 bits


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Flammes pour pas chers
MessagePosté: Jeu 17/Mai/2018 20:41 
Hors ligne
Avatar de l’utilisateur

Inscription: Jeu 29/Juil/2004 16:33
Messages: 2664
Localisation: . <------ ici
Bravo Fig,

Joli résultat en 170 lignes 8)






@++

_________________
Windows 10 x64, PureBasic 5.61 Beta 1 x86 & x64


Haut
 Profil  
Répondre en citant le message  
 Sujet du message: Re: Flammes pour pas chers
MessagePosté: Mar 03/Juil/2018 22:32 
Hors ligne

Inscription: Dim 01/Juil/2018 22:38
Messages: 6
trop bien en peu de programmation c'est du bon resultat

merci pour ton partage :)


Haut
 Profil  
Répondre en citant le message  
Afficher les messages postés depuis:  Trier par  
Poster un nouveau sujet Répondre au sujet  [ 11 messages ] 

Heures au format UTC + 1 heure


Qui est en ligne

Utilisateurs parcourant ce forum: Aucun utilisateur enregistré et 1 invité


Vous ne pouvez pas poster de nouveaux sujets
Vous ne pouvez pas répondre aux sujets
Vous ne pouvez pas éditer vos messages
Vous ne pouvez pas supprimer vos messages

Rechercher:
Aller à:  

 


Powered by phpBB © 2008 phpBB Group | Traduction par: phpBB-fr.com
subSilver+ theme by Canver Software, sponsor Sanal Modifiye