It is currently Sat Dec 07, 2019 11:11 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 12 posts ] 
Author Message
 Post subject: Physics - Helicopter
PostPosted: Thu Apr 25, 2019 8:39 am 
Offline
User
User

Joined: Thu Jul 09, 2015 9:07 am
Posts: 75
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()


Last edited by pf shadoko on Tue Apr 30, 2019 10:02 am, edited 2 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Physics - Helicopter
PostPosted: Thu Apr 25, 2019 9:00 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Jun 22, 2003 7:43 pm
Posts: 461
Location: Germany, Saarbrücken
I don't get how to fly this thing. :lol:

_________________
Electronics, Crazy & Interesting Stuff, all that with text, image and sound? Click here!

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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Physics - Helicopter
PostPosted: Thu Apr 25, 2019 9:08 am 
Offline
Moderator
Moderator
User avatar

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 1108
Location: Berlin (Germany)
@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. :)

_________________
ImageImageImageImage Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Physics - Helicopter
PostPosted: Thu Apr 25, 2019 9:11 am 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Jun 22, 2003 7:43 pm
Posts: 461
Location: Germany, Saarbrücken
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.

_________________
Electronics, Crazy & Interesting Stuff, all that with text, image and sound? Click here!

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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Physics - Helicopter
PostPosted: Thu Apr 25, 2019 11:38 am 
Offline
Enthusiast
Enthusiast

Joined: Thu Apr 18, 2019 8:17 am
Posts: 429
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Physics - Helicopter
PostPosted: Thu Apr 25, 2019 12:04 pm 
Offline
Moderator
Moderator
User avatar

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 1108
Location: Berlin (Germany)
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).

_________________
ImageImageImageImage Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Physics - Helicopter
PostPosted: Thu Apr 25, 2019 12:57 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4542
Location: Lyon - France
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)

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
 Post subject: Re: Physics - Helicopter
PostPosted: Thu Apr 25, 2019 4:07 pm 
Offline
User
User

Joined: Thu Jul 09, 2015 9:07 am
Posts: 75
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?


Top
 Profile  
Reply with quote  
 Post subject: Re: Physics - Helicopter
PostPosted: Thu Apr 25, 2019 4:19 pm 
Offline
Moderator
Moderator
User avatar

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 1108
Location: Berlin (Germany)
Now works. Thank you

_________________
ImageImageImageImage Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Physics - Helicopter
PostPosted: Tue Apr 30, 2019 10:02 am 
Offline
User
User

Joined: Thu Jul 09, 2015 9:07 am
Posts: 75
EDIT 30/04/2019
shadows okay
simplification
no more shaking (with physics you have to set the number of milliseconds with RenderWorld (16))


Top
 Profile  
Reply with quote  
 Post subject: Re: Physics - Helicopter
PostPosted: Tue Apr 30, 2019 3:32 pm 
Offline
Addict
Addict
User avatar

Joined: Thu Feb 09, 2006 11:27 pm
Posts: 2455
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'.


Top
 Profile  
Reply with quote  
 Post subject: Re: Physics - Helicopter
PostPosted: Sun May 19, 2019 12:13 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Jun 11, 2003 9:33 pm
Posts: 4580
Location: Spa, relaxing and thinking, and learning...
Thank you!

_________________
http://www.zeitgeistmovie.com

While world=business:world+mafia:Wend


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 12 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 1 guest


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye