Add 3d entities on the fly

einander · Post by **einander** » Mon Sep 12, 2011 8:26 pm

Many thanks to Comtois for lots of 3d examples.
Set Opengl in Compiler Options/Library Subsystem
Based on many Comtois examples

Code: Select all

;By einander
;Updated For PB 5.20 LTS
EnableExplicit
Define.I Ev,Wi,He,Bwi,Bhe,X,X1,Index,Gad
#CamSpeed = 2
Define Side=64,I,Sprite1,Mesh1,FlaGadd,Camx,Camy,Camz,Type
Define.F Dx, Dy, Dz,A,B,C
Define Layx,Layy,Layz,Size,A$
Define.F XLeft,XRight,YLeft,YRight,ZLeft,ZRight
Define XAxis,YAxis,ZAxis,BtnCube,BtnSphere,BtnCylinder,BtnAutoMove,Automove,Movecam
Define.I XAxisLeft,XAxisRight,YAxisLeft,YAxisRight,ZAxisLeft,ZAxisRight
Define D,E,Way=1, Time = ElapsedMilliseconds()
Enumeration 1
  #Cube
  #Sphere
  #Cylinder
EndEnumeration
;
#DDGray=$303030
#MARFIL=$CDFFFF
#PB_Engine_Space_Local=1
#PB_Engine_Space_Parent=2
#PB_Engine_Space_World=4
#PB_Engine_Absolute_Rotation=8
#PB_Engine_Relative_Rotation=16
#PB_Engine_Quaternion_Rotation=32
#PB_Engine_Euler_Rotation=64
Dim Type.S(3)
Type(#Cube)="Cube"
Type(#Sphere)="Sphere"
Type(#Cylinder)="Cylinder"
;
Structure Obj
  Index.I
  Size.F 
EndStructure
;
Global NewMap _Obj.Obj()
Global _ShowAxis=1,_ShowEdges=1
;
InitEngine3D()
InitSprite()
InitKeyboard()
ExamineDesktops()
Dim Edge(11)
;
Macro GadgetBottom(Gad)  :  GadgetY(Gad)+GadgetHeight(Gad)  : EndMacro
;
Macro GadgetRight(Gad)  :  GadgetX(Gad)+GadgetWidth(Gad)  : EndMacro
;
Macro MMk
  Abs(GetAsyncKeyState_(#VK_LBUTTON) +GetAsyncKeyState_(#VK_RBUTTON)*2+GetAsyncKeyState_(#VK_MBUTTON)*3)/$8000   
EndMacro
;
Macro GadRGB(Gad,RGB1=#Marfil,RGB2=#DGreen)
  SetGadgetColor(Gad,1,RGB1): SetGadgetColor(Gad,2,RGB2)   
EndMacro
;
Procedure.F LimF(A.F,B.F,C.F)
  If A<B :ProcedureReturn B
  ElseIf A>C :ProcedureReturn C
  EndIf
  ProcedureReturn A
EndProcedure
;
Macro Link(E1,E2,RGB1=#DdGray,RGB2=#DdGray)
  CreateLine3D(#PB_Any,EntityX(E1),EntityY(E1),EntityZ(E1),RGB1,EntityX(E2),EntityY(E2),EntityZ(E2),RGB2)
EndMacro
;
Macro XYZ2XY(Cam,Entity,Pointf)
  Pointf\X=CameraProjectionX(Cam,EntityX(Entity),EntityY(Entity),EntityZ(Entity))
  Pointf\Y=CameraProjectionY(Cam,EntityX(Entity),EntityY(Entity),EntityZ(Entity)) 
EndMacro
;
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
OpenWindow(0, 0, 0, 800,600,"",#PB_Window_Maximize) ;|#PB_Window_BorderLess)
SetWindowColor(0,0)
Wi=WindowWidth(0)
He=WindowHeight(0)
Bwi=40
Bhe=20
X=Wi-135
X1=X+Bwi+1
XLeft=ButtonGadget(-1,X,10,Bwi,20,"Left")
XRight=ButtonGadget(-1,X1,10,Bwi,20,"Right")
YLeft=ButtonGadget(-1,X,30,Bwi,20,"Up")
YRight=ButtonGadget(-1,X1,30,Bwi,20,"Down")
ZLeft=ButtonGadget(-1,X,50,Bwi,20,"Far")
ZRight=ButtonGadget(-1,X1,50,Bwi,20,"Near")
;
XAxisLeft=HyperLinkGadget(-1,X,110,Bwi,20,"-X",0)
XAxisRight=HyperLinkGadget(-1,X1,110,Bwi,20,"+X",0)
YAxisLeft=HyperLinkGadget(-1,X,131,Bwi,20,"-Y",0)
YAxisRight=HyperLinkGadget(-1,X1,131,Bwi,20,"+Y",0)
ZAxisLeft=HyperLinkGadget(-1,X,152,Bwi,20,"-Z",0)
ZAxisRight=HyperLinkGadget(-1,X1,152,Bwi,20,"+Z",0)
GadRGB(XAxisLeft,#White,#Red)
GadRGB(XAxisRight,#White,#Red)
GadRGB(YAxisLeft,#White,#Green)
GadRGB(YAxisRight,#White,#Green)
GadRGB(ZAxisLeft,#White,#Blue)
GadRGB(ZAxisRight,#White,#Blue)
;
Btncube=ButtonGadget(-1,X,Gadgetbottom(ZAxisLeft)+20,80,24,"Add Cube")
BtnSphere=ButtonGadget(-1,X,Gadgetbottom(Btncube)+10,80,24,"Add Sphere")
BtnCylinder=ButtonGadget(-1,X,Gadgetbottom(Btnsphere)+10,80,24,"Add Cylinder")
BtnAutoMove=ButtonGadget(-1,X,Gadgetbottom(BtnCylinder)+20,80,24,"AutoMove",#PB_Button_Toggle)
;-------------
OpenWindowedScreen(WindowID(0), 0, 0, Wi-140,He, 0, 0, 0,#PB_Screen_SmartSynchronization)
;AntialiasingMode(#PB_AntialiasingMode_x2)
CreateLight(0, #Marfil, 0, 300, 0,  #PB_Light_Directional)
;WorldShadows(#PB_Shadow_Additive)
;WorldShadows( #PB_Shadow_TextureAdditive  )
CreateSphere(0, 0) ;
Index+1
;Edges
Restore Vertex
For I = 0 To 7
  Read.F A:Read.F B:Read.F C
  Edge(I)=CreateEntity(-1, MeshID(0), #PB_Material_None,A*Side,B*Side,C*Side)
Next I
;
Restore Edges
For I=0 To 11
  Read.I D:Read.I E
  Link(Edge(D),Edge(E))
Next
;Axis
XAxis=CreateLine3D(-1, 0, 0, 0, #Red  ,Side,0   ,0   ,#Red)
YAxis=CreateLine3D(-1, 0, 0, 0, #Green,0   ,Side,0   ,#Green)
ZAxis=CreateLine3D(-1, 0, 0, 0, #Blue ,0   ,0   ,Side,#Blue)  ;
;Mesh
Mesh1=CreateMesh(-1)
MeshVertexPosition(-1, 0, 0)
MeshVertexPosition( 0,-1, 0)
MeshVertexPosition( 0, 0,-1)
MeshVertexPosition( 0, 0, 0)
;-Camera
CreateCamera(0, 0, 0, 100, 100)
MoveCamera(0, 0, 0, 300,#PB_Absolute)
AmbientColor($A5)
;
Repeat
  Repeat
    If GetAsyncKeyState_(27)&$8000 :  End : EndIf
    Ev=WindowEvent()
    Select Ev 
      Case #PB_Event_Gadget
        Select EventGadget()
          Case BtnAutoMove:AutoMove=GetGadgetState(BtnAutoMove)         
        EndSelect
      Default
        If MMk=1
          Gad=   GetDlgCtrlID_(WindowFromPoint_(DesktopMouseX()|DesktopMouseY()<<32 ))
          Select Gad
            Case XLeft :  MoveCamera(0,2.5, 0  , 0  ) :Way=1
            Case XRight:  MoveCamera(0, -2.5, 0  , 0  ) :Way=-1
            Case YLeft :  MoveCamera(0, 0  ,-2.5, 0  )
            Case YRight:  MoveCamera(0, 0  , 2.5, 0  )
            Case ZLeft :  MoveCamera(0, 0  , 0  , 2.5)
            Case ZRight:  MoveCamera(0, 0  , 0  ,-2.5)
            Case XAxisLeft : Layx+1
            Case XAxisRight: Layx-1
            Case YAxisLeft : Layy+1
            Case YAxisRight: Layy-1
            Case ZAxisLeft : Layz+1
            Case ZAxisRight: Layz-1
            Case Btncube
              Size=10:CreateCube(Index,Size):FlaGadd=1:Type=#Cube
            Case BtnSphere
              Size=5:CreateSphere(Index,Size):FlaGadd=1:Type=#Sphere
            Case BtnCylinder
              Size=20:CreateCylinder(Index,5,Size):FlaGadd=1:Type=#Cylinder
          EndSelect
          If FlaGadd
            FlaGadd=0
            A$=Str(Type)+" "+Str(Layx)+" "+Str(Layy)+" "+Str(Layz)
            If Not FindMapElement(_Obj(),A$) ; avoid duplicated objects on same position
              CreateEntity(Index,MeshID(Index), #PB_Material_None,Layx,Layy,Layz)
              EntityRenderMode(Index,#PB_Entity_CastShadow )
              _Obj(A$)\Index=Index
              _Obj()\Size=Size
              Index+1
            EndIf 
          EndIf
        EndIf
    EndSelect
    If _ShowAxis
      Layx=Limf(Layx,-Side,Side)
      Layy=Limf(Layy,-Side,Side)
      Layz=Limf(Layz,-Side,Side)
      If XAxis:FreeMesh(XAxis):FreeMesh(YAxis):FreeMesh(ZAxis): EndIf
      XAxis=CreateLine3D(-1, Side, Layy,Layz, #Red  ,Layx,Layy,Layz  ,#Red)
      YAxis=CreateLine3D(-1, Layx, Side,Layz, #Green,Layx,Layy,Layz   ,#Green)
      ZAxis=CreateLine3D(-1, Layx,Layy,Side ,#Blue,Layx,Layy,Layz   ,#Blue)
    Else
      If XAxis
        FreeMesh(XAxis):FreeMesh(YAxis):FreeMesh(ZAxis)
        XAxis=0 
      EndIf
    EndIf
  Until Ev=0 Or Ev=16
  If ExamineKeyboard()
    If KeyboardPushed(#PB_Key_Left)
      CamX = -#CamSpeed
    ElseIf KeyboardPushed(#PB_Key_Right)
      CamX = #CamSpeed
    Else
      CamX = 0
    EndIf
    If KeyboardPushed(#PB_Key_Up)
      CamY = -#CamSpeed
    ElseIf KeyboardPushed(#PB_Key_Down)
      CamY = #CamSpeed
    Else
      CamY = 0
    EndIf
    If KeyboardPushed(#PB_Key_PageUp)
      Camz = -#CamSpeed
    ElseIf KeyboardPushed(#PB_Key_PageDown)
      Camz = #CamSpeed
    Else
      Camz = 0
    EndIf
    Movecam=1 
  EndIf
  ;   
  If AutoMove Or MoveCam
    If AutoMove
      If ElapsedMilliseconds()-Time> 2000
        Camx=#CamSpeed*Way
      EndIf
    EndIf
    MoveCamera(0, Camx, CamY, CamZ)
    CameraLookAt(0,0,0,0) ; keeps camera centered
    RenderWorld()
    FlipBuffers()
    Movecam=0 
  EndIf
Until KeyboardPushed(#PB_Key_Escape) Or Ev=16
End
;
DataSection
  Vertex:
  Data.F 1,1,1
  Data.F 1,1,-1
  Data.F 1,-1,1
  Data.F 1,-1,-1
  Data.F -1,-1,-1
  Data.F -1,-1,1
  Data.F -1,1,-1
  Data.F -1,1,1
  Edges:
  Data.I 0,1,0,2,0,7
  Data.I 1,3,1,6,2,3
  Data.I 2,5,3,4,4,5
  Data.I 4,6,5,7,6,7
EndDataSection

dige · Post by **dige** » Tue Sep 13, 2011 6:03 am

That rocks!

Thank you for sharing!!

einander · Post by **einander** » Thu Sep 15, 2011 1:22 am

You're welcome

Kwai chang caine · Post by **Kwai chang caine** » Sat Sep 17, 2011 5:54 pm

Thanks a lot for this great job

einander · Post by **einander** » Sat Sep 17, 2011 8:15 pm

@KCC: Great is the Engine3D, that allows to do complex constructions with few lines.

Cheers!

einander · Post by **einander** » Wed Oct 23, 2013 12:34 pm

Updated for PB 5.20

IdeasVacuum · Post by **IdeasVacuum** » Wed Oct 23, 2013 2:49 pm

An incredibly small amount of code for impressive functionality.

IdeasVacuum · Post by **IdeasVacuum** » Wed Oct 23, 2013 2:56 pm

[PB5.20LTS WinXPx86 DX9c]
Wow, hit a very strange problem. I copied/pasted einander's code and ran it - works beautifully, can give it a real hammering with tons of Objects added. However, if I save the code as a .pb file, it won't run! InitEngine3D() fails every time.

How wierd is that? Just to be sure, copied/pasted the .pb contents into a new file, without saving - again, works absolutely fine...........

Edit: Tried unchecking all compiler options, OpenGL, it always fails. Yet, I can run tons of other samples, including some complex ones posted by ApplePi. Confused.com

Edit2: Oh dear - an old stray copy of Engine3D.dll is the culprit

PureBasic Forums - English

Add 3d entities on the fly

Add 3d entities on the fly

Re: Add 3d entities on the fly

Re: Add 3d entities on the fly

Re: Add 3d entities on the fly

Re: Add 3d entities on the fly

Re: Add 3d entities on the fly

Re: Add 3d entities on the fly

Re: Add 3d entities on the fly