PureBasic

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)