# PureBasic Forum

 It is currently Wed Jan 20, 2021 8:52 pm

 All times are UTC + 1 hour

 Page 1 of 1 [ 8 posts ]
 Print view Previous topic | Next topic
Author Message
 Post subject: Demo - FireworksPosted: Sat Jan 05, 2019 9:44 am
 Enthusiast

Joined: Thu Jul 09, 2015 9:07 am
Posts: 128

hello to the team,

to celebrate the long-awaited arrival of the 5.70 I made you a little fireworks display
it shows the new functions for particles (ParticleScaleRate and ParticleAngle) and CreateDataMesh
Here you go, here you go.
Code:
; feu d'artifice - pf shadoko 2018 (PB 5.70)

EnableExplicit

Structure Vector3
x.f
y.f
z.f
EndStructure

Structure PB_MeshVertexV
p.vector3
n.vector3
t.vector3
u.f
v.f
color.l
EndStructure

Procedure.f POM(v.f)
ProcedureReturn (Random(v*1000)-v*500)/500
EndProcedure

p\x=p1\x+p2\x
p\y=p1\y+p2\y
p\z=p1\z+p2\z
EndMacro

Procedure interpol3D(*R.Vector3, *V1.Vector3, *V2.Vector3, r.f)
*R\x = *V1\x + r * (*V2\x - *V1\x)
*R\y = *V1\y + r * (*V2\y - *V1\y)
*R\z = *V1\z + r * (*V2\z - *V1\z)
EndProcedure

Procedure.f lng3D(*v.Vector3)
ProcedureReturn Sqr(*V\x * *V\x + *V\y * *V\y + *V\z * *V\z)
EndProcedure

Procedure Norme3D(*V.Vector3,l.f=1)
Protected.f lm
lm = l / lng3d(*v)
*V\x * lm
*V\y * lm
*V\z * lm
EndProcedure

Macro vec3d(v,vx,vy,vz)
v\x=vx
v\y=vy
v\z=vz
EndMacro

;============================================================================================================

Structure sfusee
p.vector3
v.vector3
a.vector3
mat.i
EndStructure

#nbfusee=15     ; nombre de fusée
#exp0=100       ; étapes de l'explosion (en 1/60 s)
#exp1=5
#exp2=10
#exp3=120

Global Dim f.sfusee(#nbfusee)

Procedure matiereparticule(num0,nb,dx,dy,nbp,l,rep.f,rlum.f,blendingmode=#PB_Material_AlphaBlend)
Define.f a,r
a=Random(6283)/1000
r=Pow(Random(100000)/100000,p)*rmax
x=Cos(a)*r
y=Sin(a)*r
EndMacro

Structure spt:x.l:y.l:numi.l:EndStructure
Protected.l i,j,ii.f,jj.f,c,num,lum,rx,ry
Protected Dim p.spt(nbp)

For i=0 To nbp
p(i)\x=dx/2+rx
p(i)\y=dy/2+ry
p(i)\numi=Random(nb-1)
Next
For j=0 To nb-1
num=num0+j
CreateTexture(num,dx,dy)
StartDrawing(TextureOutput(num))
DrawingMode(#PB_2DDrawing_AlphaBlend)
Select 1
Case 1
For i=0 To nbp
lum=(255-((j+p(i)\numi) % nb)*255/nb)*rlum
LineXY(p(i)\x-l*2,p(i)\y,p(i)\x+l*2,p(i)\y,\$01010101*lum)
LineXY(p(i)\x,p(i)\y-l*2,p(i)\x,p(i)\y+l*2,\$01010101*lum)
Next
EndSelect
StopDrawing()
CreateMaterial(num, TextureID(num))
DisableMaterialLighting(num, 1)
SetMaterialAttribute(num,#PB_Material_TAM,#PB_Material_ClampTAM)
MaterialBlendingMode(num, blendingmode)
Next
EndProcedure

Procedure PBrelief()
Protected i,j,dx,dy,c,h.f

CreateImage(0,256,128,32)
StartDrawing(ImageOutput(0))
Box(1,1,256-2,128-2,\$ff0000ff)
For i=0 To 20000:Plot(Random(253)+1,Random(125)+1,\$ff0000fc):Next
DrawingMode(#PB_2DDrawing_Outlined )
Box(4,4,256-8,128-8,\$ff0000dd)
DrawingMode(#PB_2DDrawing_AlphaBlend)
DrawingFont(FontID(0))
#n=1
For j=-#n To #n
For i=-#n To #n
DrawText(16+i,14+j,"Pure Basic",\$44000088,0)
DrawText(90+i,70+j,"5.70",\$44000088,0)
Next
Next
DrawingMode(#PB_2DDrawing_AllChannels)
dx=ImageWidth(0)-1
dy=ImageHeight(0)-1
Dim t.PB_MeshVertexV(dx,dy)
For j=0 To dy
For i=0 To dx
c=Point(i,j)
With t(i,j)
vec3d(\p,-(i-dx/2)/4,-(j-dy)/4,20-Red(c)/128)
\u=i/32
\v=j/32
\color=c
EndWith
Next
Next
StopDrawing()

CreateMaterial(2, TextureID(2))
SetMaterialColor(2,#PB_Material_SpecularColor,\$ffffff)
MaterialShininess(2,\$80)
CreateDataMesh(2,t())
NormalizeMesh(2)
CreateEntity(2,MeshID(2),MaterialID(2))
EndProcedure

Procedure init()
Protected ex,ey,i
ExamineDesktops()
ex=DesktopWidth(0)
ey=DesktopHeight(0)
InitEngine3D():InitSprite():InitKeyboard():InitMouse()
;OpenWindow(0, 0, 0, ex,ey, "",#PB_Window_Maximize|#PB_Window_BorderLess):OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)
OpenScreen(ex,ey,32,"")

Parse3DScripts()

CreateCamera(0, 0, 0, 100, 100)
MoveCamera(0,0,2,-50)
CameraLookAt(0,0,20,0)
CameraBackColor(0,\$220000)
AmbientColor(\$0)

For i=0 To #nbfusee
CreateParticleEmitter(i, 0,0,0, 0,0,-1000,0)
CreateLight(i,\$ffffff):LightAttenuation(i,0,0)
SetLightColor(i, #PB_Light_SpecularColor, \$ffffff)
Next

CreateMaterial(1, TextureID(1))

PBrelief()
CreatePlane(1,256,256,100,100,32,32)
CreateEntity(1,MeshID(1),MaterialID(1))
EndProcedure

Procedure fusee(n,cpt)
Protected dec,c,col

With f(n)
dec=n*(#exp0+#exp1+#exp2+#exp3)/(#nbfusee+1)
c=(cpt+dec):If c<0: ProcedureReturn:EndIf
c % (#exp0+#exp1+#exp2+#exp3)
Select c
Case 1                    ;------------------ l'emetteur affiche le panache de la fusée
vec3d(\p,pom(20),0,0)
vec3d(\v,pom(0.2),0.8+pom(0.2),pom(0.1))
vec3d(\a,0,-0.006,0)
\mat=10
ParticleSize(n, 0.5,0.5)
ParticleColorRange(n, \$888888, \$888888)
ParticleTimeToLive  (n, 0.2,0.2)
ParticleVelocity(n, 2,0)
ParticleScaleRate(n,8)
ParticleAngle(n,-180,180)
ParticleEmissionRate(n, 120)
LightAttenuation(n,50,1)
SetLightColor(n,#PB_Light_DiffuseColor,\$ffffff)
SetLightColor(n,#PB_Light_SpecularColor,\$ffffff)
Case #exp0                ;------------------ l'emetteur stop
ParticleEmissionRate(n, 0)
Case #exp0+#exp1          ;------------------ l'emmission de particule commence
\mat=Random(5,2)*10
ParticleSize(n, 0.2,0.2)
col=Random(\$ffffff):ParticleColorRange(n, col, col)
ParticleEmitterAngle(n,180)
ParticleTimeToLive  (n, 1,1.5)
ParticleAcceleration(n, 0, -0.05, 0)
ParticleVelocity(n, 2,10)
ParticleScaleRate(n,2)
ParticleAngle(n,-180,180,-90,90)
ParticleEmissionRate(n, 8000)
LightAttenuation(n,100,1)
SetLightColor(n,#PB_Light_DiffuseColor,col)
SetLightColor(n,#PB_Light_SpecularColor,col)
Case #exp0+#exp1+#exp2    ;------------------ l'emmission de particule stop, elles resteront 1.5 s (cf ParticleTimeToLive)
LightAttenuation(n,0,1)
ParticleEmissionRate(n, 0)
EndSelect

If \mat
If c< #exp0
MoveParticleEmitter(n, \p\x+pom(0.1),\p\y,\p\z+pom(0.1),#PB_Absolute)
MoveLight(n,\p\x,\p\y,\p\z,#PB_Absolute)
EndIf
ParticleMaterial(n, MaterialID(\mat+(c>>2) % 8))
EndWith
EndIf
EndProcedure

Procedure rendu()
Protected.l i,cpt=0,col
Protected.f keyx,keyz,MouseX,Mousey
Repeat
cpt+1
ExamineMouse()
ExamineKeyboard()
For i=0 To #nbfusee:fusee(i,cpt):Next
MouseX = -MouseDeltaX() *  0.05
MouseY = -MouseDeltaY() *  0.05
keyx=(-Bool(KeyboardPushed(#PB_Key_Left)<>0)+Bool(KeyboardPushed(#PB_Key_Right)<>0))*0.1
keyz=(-Bool(KeyboardPushed(#PB_Key_Down)<>0)+Bool(KeyboardPushed(#PB_Key_Up   )<>0))*0.1+MouseWheel()*2
RotateCamera(0, MouseY, MouseX, 0, #PB_Relative):MoveCamera  (0, keyx, 0, -keyz,#PB_Local ):MoveCamera(0,CameraX(0), 2,CameraZ(0),#PB_Absolute )

RenderWorld()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) Or KeyboardReleased(#PB_Key_Escape)
EndProcedure

init()
rendu()

Top

 Post subject: Re: Demo - FireworksPosted: Sat Jan 05, 2019 11:01 am

Joined: Fri Nov 09, 2012 11:04 pm
Posts: 1807
Location: Uttoxeter, UK
You code some lovely graphics.
Thank you for sharing.

_________________
DE AA EB

Top

 Post subject: Re: Demo - FireworksPosted: Sat Jan 05, 2019 1:24 pm

Joined: Sat Feb 13, 2010 3:45 pm
Posts: 1145
Nice effect

_________________

Top

 Post subject: Re: Demo - FireworksPosted: Sat Jan 05, 2019 1:45 pm

Joined: Wed Jun 11, 2003 9:33 pm
Posts: 4655
Location: Spa, relaxing and thinking, and learning...
Good one!

_________________
http://www.zeitgeistmovie.com

Top

 Post subject: Re: Demo - FireworksPosted: Thu Apr 18, 2019 2:34 pm
 Moderator

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 1113
Location: Gernsbach (Germany)
Nice effect, thumbs up.

_________________

Top

 Post subject: Re: Demo - FireworksPosted: Sat Sep 28, 2019 4:30 pm
 User

Joined: Mon Feb 23, 2009 4:01 pm
Posts: 98
Location: Poland
It is work

_________________
My game

Top

 Post subject: Re: Demo - FireworksPosted: Sat Sep 28, 2019 5:57 pm
 Enthusiast

Joined: Mon Jul 09, 2007 4:47 pm
Posts: 228
Location: Courthouse
Very impressive

Top

 Post subject: Re: Demo - FireworksPosted: Sun Sep 29, 2019 9:15 pm

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4841
Location: Lyon - France
Like usually ......

_________________
Not a destination

Top

 Display posts from previous: All posts1 day7 days2 weeks1 month3 months6 months1 year Sort by AuthorPost timeSubject AscendingDescending
 Page 1 of 1 [ 8 posts ]

 All times are UTC + 1 hour

#### Who is online

Users browsing this forum: No registered users and 3 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