Physics - Helicopter

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

Physics - Helicopter

Post by pf shadoko »

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: Select all

;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()
Last edited by pf shadoko on Tue Apr 30, 2019 10:02 am, edited 2 times in total.
User avatar
NicTheQuick
Addict
Addict
Posts: 1224
Joined: Sun Jun 22, 2003 7:43 pm
Location: Germany, Saarbrücken
Contact:

Re: Physics - Helicopter

Post by NicTheQuick »

I don't get how to fly this thing. :lol:
The english grammar is freeware, you can use it freely - But it's not Open Source, i.e. you can not change it or publish it in altered way.
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Physics - Helicopter

Post by RSBasic »

@NicTheQuick

Code: Select all

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. :)
Image
Image
User avatar
NicTheQuick
Addict
Addict
Posts: 1224
Joined: Sun Jun 22, 2003 7:43 pm
Location: Germany, Saarbrücken
Contact:

Re: Physics - Helicopter

Post by NicTheQuick »

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.
The english grammar is freeware, you can use it freely - But it's not Open Source, i.e. you can not change it or publish it in altered way.
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: Physics - Helicopter

Post by BarryG »

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.
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Physics - Helicopter

Post by RSBasic »

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).
Image
Image
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Physics - Helicopter

Post by Kwai chang caine »

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)
ImageThe happiness is a road...
Not a destination
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 280
Joined: Thu Jul 09, 2015 9:07 am

Re: Physics - Helicopter

Post by pf shadoko »

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?
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Physics - Helicopter

Post by RSBasic »

Now works. Thank you
Image
Image
User avatar
pf shadoko
Enthusiast
Enthusiast
Posts: 280
Joined: Thu Jul 09, 2015 9:07 am

Re: Physics - Helicopter

Post by pf shadoko »

EDIT 30/04/2019
shadows okay
simplification
no more shaking (with physics you have to set the number of milliseconds with RenderWorld (16))
User avatar
Michael Vogel
Addict
Addict
Posts: 2666
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Physics - Helicopter

Post by Michael Vogel »

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'.
User avatar
Psychophanta
Addict
Addict
Posts: 4969
Joined: Wed Jun 11, 2003 9:33 pm
Location: Lípetsk, Russian Federation
Contact:

Re: Physics - Helicopter

Post by Psychophanta »

Thank you!
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend
Will never leave this forum until the absolute bugfree PB :mrgreen:
Post Reply