Demo 3D: Path finding

Everything related to 3D programming
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 280
Joined: Thu Jul 09, 2015 9:07 am

Demo 3D: Path finding

Post by pf shadoko »

requires PB 6.02 (shaders being buggy in previous versions)

[EDIT] I made a small modification, using "SetMeshData" I can multiply by 10 the number of balls (100 000) !!!

a small path finding demo
movement :
- mouse (+wheel) + arrow
- left button to add/remove blocks (white line)
- right button to change the target position
- [space] to change map

Remove debugger

Code: Select all

; 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)

Last edited by pf shadoko on Wed May 31, 2023 5:20 pm, edited 2 times in total.
User avatar
Caronte3D
Addict
Addict
Posts: 1025
Joined: Fri Jan 22, 2016 5:33 pm
Location: Some Universe

Re: Demo 3D: Path finding

Post by Caronte3D »

WoW! :shock: very nice!
This kind of demo shows more and more that the 3d part of PB can still be very useful even if it doesn't keep up with the new gameengines.
Thanks for sharing! :wink:
dige
Addict
Addict
Posts: 1247
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:

Re: Demo 3D: Path finding

Post by dige »

That rocks!! :D
"Daddy, I'll run faster, then it is not so far..."
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: Demo 3D: Path finding

Post by BarryG »

Stop making such addictive little apps!
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 280
Joined: Thu Jul 09, 2015 9:07 am

Re: Demo 3D: Path finding

Post by pf shadoko »

I made a small modification, using "SetMeshData" I can multiply by 10 the number of balls (100 000) !!!
User avatar
Caronte3D
Addict
Addict
Posts: 1025
Joined: Fri Jan 22, 2016 5:33 pm
Location: Some Universe

Re: Demo 3D: Path finding

Post by Caronte3D »

:shock: :shock:
benubi
Enthusiast
Enthusiast
Posts: 113
Joined: Tue Mar 29, 2005 4:01 pm

Re: Demo 3D: Path finding

Post by benubi »

Very good!
User avatar
idle
Always Here
Always Here
Posts: 5039
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Demo 3D: Path finding

Post by idle »

That's quite a lot of balls, if you place a cube over the swarm you trap them inside the cube.
Post Reply