[EDIT] j'ai fais une petite modif, en utilisant "SetMeshData" je peux multiplier par 10 le nombre de bille (100 000) !!!
une petite demo de path finding
déplacement :
- souris (+roulette) + fleche
- bouton gauche pour ajouter/enlever des blocs (ligne blanche)
- bouton droit pour changer la position de la cible
- [espace] pour changer de carte
Enlever le débogueur
Code : Tout sélectionner
; demo 3d: pathfinding - Pf Shadoko - 2022
Structure l2
x.l
y.l
EndStructure
Macro f3:vector3:EndMacro
Structure MeshVertexV
p.f3
n.f3
t.f3
u.f
v.f
color.l
EndStructure
Procedure.f POM(v.f)
ProcedureReturn (Random(2000)-1000)*0.001*v
EndProcedure
Procedure.f clamp(V.f, i.f, s.f)
If V < i :v=i:EndIf
If V > s :v=s:EndIf
ProcedureReturn V
EndProcedure
Global n=32,n1=n-1,cx,cy,size.f=0.05,nb=100000
Global ex,ey,cible
Global Dim t(n1,n1)
Global Dim s.f(n1,n1)
Global Dim o.l2(n1,n1)
Global Dim pos.f3(nb)
Global Dim vit.f3(nb)
Procedure pathfinding(gi,gj)
Structure sfront:p.l2:o.b:EndStructure
Protected f.sfront,*f.sfront,s.f,ns.f
Dim s.f(n1,n1):For j=0 To n1:For i=0 To n1:s(j,i)=1e10:Next:Next
Dim polar.l2(7):For i=0 To 7:polar(i)\x=Round(Cos(#PI*i/4),#PB_Round_Nearest):polar(i)\y=Round(Sin(#PI*i/4),#PB_Round_Nearest):Next
Dim front.sfront(1000)
Dim nfront.sfront(1000)
Dim o.l2(n1,n1)
front(0)\p\x=gi:front(0)\p\y=gj:t(gj,gi)-0:nf=1:s(gj,gi)=1
Repeat
nnf=0
For k=0 To nf-1
f=front(k):s=s(f\p\y,f\p\x)
Macro mwave
i=(ii+f\o) & 7:pj=f\p\y+polar(i)\y:pi=f\p\x+polar(i)\x
If pi>=0 And pi<n And pj>=0 And pj<n
If i&1:ns=s+1.4:Else:ns=s+1.0:EndIf
If s(pj,pi)<=ns:Break:EndIf
If t(pj,pi)=0:*f=nfront(nnf):*f\p\x=pi:*f\p\y=pj:*f\o=i:nnf+1:s(pj,pi)=ns:o(pj,pi)=polar(i):EndIf
EndIf
EndMacro
For ii= 0 To 3: mwave:Next
For ii=-1 To -4 Step -1:mwave:Next
Next
CopyArray(nfront(),front()):nf=nnf
Until nf=0
EndProcedure
Procedure changecible(auto=1)
If auto:Repeat:cx=Random(n1):cy=Random(n1):Until t(cy,cx)=0:EndIf
MoveEntity(cible,cx,1,cy,#PB_Absolute)
MoveLight(0,cx,n/4,cy,#PB_Absolute)
pathfinding(cx,cy)
EndProcedure
Procedure affiche()
For j=0 To n1
For i=0 To n1
e=j*n+i:CreateEntity(e,MeshID(0),MaterialID(t(j,i)),i,t(j,i)-0.5,j,1)
Next
Next
pathfinding(cx,cy)
EndProcedure
Procedure carte(rnd=0,proba=45)
RandomSeed(rnd)
For j=1 To n1
For i=1 To n1
t(j,i)=Bool(Random(100)<proba)
Next
Next
For j=1 To n1-2
For i=1 To n1-2
s= t(j-1,i) + t(j+1,i) + t(j,i-1) + t(j,i+1)
If s<=1:t(j,i)=0:EndIf
If s>=3:t(j,i)=1:EndIf
Next
Next
For i=0 To n1:t(i,0)=1:t(i,n1)=1:t(0,i)=1:t(n1,i)=1:Next
affiche()
changecible()
For i=0 To nb:pos(i)\x=cx:pos(i)\z=cy:pos(i)\y=0.5+pom(0.4):Next
changecible()
EndProcedure
InitEngine3D():InitSprite():InitKeyboard():InitMouse()
ExamineDesktops():ex=DesktopWidth(0):ey=DesktopHeight(0)
OpenWindow(0,0,0,ex,ey,"",#PB_Window_BorderLess|#PB_Window_ScreenCentered):OpenWindowedScreen(WindowID(0), 0, 0, WindowWidth(0),WindowHeight(0))
CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,0,30,0):CameraLookAt(0,n/2,0,n/2): CameraBackColor(0,$884488)
CreateLight(0,$ffffff)
AmbientColor($111111*4)
CreateCube(0,1)
CreateTexture(0,256,256):StartDrawing(TextureOutput(0)):Box(0,0,256,256,$ffffff):Box(2,2,252,252,$aaaaaa):StopDrawing()
CreateMaterial(0,TextureID(0),$88ffff)
CreateMaterial(1,TextureID(0),$ffff88)
CreateCylinder(5,0.1,2)
CreateMaterial(5,0,$ff)
cible=CreateEntity(-1,MeshID(5),MaterialID(5))
CreateShaderMaterial(2,#PB_Material_PointSpriteSphereShader):MaterialShininess(2,64,$ffffffff)
SetMaterialAttribute(2,#PB_Material_PointSprite,1)
Define.f depx,depz,mousex,mousey,dist,mb1,amb1,mb2,amb2,niv=6,auto=1
Dim v.MeshVertexv(nb)
CreateMesh(1,#PB_Mesh_PointList)
For i=0 To nb:MeshVertex(Random(n1),0.5+pom(0.4),Random(n1),size,0,$ff|$ffff00*i/nb):Next
FinishMesh(1)
CreateEntity(5001,MeshID(1),MaterialID(2),0,0,0,2)
carte(niv)
Repeat
While WindowEvent():Wend
ExamineKeyboard()
ExamineMouse()
depx=(-Bool(KeyboardPushed(#PB_Key_Left))+Bool(KeyboardPushed(#PB_Key_Right)))*0.1
depz=(-Bool(KeyboardPushed(#PB_Key_Down))+Bool(KeyboardPushed(#PB_Key_Up )))*0.1+MouseWheel()*2
MouseX = -MouseDeltaX() * 0.05
MouseY = -MouseDeltaY() * 0.05
RotateCamera(0, MouseY, MouseX, 0, #PB_Relative)
dist+(depz-dist)*0.05:MoveCamera (0, depX, 0, -dist)
e=MousePick(0,ex/2,ey/2,1)
If e>=0 And e<n*n
mcx = e & n1
mcy = e/n
CreateLine3D(5000,mcx, 0, mcy,$ffffff,mcx, 4, mcy,$ffffff)
EndIf
If KeyboardReleased(#PB_Key_Space):niv+1:carte(niv):EndIf
amb1=mb1:mb1=MouseButton(1):If amb1=0 And mb1:t(mcy,mcx)!1:affiche():EndIf
amb2=mb2:mb2=MouseButton(2):If amb2=0 And mb2:cx=mcx:cy=mcy:changecible(0):auto=0:EndIf
If auto And ElapsedMilliseconds()-t0>10000:t0=ElapsedMilliseconds():changecible():EndIf
Define.f px,pz,vl,inf=0.002,vlim=0.04
Define i,j,k,ii,jj
For k=0 To nb
i=pos(k)\x
j=pos(k)\z
vl=vlim*(1+k/nb)
vit(k)\x-o(j,i)\x*inf+pom(0.01):vit(k)\x=clamp(vit(k)\x,-vl,vl):px=pos(k)\x+vit(k)\x:ii=px
vit(k)\z-o(j,i)\y*inf+pom(0.01):vit(k)\z=clamp(vit(k)\z,-vl,vl):pz=pos(k)\z+vit(k)\z:jj=pz
If t(jj,ii):vit(k)\x=0:vit(k)\z=0:Else:pos(k)\x=px:pos(k)\z=pz: EndIf
v(k)\p= pos(k)
Next
SetMeshData(1,0,v(),#PB_Mesh_Vertex,0,nb)
RenderWorld()
FlipBuffers()
Until KeyboardReleased(#PB_Key_Escape) Or MouseButton(3)
en si peut de ligne