PureBasic Forum
https://www.purebasic.fr/english/

Physics - Helicopter
https://www.purebasic.fr/english/viewtopic.php?f=36&t=72706
Page 1 of 1

Author:  pf shadoko [ Thu Apr 25, 2019 8:39 am ]
Post subject:  Physics - Helicopter

A mini helicopter simulator.
But it's pretty realistic from a physical point of view.
for commands see window title
(in terms of shadows, you're not surprised, it's not working (I haven't understood why yet))

EDIT 25/04/2019
added optional settings for CreateCone (line 166)
CreateCone(1,0.3.3,3.3.5,5,16,1)
at home, it fixes crashes on x86
can you confirm?


EDIT 30/04/2019
shadows okay
simplification
no more shaking (with physics you have to set the number of milliseconds with RenderWorld (16))


Code:
;Physics - Helicopter - Pf Shadoko - 2019

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

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

Macro sub3D(p,p1,p2)
  p\x=p1\x-p2\x
  p\y=p1\y-p2\y
  p\z=p1\z-p2\z
EndMacro

Macro mul3d(p1,v)
  p1\x*(v)
  p1\y*(v)
  p1\z*(v)
EndMacro

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

Procedure perlinarray2d(Array pa.f(2),rnd,periode,amplitude.f=1)
  Protected i,ii,dx=ArraySize(pa(),1),ddx=dx/periode,
            j,jj,dy=ArraySize(pa(),2),ddy=dy/periode
  Protected.f x,y,y0,y1,wx,wy
 
  RandomSeed(rnd)
  Dim t.f(ddx+1,ddy+1)
  For i=0 To ddx:For j=0 To ddy:t(i,j)=pom(amplitude):Next:Next
  For i=0 To ddx+1:t(i,ddy+1)=t(i,0):Next
  For j=0 To ddy+1:t(ddx+1,j)=t(0,j):Next
 
  For jj=0 To ddy
    For ii=0 To ddx
      For i=0 To periode-1
        x=i/periode
        wx=x*x*(3-2*x)
        For j=0 To periode-1
          y0=t(ii+1,jj  )*wx+t(ii,jj  )*(1-wx)
          y1=t(ii+1,jj+1)*wx+t(ii,jj+1)*(1-wx)
          y=j/periode
          wy=y*y*(3-2*y)
          pa(ii*periode+i,jj*periode+j)=y1*wy+y0*(1-wy)
        Next
      Next
    Next
  Next
EndProcedure

Procedure AddMesh(mesho,Mesh,mat, NewX.f=0 , NewY.f=0, NewZ.f=0, ScaleX.f=1, ScaleY.f=1, ScaleZ.f=1, RotateX.f=0, RotateY.f=0, RotateZ.f=0)
  Protected Dim MeshDataV.PB_MeshVertex(0)
  Protected Dim MeshDataF.PB_MeshFace(0)
  Protected i,meshc
 
  meshc=CopyMesh(mesh,-1)
  TransformMesh(Meshc, NewX,NewY,NewZ, ScaleX,ScaleY,ScaleZ, RotateX,RotateY,RotateZ)
  GetMeshData(Meshc,0, MeshDataV(), #PB_Mesh_Vertex |#PB_Mesh_Color | #PB_Mesh_UVCoordinate| #PB_Mesh_Normal, 0, MeshVertexCount(Meshc, 0)-1)
  GetMeshData(Meshc,0, MeshDataF(), #PB_Mesh_Face, 0, MeshIndexCount(Meshc, 0)-1)
  FreeMesh(meshc)
 
  AddSubMesh()
  For i=0 To ArraySize(MeshDataV())
    With MeshDatav(i)
      MeshVertex(\x,\y,\z,\u,\v,$ffffff,\NormalX,\NormalY,\NormalZ)
    EndWith
  Next     
  For i=0 To ArraySize(MeshDataF()) Step 3
    MeshFace(MeshDataF(i)\Index, MeshDataF(i+1)\Index,MeshDataF(i+2)\Index)
  Next
  If mat>=0:SetMeshMaterial(mesho, MaterialID(mat), SubMeshCount(mesho)-1):EndIf
EndProcedure

;##########################################################################################################################################################
Global ex,ey,h.f

Procedure matiere(num,dx,dy,c1,c2, brillance=$888888,alpha=0,scale.f=1)
  CreateTexture(num,dx,dy)
  StartDrawing(TextureOutput(num))
  If alpha:DrawingMode(#PB_2DDrawing_AllChannels):EndIf
  Box(0,0,dx,dy,c2)
  Box(2,2,dx-4,dy-4,c1)
  StopDrawing()
  CreateMaterial(num, TextureID(num))
  MaterialFilteringMode(num,#PB_Material_Anisotropic,4)
  ScaleMaterial(num,scale,scale)
  If brillance:SetMaterialColor(num, #PB_Material_SpecularColor, brillance):MaterialShininess(num, 40):EndIf
  If alpha:MaterialBlendingMode(num,#PB_Material_AlphaBlend):EndIf
EndProcedure

Procedure mesh_terrain(mesh,n)
  Protected.f h, vx, vy
  Protected i,j,dt=4,n2=n/2
  Dim pa.f(n-1,n-1)
 
  perlinarray2d(pa(),0,8,16)
 
  Dim t.PB_MeshVertexV(n,n)
  RandomSeed(0)
  For j=0 To n
    For i=0 To n
      With t(i,j) 
        \p\x=(i-n2)*4
        \p\z=(j-n2)*4
        \p\y=pa(i & (n-1),j & (n-1))+8:If \p\y<0:\p\y=0:EndIf
        \u=i
        \v=j
        \color=$ffffff
      EndWith
    Next
  Next
  CreateDataMesh(mesh,t())
  NormalizeMesh(mesh);UpdateMeshBoundingBox(mesh);BuildMeshShadowVolume(mesh)
EndProcedure

Procedure Init()
  Protected i
  InitEngine3D():InitSprite():InitKeyboard():InitMouse()
 
  OpenWindow(0, 0, 0, 800,600, "",#PB_Window_Maximize|#PB_Window_BorderLess)
  ex=WindowWidth (0,#PB_Window_InnerCoordinate)
  ey=WindowHeight(0,#PB_Window_InnerCoordinate)
  OpenWindowedScreen(WindowID(0), 0, 0, ex, ey, 0, 0, 0)
  LoadFont(0,"arial",12)
 
  EnableWorldPhysics(#True)
  EnableWorldCollisions(#True)
  WorldGravity(-10)
 
  CreateCamera(0, 0, 0, 100, 100):MoveCamera(0,0,10,-20)
  CameraBackColor(0,$ff8888)
 
  CreateLight(0,$888888, 1000,1000,0):SetLightColor(0, #PB_Light_SpecularColor, $ffffff)
  AmbientColor($444444) 
 
  ; -------------------- terrain
  matiere(0,256,256,$ff448888,$ff88cccc,0)
  mesh_terrain(100,256)
  CreateEntity(100,MeshID(100),MaterialID(0)):CreateEntityBody(100,#PB_Entity_StaticBody,1,0,1)
  EntityRenderMode(100,0)
  matiere(1,256,256,$aaaaaa,$ffffff,0,0,0.25)
  CreateCylinder(101,5,1,32,1,1)
  CreateEntity(101,MeshID(101),MaterialID(1)):CreateEntityBody(101,#PB_Entity_StaticBody,1,0,1)
 
  ; -------------------- helico
  CreateMesh(0)
  matiere(10,256,256,$88444444,$88444444,$ffffff,1)
  CreateSphere(1,0.75):AddMesh(0,1,10,0,0,0.5, 0.8,1,1.4)
  matiere(11,256,256,$ff0000ff,$8888ff,$ffffff,0,4)
  CreateCone(1,0.3,3.5,16,1):AddMesh(0,1,11,0,0,-1.8,0.8,1,1,-90,0,0)
  matiere(12,256,256,$00ffff,$88ffff,$88ffff,0,4)
  CreateCapsule(1,0.15,1.5):AddMesh(0,1,12,0.6,-1,0,1,1,1,90,0,0):AddMesh(0,1,12,-0.6,-1,0,1,1,1,90,0,0)
  FinishMesh(1):NormalizeMesh(0);UpdateMeshBoundingBox(0);BuildMeshShadowVolume(0)
  CreateEntity(0, MeshID(0), #PB_Material_None,0,1.2+0.5,0):CreateEntityBody(0, #PB_Entity_ConvexHullBody ,10, 0.0,0.3);EntityRenderMode(0, 0)
  SetEntityAttribute(0,#PB_Entity_LinearSleeping,0)
  ; rotor principal
  matiere(13,256,256,$444444,$444444)
  CreateCapsule(2, 0.05,1):TransformMesh(2,0,0,0,1,6,2,0,0,90):NormalizeMesh(2):UpdateMeshBoundingBox(2);:BuildMeshShadowVolume(2)
  CreateEntity(2, MeshID(2), MaterialID(13),0,1,0)
  AttachEntityObject(0,"",EntityID(2))
  ; rotor arriere
  CreateCapsule(3, 0.05,1):TransformMesh(3,0,0,0,0.5,1,1,0,0,0):NormalizeMesh(3);:BuildMeshShadowVolume(3)
  CreateEntity(3, MeshID(3), MaterialID(13),0.1,0,-3.5) 
  AttachEntityObject(0,"",EntityID(3))
 
  WorldShadows(#PB_Shadow_Additive); use #PB_Shadow_Modulative if it lags
  ;WorldDebug(#PB_World_DebugBody)
EndProcedure

Procedure menu()
  Protected p=4
  Macro DT(t1,t2="")
    DrawText(8,p,t1)
    DrawText(100,p,t2)
    p+20
  EndMacro
  CreateSprite(0,180,108,#PB_Sprite_AlphaBlending)
  StartDrawing(SpriteOutput(0))
  DrawingMode(#PB_2DDrawing_AllChannels)
  DrawingFont(FontID(0))
  Box(0,0,OutputWidth(),OutputHeight(),$44000000)
  DrawingMode(#PB_2DDrawing_AllChannels|#PB_2DDrawing_Outlined)
  Box(0,0,OutputWidth(),OutputHeight(),$44ffffff)
  BackColor($44000000)
  FrontColor($ffffffff)
  dt("Controls:")
  dt("Arrow keys + Mouse")
  dt("[Pad 0-1]","Engine")
  dt("[F1]","Camera")
  dt("[Esc]","Quit")
  StopDrawing()
EndProcedure

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 affiche3d()
  Protected i,ii,j,c,l,dis=1,vdis=1<<dis-1,shadows
  Protected.f inclx,inclz,  droty,rotp,rota,fportance,decx,decz,cx=3,alt=1+1.2-1
  Protected.vector3 apos,pos,vit,ftrainee
 
  Macro KBdep(k1,k2):(Bool(KeyboardPushed(k1))-Bool(KeyboardPushed(k2))) :EndMacro
 
  menu()
  MouseLocate(ex/2,ey/2)
  Repeat
    WindowEvent()
    ExamineMouse()
    ExamineKeyboard()
    If KeyboardReleased(#PB_Key_F1):dis=(dis+1)%3:vdis=1<<dis-1:EndIf
   
    ; info: position, vitesse, inclinaison x/z
    apos=pos
    vec3d(pos,EntityX(0),EntityY(0),EntityZ(0))
    sub3d(vit,pos,apos):mul3d(vit,60)
    ConvertLocalToWorldPosition(EntityID(0),1,0,0):inclx=EntityY(0)-GetY()
    ConvertLocalToWorldPosition(EntityID(0),0,0,1):inclz=EntityY(0)-GetY()
   
    ; portance
    alt+KBdep(#PB_Key_Pad1,#PB_Key_Pad0)*0.1
    fportance=100-(pos\y-alt+vit\y)*20
    decx-KBdep(#PB_Key_Left,#PB_Key_Right)*0.1+inclx*0.2:decx*0.9
    decz+KBdep(#PB_Key_Down,#PB_Key_Up   )*0.12+inclz*0.2:decz*0.9
    ApplyEntityForce(0, 0,fportance,0,decx,1,decz,#PB_Local )
   
    ; rotation
    droty-MouseDeltaX()*0.4:droty*0.9
    ApplyEntityTorque(0, 0,droty,0,#PB_Local)
   
    ; trainĂ©e
    ftrainee=vit:mul3d(ftrainee,-cx)
    ApplyEntityForce(0,ftrainee\x,ftrainee\y,ftrainee\z)
   
    stabilise(0,100)
   
    rotp=fportance/5:RotateEntity(2,0,rotp,0,#PB_Relative)
    rota=fportance/5:RotateEntity(3,rota,0,0,#PB_Relative)
   
    CameraFollow(0, EntityID(0), -180,EntityY(0)+vdis, 6*vdis+0.1, 0.05, 1)
    RenderWorld(16)
    DisplayTransparentSprite(0,8,8)
    FlipBuffers()
  Until KeyboardPushed(#PB_Key_Escape)
EndProcedure

init()
affiche3d()

Author:  NicTheQuick [ Thu Apr 25, 2019 9:00 am ]
Post subject:  Re: Physics - Helicopter

I don't get how to fly this thing. :lol:

Author:  RSBasic [ Thu Apr 25, 2019 9:08 am ]
Post subject:  Re: Physics - Helicopter

@NicTheQuick
Code:
alt+KBdep(#PB_Key_Pad1,#PB_Key_Pad0)*0.05

You can change the key. With this key you can start the engine.

@pf shadoko
Very good, thank you. :)

Author:  NicTheQuick [ Thu Apr 25, 2019 9:11 am ]
Post subject:  Re: Physics - Helicopter

I know, but when I have started the engine and then wiggle with the mouse and press some arrow keys the helicopter suddenly rotates around all its axes and gets uncontrollable. I don't get the correlation between mouse and the arrow keys.

Author:  BarryG [ Thu Apr 25, 2019 11:38 am ]
Post subject:  Re: Physics - Helicopter

Hi, this doesn't work for me. The window opens and then disappears immediately, and the program just sits in the main loop where I can't see or do anything. I'm just left looking at the PureBasic IDE.

Nic, that's what used to happen to me with the Bell helicopter in Microsoft Flight Simulator. They're just hard to fly.

Author:  RSBasic [ Thu Apr 25, 2019 12:04 pm ]
Post subject:  Re: Physics - Helicopter

BarryG wrote:
Hi, this doesn't work for me. The window opens and then disappears immediately, and the program just sits in the main loop where I can't see or do anything. I'm just left looking at the PureBasic IDE.

+1
On my laptop (PB 5.70, W10, i7-5500U, Radeon R7 M270) I had exactly the same problem. It works on my other computer (PB 5.70, W10, i5 2500K, Geforce GTX 1050 Ti).

Author:  Kwai chang caine [ Thu Apr 25, 2019 12:57 pm ]
Post subject:  Re: Physics - Helicopter

Quote:
Hi, this doesn't work for me. The window opens and then disappears immediately, and the program just sits in the main loop where I can't see or do anything. I'm just left looking at the PureBasic IDE.

+1 (W7 x86 / Pb 5.70 x86)

Author:  pf shadoko [ Thu Apr 25, 2019 4:07 pm ]
Post subject:  Re: Physics - Helicopter

I added the optional settings for CreateCone (line 166)
CreateCone(1,0.3.3,3.3.5,5,16,1)
at home, it fixes crashes on x86
can you confirm?

Author:  RSBasic [ Thu Apr 25, 2019 4:19 pm ]
Post subject:  Re: Physics - Helicopter

Now works. Thank you

Author:  pf shadoko [ Tue Apr 30, 2019 10:02 am ]
Post subject:  Re: Physics - Helicopter

EDIT 30/04/2019
shadows okay
simplification
no more shaking (with physics you have to set the number of milliseconds with RenderWorld (16))

Author:  Michael Vogel [ Tue Apr 30, 2019 3:32 pm ]
Post subject:  Re: Physics - Helicopter

Nice program, needed to use opengl as library subsystem here and also changed the keyboard setting...

...but be careful here: #PB_Key_Y ignores the keyboard layout, on a keyboard using a german layout you must press 'Z' instead of 'Y'.

Author:  Psychophanta [ Sun May 19, 2019 12:13 pm ]
Post subject:  Re: Physics - Helicopter

Thank you!

Page 1 of 1 All times are UTC + 1 hour
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/