PureBasic

Forums PureBasic - Français
https://www.purebasic.fr/french/

Physique des Fluides ......

https://www.purebasic.fr/french/viewtopic.php?t=7249

Page 1 sur 6

Physique des Fluides ......

Publié : ven. 28/sept./2007 13:59
par Mytic
J’étais entrain d’améliorer le moteur de Route, et je suis vite passer à l’Eau. :lol:
Voici un moteur qui gère la physique du liquide (le minimum).
Dessinez sur l’écran les obstacles avec le bouton gauche de la souris.
Et avec le bouton droit vous injecter l’eau.
Espace pour changer le mode de dessin en gomme et vis versa.
Appuyez sur la touche ENTRER pour générer un labyrinthe.
Echape (à vous de deviner)

:D

Image

Code : Tout sélectionner

;-------------
;-By Mytic ---
;-------------
;------------------(Physique des fluides 6.5)

InitSprite()
;InitScreen() ;----(Inutile pour les nouvelles versions )
InitMouse()
InitKeyboard()

Structure info
x.l
y.l
acc.D
coul.l
activ.l
mov.l
ina.l
EndStructure

;Global FPS()
Global Dim goute.info(9999)
Global Dim Bgoute.info(9999)
Global maxg.l = -1
Global limg.l = 9999
Global G.D = 0.1,maxacc.d = 4
Global pa.l = 255
Global activ.l = 0

Procedure.s FPS()
Static newtime.d,bactime.d,fp.l,rfp.s
newtime = ElapsedMilliseconds()
If newtime - bactime => 1000
rfp = Str(fp)
fp = 0
bactime = newtime
Else
fp = fp + 1
EndIf
ProcedureReturn rfp
EndProcedure

Procedure mega_Point(x,Y)   
UseBuffer(0) 
    color= PeekW(DrawingBuffer() + (x * 2) +DrawingBufferPitch()* ( Y )  )
UseBuffer(-1)
    ProcedureReturn color
EndProcedure



Procedure mega_Plot(x,Y,Couleur)
UseBuffer(0)
    PokeW( DrawingBuffer()  + (x * 2) +DrawingBufferPitch()* ( Y ) , Couleur )
UseBuffer(-1)
EndProcedure 

Procedure mega_BOX(x,Y,w.l,h.l,Couleur)
UseBuffer(-1)
For ny = y To y+h-2
For nx = x To x+w-2
    PokeW( DrawingBuffer()  + (nx * 2) +DrawingBufferPitch()* ( nY ) , Couleur )
Next nx
Next ny

EndProcedure 

Procedure labi(maxlX.l,minlY.l,grosso.l,couleur.l)
#taille = 13
For y = 1 To minlY-1 Step #taille
For x = 1 To maxlX-1 Step #taille
ax = Random(1)
If ax <> 0
For i = 0 To grosso
LineXY(x,y+i,x+#taille,y+i,couleur)
Next i

EndIf
Next x
Next y
For x = 1 To maxlX-1 Step #taille
For y = 1 To minlY-1 Step #taille
ay = Random(1)
If ay <> 0
For i = 0 To grosso
LineXY(x+i,y,x+i,y+#taille,couleur)
Next i
EndIf
Next y
Next x
EndProcedure


Procedure init_goute()
For i = 0 To limg
goute(i)\x = 1
goute(i)\y = 1
goute(i)\activ = 0
vv = Random(150)
goute(i)\coul = RGB(vv,vv,220 + Random(30))
Next i
EndProcedure

Procedure nouvel_goute(x.l,y.l)
For i = 0 To maxg
If goute(i)\activ = 0
goute(i)\acc = 1
goute(i)\x = x
goute(i)\y = y
goute(i)\activ = 1
vv = Random(150)
goute(i)\coul = RGB(vv,vv,220 + Random(30))
ProcedureReturn 1
EndIf
Next i
If maxg <= limg
maxg = maxg + 1
goute(maxg)\acc = 1
goute(maxg)\x = x
goute(maxg)\y = y
goute(maxg)\activ = 1
vv = Random(150)
goute(maxg)\coul = RGB(vv,vv,220 + Random(30))
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure

Procedure gravite_collision()
activ = 0
StartDrawing(SpriteOutput(0))
For i = 0 To maxg
If goute(i)\activ = 1
activ+1
;=================(effet bulles de savon)
;If mega_Point(goute(i)\x,goute(i)\y)<> 0  
;goute(i)\y-1
;EndIf
If mega_Point(goute(i)\x,goute(i)\y+goute(i)\acc) = 0
goute(i)\y+goute(i)\acc
If goute(i)\acc < maxacc
goute(i)\acc+G
EndIf
;goute(i)\ina-1
Else
goute(i)\acc=1
p = Random(1)
If p = 1
If mega_Point(goute(i)\x+1,goute(i)\y)= 0
goute(i)\x+1
Else
If mega_Point(goute(i)\x-1,goute(i)\y)= 0 :goute(i)\x-1:EndIf
EndIf
Else
If mega_Point(goute(i)\x-1,goute(i)\y)= 0
goute(i)\x-1
Else
If mega_Point(goute(i)\x+1,goute(i)\y)= 0 :goute(i)\x+1:EndIf
EndIf
EndIf


If mega_Point(goute(i)\x,goute(i)\y+1)<> 0 And  mega_Point(goute(i)\x,goute(i)\y-1)= 0
If mega_Point(goute(i)\x-1,goute(i)\y+1)<> 0 And mega_Point(goute(i)\x+1,goute(i)\y+1)<> 0
goute(i)\y-1
;goute(i)\y-goute(i)\acc
EndIf
EndIf

EndIf

If (goute(i)\x > 10) And (goute(i)\x < 630) And (goute(i)\y > 10) And (goute(i)\y < 470)
vv = Random(150)
goute(i)\coul = RGB(vv,vv,220 + Random(30))
mega_Plot(Bgoute(i)\x,Bgoute(i)\y,0)
mega_Plot(goute(i)\x,goute(i)\y,goute(i)\coul)
Bgoute(i)\x = goute(i)\x
Bgoute(i)\y = goute(i)\y
Else
activ-1
mega_Plot(Bgoute(i)\x,Bgoute(i)\y,0)
goute(i)\activ = 0
EndIf

EndIf
Next i

DrawText(10,10,"Gouttes actives : " + Str(activ)+"#" + FPS() + "#" ,53289)
StopDrawing()

EndProcedure


Procedure type_goute()
StartDrawing(ScreenOutput())
For i = 0 To maxg
If goute(i)\activ = 1
;Box(Bgoute(i)\x,Bgoute(i)\y,2,2,0)
Box(goute(i)\x,goute(i)\y,2,2+goute(i)\acc/maxacc+1,goute(i)\coul)
;mega_BOX(goute(i)\x,goute(i)\y,2,2+goute(i)\acc/maxacc+1,goute(i)\coul)
EndIf
Next i
StopDrawing()
EndProcedure
;OpenWindow(0,0,0,500,500,"test")
;OpenWindowedScreen(WindowID(0),0,0,500,500,0,0,0)
OpenScreen(640,480,16,"Eau")
CreateSprite(0,500,500)
CreateSprite(1,10,10)
StartDrawing(SpriteOutput(1))
LineXY(0,5,10,5,RGB(0,255,0))
LineXY(5,0,5,10,RGB(0,255,0))
StopDrawing()
FlipBuffers()


init_goute()
Repeat
ClearScreen(0)
ExamineKeyboard()
ExamineMouse()

If KeyboardReleased(#PB_Key_Return)
UseBuffer(0)
ClearScreen(0)
StartDrawing(SpriteOutput(0))
labi(640,480,3,255)
StopDrawing()
UseBuffer(-1)
EndIf

If KeyboardPushed(#PB_Key_Escape)
End
EndIf
If KeyboardReleased(#PB_Key_Space)
If pa = 0
pa = 255
Else
pa = 0
EndIf
EndIf
x = MouseX()
y = MouseY()
If MouseButton(#PB_MouseButton_Left)
StartDrawing(SpriteOutput(0))
Circle(x,y,3,pa)
;mega_Plot(x,y,255)
StopDrawing()
EndIf

If MouseButton(#PB_MouseButton_Right)
nouvel_goute(x,y)
EndIf

DisplaySprite(0,0,0)
DisplayTransparentSprite(1,x-5,y-5)
gravite_collision()
type_goute()
;event = WindowEvent()
Delay(1)
FlipBuffers()
ForEver
End

Publié : ven. 28/sept./2007 14:04
par Mytic
Image
:D

Publié : ven. 28/sept./2007 14:21
par Mytic
Image

Publié : ven. 28/sept./2007 14:26
par wolfjeremy
Marche pas chez moi, mais ça à l'air pas mal.

Initscreen() ça n'existe pas chez moi dans PB, bizar 8O (version beta 3 de 4.10)

Publié : ven. 28/sept./2007 14:32
par Mytic
Tu peu la supprimé elle ne sert à rien, c’est qu’un réflex chez moi :lol:

Publié : ven. 28/sept./2007 15:18
par Mytic
Je sais bien que le Code peu encore être amélioré, et c’est ce que je suis entrain de faire…
La nouvelle version sera postée le soir si tout ce passe bien
:!:

Publié : ven. 28/sept./2007 18:32
par Backup
Mytic a écrit :Je sais bien que le Code peu encore être amélioré, et c’est ce que je suis entrain de faire…
La nouvelle version sera postée le soir si tout ce passe bien
:!:
chapeau bas, je trouve cela extra !! :D

c'est vraiment fort !! :D bravo grand chef !! :)

Publié : ven. 28/sept./2007 19:17
par Huitbit
@Mytic

Ce qui est fort, c'est la taille de tes codes !
Je savais pas qu'on pouvait faire autant avec si peu de lignes!

BRAVO!

PS:

Code : Tout sélectionner

event = WindowEvent()
doit être supprimé pour que ça marche chez moi (c'est un "reste" de ton écran fenêtré)

Publié : ven. 28/sept./2007 21:49
par Mytic
Merci...
J’ai amélioré le code, et j’ai ajouté un effet de brillance dans l’eau.
:)
J’ai posté le code à la place du premier.

:idea:

Publié : ven. 28/sept./2007 22:03
par Ollivier
C'est du propre !

Par contre, mon petit 1 ghz a un petit peu.

En attendant, félicitations! Tu ne manques pas d'imagination!

Publié : ven. 28/sept./2007 22:21
par Mytic
Un screenshoot du nouveau moteur…
:D
Image

Publié : ven. 28/sept./2007 22:24
par wolfjeremy
Manque plus qu'une gomme mdr

Publié : ven. 28/sept./2007 22:28
par Mytic
@wolfjeremy
Avec Espace tu bascules en mode gomme ou dessin !

Publié : ven. 28/sept./2007 22:35
par wolfjeremy
Ha lol désolé

Publié : ven. 28/sept./2007 23:00
par wolfjeremy
Ma contribution lol :

Image
Fuseau horaire sur UTC+01:00
Page 1 sur 6

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru