dans la série simulateur mini budget: le hors bord
désactiver le debogueur
Code : Tout sélectionner
; Physics - Speedboat - pf Shadoko - 2020
EnableExplicit
DeclareModule ext_3D
EnableExplicit
Structure f3
x.f
y.f
z.f
EndStructure
Structure f2
x.f
y.f
EndStructure
Structure PB_MeshVertexV
p.f3
n.f3
t.f3
u.f
v.f
color.l
EndStructure
;________________ Lib ________________
Declare vec3d(*v.f3,vx.f,vy.f,vz.f)
Declare sub3D(*p.f3,*p1.f3,*p2.f3)
Declare mul3d(*p1,v.f)
Declare.f lng3D(*v.f3)
Declare norme3d(*v.f3,l.f=1)
Declare.f Max(v1.f,v2.f)
Declare.f Min(v1.f,v2.f)
Declare.f limite(V.f, i.f, s.f)
Declare.i Modi(v,divisor)
Declare.f interpolarray2d(Array tt.f(2),x.f,y.f)
Declare Split(Array t.s(1),l.s,sep.s=",",nmax=100)
Declare ColorBlend(color1.l, color2.l, blend.f)
Declare GradientToArray(Array pal.l(1),n,gradient.s,inv.b=0,alpha.b=0)
Declare heightmap(Array t.w(2),rnd, dx.w, dy.w, Re.w)
Declare texture(tex,dx,dy,rnd=0,f=0,lissage=0,embos=-10,grad.s="0,$000000/1,$ffffff",profil.s="0,0/1,1")
;________________ océan ________________
Declare initocean(tilesize,prec,range,material,particule,waveheight.f,swellheight.f)
Declare freeocean()
Declare renderocean()
Declare.f oceanHeight(x.f,z.f)
Declare oceanset(waveheight.f,swellheight.f)
EndDeclareModule
Module ext_3D
;{ lib
Procedure vec3d(*v.f3,vx.f,vy.f,vz.f)
*v\x=vx
*v\y=vy
*v\z=vz
EndProcedure
Procedure.f lng3D(*v.f3)
ProcedureReturn Sqr(*V\x * *V\x + *V\y * *V\y + *V\z * *V\z)
EndProcedure
Procedure Norme3D(*V.f3,l.f=1)
Protected.f lm
lm = l / lng3D(*v)
*V\x * lm
*V\y * lm
*V\z * lm
EndProcedure
Macro add3d(p,p1,p2)
p\x=p1\x+p2\x
p\y=p1\y+p2\y
p\z=p1\z+p2\z
EndMacro
Procedure sub3D(*p.f3,*p1.f3,*p2.f3)
*p\x=*p1\x-*p2\x
*p\y=*p1\y-*p2\y
*p\z=*p1\z-*p2\z
EndProcedure
Procedure mul3d(*p1.f3,v.f)
*p1\x*(v)
*p1\y*(v)
*p1\z*(v)
EndProcedure
Procedure.f Max(v1.f,v2.f)
If v1>v2:ProcedureReturn v1:Else:ProcedureReturn v2:EndIf
EndProcedure
Procedure.f Min(v1.f,v2.f)
If v1<v2:ProcedureReturn v1:Else:ProcedureReturn v2:EndIf
EndProcedure
Procedure.f limite(V.f, i.f, s.f)
If V < i :v=i:EndIf
If V > s :v=s:EndIf
ProcedureReturn V
EndProcedure
Procedure.i Modi(v,divisor)
ProcedureReturn (V+$10000*divisor) % divisor
EndProcedure
Procedure.f interpolarray2d(Array tt.f(2),x.f,y.f)
Protected.l i0, j0,i1,j1,dx1,dy1, ix=Int(x)-Bool(x<0),iy=Int(y)-Bool(y<0)
Protected.f dx, dy
dx1=ArraySize(tt(),1)
dy1=ArraySize(tt(),2)
i0 = ix & dx1:i1=(i0+1) & dx1: dx = X - ix
j0 = iy & dy1:j1=(j0+1) & dy1: dy = Y - iy
ProcedureReturn (((1 - dx) * tt(j0,i0) + dx * tt(j0,i1)) * (1 - dy) + ((1 - dx) * tt(j1,i0) + dx * tt(j1,i1)) * dy)
EndProcedure
Procedure.f POM(v.f)
ProcedureReturn (Random(2000)-1000)*0.001*v
EndProcedure
Procedure Split(Array t.s(1),l.s,sep.s=",",nmax=100)
Protected ap.l,p.l,n,ls
Dim t(nmax)
ls=Len(sep)
l+sep
p=1-ls
Repeat
ap=p+ls:p=FindString(l,sep,ap)
If p=0:Break:EndIf
n+1
t(n)= Mid(l,ap,p-ap)
ForEver
ReDim t(n)
EndProcedure
Procedure string2vector2(Array s.f2(1),txt.s)
Protected Dim tt.s(0)
Protected Dim t.s(0)
Protected i,n
Split(tt(),txt,"/",100)
n=ArraySize(tt())
Dim s(n-1)
For i=1 To n
Split(t(),tt(i)+",0",",")
With s(i-1)
\x=ValF(t(1))
\y=ValF(t(2))
EndWith
Next
EndProcedure
Procedure CoRBinv(c.l)
ProcedureReturn RGBA(Blue(c),Green(c),Red(c),Alpha(c))
EndProcedure
Procedure ColorBlend(color1.l, color2.l, blend.f)
Protected r.w,g.w,b.w,a.w
r= Red(color1) + (Red(color2) - Red(color1)) * blend
g=Green(color1) + (Green(color2) - Green(color1)) * blend
b= Blue(color1) + (Blue(color2) - Blue(color1)) * blend
a=Alpha(color1) + (Alpha(color2) - Alpha(color1)) * blend
ProcedureReturn RGBA(r,g,b,a)
EndProcedure
Procedure GradientToArray(Array pal.l(1),n,gradient.s,inv.b=0,alpha.b=0)
Protected Dim lt.s(0)
Protected i,j, apos,pos, acol.l,col.l
n-1
Dim pal(n)
Split(lt(),gradient,"/")
Macro lparam(i)
pos=ValF(lt(i))*n
col=Val(Mid(lt(i),FindString(lt(i),",")+1))
If inv :col=CoRBinv(col):EndIf
If alpha:col | $ff000000:EndIf
EndMacro
lparam(1)
For i=2 To ArraySize(lt())
apos=pos
acol=col
lparam(i)
For j=apos To pos:pal(j)=ColorBlend(acol,col,(j-apos)/(pos-apos)):Next
Next
EndProcedure
Procedure Finterpol(Array F.f(1),t.s,rx.f=1,ry.f=1,oy.f=0)
Protected.l i,j,n,c,ac
Protected.f y,dx,dy,p
Protected Dim s.f2(0)
string2vector2(s(),t)
n=ArraySize(s())
For i=0 To n
s(i)\x*rx
s(i)\y*ry+oy
Next
Dim f(Int(s(n)\x))
For j=0 To n-1
y=s(j)\y
dx=s(j+1)\x-s(j)\x
dy=s(j+1)\y-s(j)\y
p=dy/dx
ac=c
While c<=s(j+1)\x
f(c)=y+p*(c-ac):c+1
Wend
Next
EndProcedure
Procedure t2norme(Array t.w(2),dmin.w,dmax.w,profil.s="")
Protected smin.w,smax.w,dx1,dy1,i,j,sr,dr
If profil="":profil="0,0/1,1":EndIf
dy1 = ArraySize(t(), 1)
dx1 = ArraySize(t(), 2)
smax = -32768
smin = 32767
For j=0 To dy1
For i=0 To dx1
If t(j,i)>smax : smax=t(j,i): EndIf
If t(j,i)<smin : smin=t(j,i): EndIf
Next
Next
sr=smax-smin
dr=dmax-dmin
Protected Dim conv.f(sr)
Finterpol(conv(),profil,sr,dr,dmin)
For j=0 To dy1
For i=0 To dx1
t(j,i)=conv(t(j,i)-smin)
Next
Next
EndProcedure
Procedure Tmodulo(Array T(1), max, marge)
Protected i,d=max-marge/2
Dim T(max + 2*marge): For i = 0 To max + 2*marge: T(i) = (i+d) % (max+1): Next
EndProcedure
Procedure Tlimite(Array T(1), max, marge)
Protected i
Dim T(max + 2*marge): For i = 0 To max + 2*marge: T(i) = limite(i-1-marge/2, 0, max): Next
EndProcedure
Procedure lisser2D(Array s.w(2),di.w, dj.w,pass=1,loop=1)
If di=0 And dj=0:ProcedureReturn:EndIf
Protected i,j,k,dii,djj,dx,dy,dij,tx
dx = ArraySize(s(), 2):di=Min(di,dx)
dy = ArraySize(s(), 1):dj=Min(dj,dy)
Dim d.w(dy,dx)
dii=di+1
djj=dj+1
dij = dii * djj
Dim lx(0)
Dim ly(0)
If loop
Tmodulo (lx(), dx, di+1)
Tmodulo (ly(), dy, dj+1)
Else
Tlimite(lx(), dx, di+1)
Tlimite(ly(), dy, dj+1)
EndIf
For k=1 To pass
Dim ty.l(dx)
For j = 0 To djj - 1: For i = 0 To dx: ty(i) + s(ly(j),i): Next: Next
For j = 0 To dy
For i = 0 To dx: ty(i) + s(ly(djj+j),i) - s(ly(j),i): Next
tx=0:For i = 0 To dii-1: tx+ty(lx(i)): Next
For i = 0 To dx: tx + ty(lx(dii+i)) - ty(lx(i) ): d(j,i) = tx / dij: Next
Next
CopyArray(d(),s())
Next
EndProcedure
Procedure Embos(Array d.w(2),Array s.w(2), px.w=0, py.w=0)
Protected i,j,dx,dy
px=1<<Int(Abs(px))*Sign(px)
py=1<<Int(Abs(py))*Sign(py)
Macro gra(j0,i0,j1,i1)
d(j0,i0)=Abs(s(j0,i0)-s(j0,i1)+px)+Abs(s(j0,i0)-s(j1,i0)+py)
EndMacro
dy = ArraySize(s(), 1)
dx = ArraySize(s(), 2)
Dim d(dy,dx)
For j=0 To dy-1
For i=0 To dx-1
gra(j,i,j+1,i+1)
Next
gra(j,dx,j+1,0)
Next
For i = 0 To dx-1
gra(dy,i,0,i+1)
Next
gra(dy,dx,0,0)
EndProcedure
Procedure heightmap(Array t.w(2),rnd, dx.w, dy.w, Re.w)
Protected i,j,ii,jj,n,d,dd,dx1=dx-1,dy1=dy-1,l,R, rr,dec
RandomSeed(rnd)
n = 1<<re
dd=Min(dx,dy) / n: If dd<1:dd=1:EndIf
Dim t.w(dy-1, dx-1)
rr = $1fff:r=rr>>1
For jj = 0 To dy/dd - 1:j=jj*dd: For ii = 0 To dx/dd - 1:i=ii*dd: t(j,i) = Random(rr) - R: Next: Next
l = dd
While dd > 1
d = dd / 2
For jj = 0 To dy/dd - 1 :j=jj*dd+d
For ii = 0 To dx/dd - 1:i=ii*dd+d
t(j,i) = (t((j - d) & dy1,(i - d) & dx1) + t((j - d) & dy1,(i + d) & dx1) + t((j + d) & dy1,(i + d) & dx1) + t((j + d) & dy1,(i - d) & dx1)) / 4 + Random(rr) - R
Next
Next
For jj = 0 To dy/d - 1 :j=jj*d:dec=1- jj & 1
For ii = 0 To dx/dd - 1:i=ii*dd+dec*d
t(j,i) = (t(j,(i - d) & dx1) + t(j,(i + d) & dx1) + t((j - d) & dy1,i) + t((j + d) & dy1,i)) / 4 + Random(rr) - R
Next
Next
l/2
dd/2
r/2:rr/2
Wend
EndProcedure
Procedure texture(tex,dx,dy,rnd=0,f=0,lissage=0,embos=-10,grad.s="0,$000000/1,$ffffff",profil.s="0,0/1,1")
Protected Dim t.w(0,0)
Protected Dim bmp.l(dy-1,dx-1)
Protected Dim grad.l(0):gradienttoarray(grad(),1024,grad,1)
Protected i,j,n
heightmap(t(),rnd,dx,dy,f)
lisser2d(t(),lissage,lissage,1)
t2norme(t(),0,1023,profil)
For j=0 To dy-1:For i=0 To dx-1:bmp(j,i)=grad(t(j,i)):Next:Next
n=CreateTexture(tex,dx,dy):If tex=-1:tex=n:EndIf
StartDrawing(TextureOutput(tex))
CopyMemory(@ bmp(0,0),DrawingBuffer(),dx*dy*4)
StopDrawing()
ProcedureReturn tex
EndProcedure
;} ----------------------------------------------------------------------------------------------------------------------------------
;{ Océan
Global oc_mesh,oc_material,oc_particule, oc_wave.f,oc_swell.f
Global oc_tilesize,oc_tilesize2,oc_prec,oc_tilenb,oc_tilenb1
Global oc_tn,oc_tn1,oc_tn2
Procedure initocean(tilesize,prec,range,material,particule,waveheight.f,swellheight.f)
;tilesize: must be a power of 2
;precision : 1-> 1 meters, 2->2 meters, 3->4 meters, 4-> 8 meters...
;range : distance to the camera where the oocean should be rendered
;material : For water
;particule : for sea spay
Protected i,j,n,a.f
oc_tilesize=tilesize:oc_tilesize2=oc_tilesize/2
oc_prec=1<<(prec-1)
oc_tilenb=range/tilesize*2:oc_tilenb1=oc_tilenb-1
oc_tn=oc_tilesize/oc_prec:oc_tn1=oc_tn-1:oc_tn2=oc_tn/2
oc_material=material
oc_particule=particule
oceanset(waveheight,swellheight)
Global Dim oc_t.w(oc_tn1,oc_tn1)
Global Dim oc_h.f(oc_tn1,oc_tn1)
Global Dim oc_entity(oc_tilenb1,oc_tilenb1)
heightmap(oc_t(),0,oc_tn,oc_tn,0)
t2norme(oc_t(),-128,128,"0,0/0.5,1/1,0")
Dim mv.PB_MeshVertexv(oc_tn,oc_tn)
For j=0 To oc_tn
For i=0 To oc_tn
With mv(j,i)
vec3d(\p,(i-oc_tn2)*oc_prec,pom(16),(j-oc_tn2)*oc_prec)
\u=i/16*oc_prec
\v=j/16*oc_prec
EndWith
Next
Next
oc_mesh=CreateDataMesh(-1,mv())
Global Dim oc_MD.PB_MeshVertexv(MeshVertexCount(oc_mesh)-1)
GetMeshData(oc_mesh, 0, oc_MD(), #PB_Mesh_Vertex,0, MeshVertexCount(oc_mesh)-1)
For j=0 To oc_tilenb1
For i=0 To oc_tilenb1
oc_entity(j,i)=CreateEntity(-1,MeshID(oc_mesh),MaterialID(material))
Next
Next
EndProcedure
Procedure freeocean()
Protected i,j
For j=0 To ArraySize(oc_entity(),1)
For i=0 To ArraySize(oc_entity(),2)
FreeEntity(oc_entity(j,i))
Next
Next
FreeMesh(oc_mesh)
FreeArray(oc_entity())
EndProcedure
Procedure.f oceanHeight(x.f,z.f)
ProcedureReturn interpolarray2d(oc_h(),x/oc_prec,z/oc_prec)
EndProcedure
Procedure oceanset(waveheight.f,swellheight.f)
oc_wave=waveheight
oc_Swell=swellheight
EndProcedure
Procedure renderocean()
Static dif.f
Protected i,j,ii,jj, di,cv
Protected.f hc,hg,hd,hh,hb,ecume,ecumf=1.5/oc_prec,a,houle,pos.f3,w=oc_wave/128,r0=0.05/oc_prec,r1=1-r0
;------------------- mouvement des vagues
dif+0.2/oc_prec:di=dif
For j=0 To oc_tn1
jj=(j-di) & oc_tn1
a=2*jj/oc_tn*#PI
houle=Sin(a) *oc_Swell*2
For i=0 To oc_tn1
ii=(i-di) & oc_tn1
oc_h(j,i)*r1+((oc_t(ii,j)+oc_t(oc_tn1-jj,oc_tn1-i))*w +houle)*r0
Next
Next
For jj=0 To oc_tn:j=jj & oc_tn1
For ii=0 To oc_tn:i=ii & oc_tn1
With oc_MD(cv)
hc=oc_h(j,i)
hg=oc_h(j,(i-1) & oc_tn1)
hd=oc_h(j,(i+1) & oc_tn1)
hh=oc_h((j-1) & oc_tn1,i)
hb=oc_h((j+1) & oc_tn1,i)
\p\y =hc
ecume=limite((hc*4-hg-hd-hh-hb)*ecumf,0.2,1):ecume*ecume
vec3d(\n,hg-hd,2,hh-hb):norme3d(\n)
\color=RGBA(255,255,255,ecume*255)
cv+1
EndWith
Next
Next
SetMeshData(oc_mesh,0, oc_MD(), #PB_Mesh_Vertex|#PB_Mesh_Normal|#PB_Mesh_Color, 0, MeshVertexCount(oc_mesh)-1)
pos\x=CameraX(0)+pom(100)+CameraDirectionX(0)*100
pos\z=CameraZ(0)+pom(100)+CameraDirectionZ(0)*100
pos\y=oceanHeight(pos\x,pos\z)+2
If pos\y>0:MoveParticleEmitter(oc_particule,pos\x,pos\y,pos\z,#PB_Absolute):EndIf
;------------------- tuiles
Protected da=oc_tilenb*oc_tilesize
Static api=0,pi=1000, apj=0,pj=1000, i0,i1, j0,j1, e
api=pi:pi=(CameraX(0)-da/2)/oc_tilesize:If pi<api:i0=pi:i1=api-1:Else:i0=api+1+oc_tilenb1:i1=pi+oc_tilenb1:EndIf
apj=pj:pj=(CameraZ(0)-da/2)/oc_tilesize:If pj<apj:j0=pj:j1=apj-1:Else:j0=apj+1+oc_tilenb1:j1=pj+oc_tilenb1:EndIf
For j=pj To pj+oc_tilenb1
For i=pi To pi+oc_tilenb1
If (i>=i0 And i<=i1) Or (j>=j0 And j<=j1)
MoveEntity(oc_entity(Modi(j,oc_tilenb),Modi(i,oc_tilenb)), i*oc_tilesize+oc_tilesize2,0,j*oc_tilesize+oc_tilesize2,#PB_Absolute)
EndIf
Next
Next
;------------------- sous / sur l'eau
If CameraY(0)<oceanHeight(CameraX(0),CameraZ(0))
CameraBackColor(0,$332200):Fog($332200,100,0,100)
MaterialCullingMode(oc_material,#PB_Material_ClockWiseCull)
Else
CameraBackColor(0,$ffaa88):Fog($ffaa88,100,0,da/2)
MaterialCullingMode(oc_material,#PB_Material_AntiClockWiseCull)
EndIf
EndProcedure
;}
EndModule
;#####################################################################################################################################################
UseModule ext_3d
Procedure stabilise(entity,f.f)
Protected.f x,y,z
x=GetEntityAttribute(entity,#PB_Entity_AngularVelocityX)
y=GetEntityAttribute(entity,#PB_Entity_AngularVelocityY)
z=GetEntityAttribute(entity,#PB_Entity_AngularVelocityZ)
ApplyEntityTorque(entity,-x*f,-y*f,-z*f,#PB_World )
EndProcedure
Procedure menu(p1.s="",p2.s="",p3.s="")
Protected p=8
Macro DT(t1,t2="")
DrawText(8,p,t1)
DrawText(120,p,t2)
p+20
EndMacro
CreateSprite(0,240,200,#PB_Sprite_AlphaBlending)
StartDrawing(SpriteOutput(0))
DrawingMode(#PB_2DDrawing_AllChannels)
DrawingFont(FontID(0))
Box(0,0,240,200,$44000000)
DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Outlined)
Box(0,0,240,200,$ffffffff)
BackColor($44000000)
FrontColor($ffffffff)
dt("Moving:")
dt("Mouse + wheel"," Engine: "+p1)
dt("")
dt("Commandes:")
dt("[F1] / [F2]","Wave height: "+p2)
dt("[F3] / [F4]","Swell height: "+p3)
dt("[F5] / [F6]","Rotate camera")
dt("[F12]","Wireframe")
dt("[Esc]","Quit")
StopDrawing()
EndProcedure
Procedure main()
#sky=100
#water=10
#Seaspray=1
Protected ex,ey,c,v, fly=1,fdf
Protected.f MouseX,Mousey,keyx,keyy,keyz,camrot,aval, och, wave.f,swell.f
;boat
Protected i,j,engine,farchi.f, fmoteur.f,angle.f,oceanh
Protected.f3 pos,apos,vit,ftrainee
InitEngine3D():InitSprite():InitKeyboard():InitMouse()
ExamineDesktops()
ex=DesktopWidth(0)
ey=DesktopHeight(0)
InitKeyboard():InitMouse():InitEngine3D():InitSprite()
;OpenWindow(0,0,0,ex,ey,"",#PB_Window_BorderLess|#PB_Window_ScreenCentered):OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0),WindowHeight(0))
OpenScreen(ex,ey,32,"")
LoadFont(0,"arial",12)
;------------------- scene
CreateCamera(0, 0, 0, 100, 100):CameraRange(0,0,1000)
MoveCamera(0,0,10,0)
CameraLookAt(0, 0,10,-10)
CreateLight(0,$aaaaaa,0, 1000, 1000)
AmbientColor($888888)
;---- sky / ciel
texture(#sky,512,512,0,0,0,-10,"0,$ffff4400/0.5,$ffffffff/1,$ff888888")
CreateMaterial(#sky,TextureID(#sky)):ScaleMaterial(#sky,1,1)
SetMaterialColor(#sky,#PB_Material_SelfIlluminationColor,$ffffff):MaterialCullingMode(#sky, #PB_Material_AntiClockWiseCull):ScrollMaterial(#sky,0,-0.04,#PB_Material_Animated)
CreatePlane(#sky,100000,100000,1,1,320,320): CreateEntity(#sky,MeshID(#sky),MaterialID(#sky),0,100,0)
;--- water / eau
; EnvironmentMap
texture(0,512,512,0, 0,0,-10,"0,$ff221100/1,$ffaa8866","0,0/0.1,0/1,1")
StartDrawing(TextureOutput(0))
DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient)
GradientColor(0,$ffffFFFF)
GradientColor(0.25,$ffffFFFF)
GradientColor(1,$00ffffff)
CircularGradient(256,80,80)
Circle(256,80,80)
StopDrawing()
; Sea foam / écume
texture(1,256,256,0,3,0,0,"0,$442200/1,$ffffff","0,0/0.4,0.2/0.5,1/0.6,0.2/1,0")
CreateMaterial(#water, TextureID(0))
SetMaterialAttribute(#water,#PB_Material_EnvironmentMap,#PB_Material_ReflectionMap)
DisableDebugger
AddMaterialLayer(#water, TextureID(1),13)
SetMaterialAttribute(#water,21,3)
EnableDebugger
; Sea spray / embruns
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures", #PB_3DArchive_FileSystem):Parse3DScripts()
LoadTexture(4, "water.png")
CreateMaterial(4, TextureID(4))
DisableMaterialLighting(4, 1)
MaterialBlendingMode (4, #PB_Material_AlphaBlend)
SetMaterialAttribute(4,#PB_Material_TAM,#PB_Material_ClampTAM)
CreateParticleEmitter(#Seaspray,8, 2, 8, #PB_Particle_Box)
ParticleMaterial (#Seaspray, MaterialID(4))
ParticleSize (#Seaspray, 0.5,0.5):ParticleScaleRate(#Seaspray,8)
ParticleColorFader(#Seaspray, 0, 0, 0, -1)
ParticleEmitterDirection(#Seaspray, 0, 0, 1)
ParticleTimeToLive (#Seaspray, 1,1)
ParticleVelocity(#Seaspray, 2,20)
ParticleAcceleration(#Seaspray, 0, -0.2, 0)
ParticleAngle(#Seaspray,-180,180,-180,180)
ParticleEmissionRate(#Seaspray, 500)
wave=3
swell=3
menu(Str(wave),Str(swell))
initocean(128,1,512,#water,#Seaspray,wave,swell)
;================================================================================= boat
CreateCapsule(0,2,5):TransformMesh(0,0,0,0,1,1,0.4,90,0,0):NormalizeMesh(0)
CreateCapsule(1,0.2,1):TransformMesh(1,0,0,0,4,0.8,2,0,0,0):NormalizeMesh(1)
CreateCapsule(2,1,2):TransformMesh(2,0,0.5,-1,1.2,1,1,90,0,0):NormalizeMesh(2)
CreateTexture(1,256,256):StartDrawing(TextureOutput(1)):DrawingMode(#PB_2DDrawing_AllChannels):Box(0,0,128,256,$88ffffff):Box(128,0,128,256,$880000ff):StopDrawing()
CreateTexture(2,256,256):StartDrawing(TextureOutput(2)):DrawingMode(#PB_2DDrawing_AllChannels):Box(0,0,256,256,$8800ffff):StopDrawing()
CreateTexture(3,256,256):StartDrawing(TextureOutput(3)):DrawingMode(#PB_2DDrawing_AllChannels):Box(0,0,256,256,$88000000):StopDrawing()
CreateMaterial(0, TextureID(0)):SetMaterialAttribute(0,#PB_Material_EnvironmentMap,#PB_Material_ReflectionMap)
AddMaterialLayer(0,TextureID(1),#PB_Material_AlphaBlend)
CreateMaterial(1, TextureID(0)):SetMaterialAttribute(1,#PB_Material_EnvironmentMap,#PB_Material_ReflectionMap)
AddMaterialLayer(1,TextureID(2),#PB_Material_AlphaBlend)
CreateMaterial(2, TextureID(3))
AddMaterialLayer(2,TextureID(0),#PB_Material_AlphaBlend):SetMaterialAttribute(2,#PB_Material_EnvironmentMap,#PB_Material_ReflectionMap,1)
MaterialBlendingMode(2,#PB_Material_AlphaBlend)
CreateEntity(0,MeshID(0),MaterialID(0)):CreateEntityBody(0,#PB_Entity_CapsuleBody,100)
CreateEntity(1,MeshID(1),MaterialID(1),0,0.5,-4.5)
CreateEntity(2,MeshID(2),MaterialID(2))
AttachEntityObject(0,"",EntityID(1))
AttachEntityObject(0,"",EntityID(2))
CreateParticleEmitter(0,0,0,0, #PB_Particle_Point)
ParticleMaterial (0, MaterialID(4))
ParticleSize (0, 1,1)
ParticleColorFader(0, 0, 0, 0, -2)
ParticleTimeToLive (0, 0.5,0.5)
ParticleEmitterDirection(0, 0, 1, 0)
ParticleVelocity(0, 2,10)
ParticleEmitterAngle(0,40)
ParticleAcceleration(0, 0, -0.5, 0)
ParticleAngle(0,-180,180,-180,180)
;=================================================================================
Repeat
;WindowEvent()
ExamineMouse()
ExamineKeyboard()
MouseX = -MouseDeltaX() * 0.05
MouseY = -MouseDeltaY() * 0.05
aval=wave :wave +(KeyboardReleased(#PB_Key_F2)-KeyboardReleased(#PB_Key_F1)):wave =limite(wave ,1,4):If wave <>aval:oceanset(wave,swell):menu(Str(engine),Str(wave),Str(swell)):EndIf
aval=swell:swell+(KeyboardReleased(#PB_Key_F4)-KeyboardReleased(#PB_Key_F3)):swell=limite(swell,0,4):If swell<>aval:oceanset(wave,swell):menu(Str(engine),Str(wave),Str(swell)):EndIf
camrot+(KeyboardPushed(#PB_Key_F5)-KeyboardPushed(#PB_Key_F6))*0.02
If KeyboardReleased(#PB_Key_F11):fly=1-fly:EndIf
If KeyboardReleased(#PB_Key_F12):fdf=1-fdf:If fdf:CameraRenderMode(0,#PB_Camera_Wireframe):Else:CameraRenderMode(0,#PB_Camera_Textured):EndIf:EndIf
keyx=(-Bool(KeyboardPushed(#PB_Key_Left))+Bool(KeyboardPushed(#PB_Key_Right)))*-1
keyz=(-Bool(KeyboardPushed(#PB_Key_Up ))+Bool(KeyboardPushed(#PB_Key_Down )))*0.1-MouseWheel()*4;-fly*0.5
; RotateCamera(0, MouseY, MouseX, 0, #PB_Relative):MoveCamera (0, KeyX, 0, keyz)
; If fly=0:och+(oceanHeight(CameraX(0),CameraZ(0))+1-och)*0.2:MoveCamera(0,CameraX(0),och,CameraZ(0),#PB_Absolute):EndIf
CameraFollow(0,EntityID(0),camrot+180,8,20,1,1)
;================================================================================= boat
apos=pos:vec3d(pos,EntityX(0),EntityY(0),EntityZ(0))
sub3d(vit,pos,apos):mul3d(vit,60)
;flotaison
For i=-2 To 2 Step 4:For j=-3 To 3 Step 6
ConvertLocalToWorldPosition(EntityID(0),i,0,j*2)
farchi=min((GetY()-oceanHeight(GetX(),GetZ())-0.5),0.5)*-3000
ApplyEntityForce(0,0,farchi,0,i,1,j*2,#PB_Local )
Next:Next
aval=engine:engine=limite(engine+MouseWheel(),-5,10):If fmoteur <>aval:menu(Str(engine),Str(wave),Str(swell)):EndIf
ParticleScaleRate(0,Abs(engine/2))
angle=(angle+MouseDeltaX()*0.001)*0.98
EntityDirection(1,Sin(angle),0,Cos(angle),#PB_Parent ,0)
ConvertLocalToWorldPosition(EntityID(0),0,0,-5)
oceanh=oceanHeight(GetX(),GetZ())
MoveParticleEmitter(0,GetX(),oceanH,GetZ(),#PB_Absolute)
If GetY()-1<oceanH
;moteur
fmoteur=engine*300
ApplyEntityForce(0,fmoteur*Sin(angle),0,fmoteur*Cos(angle),0,0,-5,#PB_Local )
ParticleEmissionRate(0,60)
Else
ParticleEmissionRate(0,0)
EndIf
; trainée
ftrainee=vit:mul3d(ftrainee,-50)
ApplyEntityForce(0,ftrainee\x,ftrainee\y,ftrainee\z)
stabilise(0,8000)
;=================================================================================
renderocean()
RenderWorld(17)
DisplayTransparentSprite(0,8,8)
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) Or MouseButton(1)
EndProcedure
main()
ça m’éclate
