PureBasic Forums - English

Code: Select all

;Stick and ball cubic grid
;by einander - PB 4.60
EnableExplicit
Define Wi,He,Ev
InitEngine3D()
InitKeyboard()
InitSprite()
#Box=1
#Ellip=2
Global _CamSpeed.D=1,_Quit,I
Global Dim _Attached(0)
;
#Left=1 
#Top=2
#Right=4
#Bottom=8
#Front=16
#Rear=32
;
Structure SB
  Stick.I
  Ball.I
  Rim.D
  Sz.D
  Rad.D
  Ang.D  
  DefBall.I  
  ;  DefBox.I  
EndStructure
;
Define SB.SB  ; 
;
Procedure KeyMap(Node,Cam)  ; Control  moving and rotating with Keyboard
  ;keys: Left,Right,Up,Down,PageUp,PageDown,Insert,Delete,Home,End ,+,-, F1 to F8
  ; -------
  Macro KBP(Key1,Key2)
    (KeyboardPushed(#PB_Key_#Key1) Or KeyboardPushed(#Pb_Key_#Key2))
  EndMacro
  ; -------
  If KBP(Add,F1)         
    MoveNode(Node, 0,0, _CamSpeed*2)                 ; Absolute move to front
  ElseIf KBP(Subtract,F2)         
    MoveNode(Node, 0, 0,-_CamSpeed*2)                  ; Absolute move to rear
    ; ------------------------------
    ; Arrow keys; move camera to 4 absolute directions
  ElseIf KeyboardPushed(#PB_Key_Left)             
    MoveNode(Node, -_CamSpeed/2, 0, 0)                  ; Move to screen Left
  ElseIf KeyboardPushed(#PB_Key_Right)             
    MoveNode(Node, _CamSpeed/2, 0, 0)                 ; Move to screen Right
  ElseIf KeyboardPushed(#PB_Key_Up)             
    MoveNode(Node, 0,_CamSpeed/2, 0)                  ; Move to screen Top
  ElseIf KeyboardPushed(#PB_Key_Down)             
    MoveNode(Node, 0,-_CamSpeed/2, 0)                   ; Move to screen Bottom
    ; -------------------
    ;PageUp - Insert : Home - End : Delete - PageDown ; 6 rotations relative to object position
  ElseIf KBP(F3,PageUp)
    RotateNode(Node,0,0,-_CamSpeed*2,#PB_Relative)        ; Turn Left
  ElseIf KBP(F4,Insert)
    RotateNode(Node,0,0,_CamSpeed*2,#PB_Relative)       ; Turn Right
    ; ---------------------
    ;Home / End     
  ElseIf KBP(F5,Home)
    RotateNode(Node,-_CamSpeed,0,0,#PB_Relative)       ; Turn back
  ElseIf KBP(F6,End)
    RotateNode(Node,_CamSpeed,0,0,#PB_Relative)        ; Turn front
    ; -------------
    ;Delete / PageDown
  ElseIf KBP(F7,Delete)
    RotateNode(Node,0,- _CamSpeed,0,#PB_Relative)       ; Rotation Left
  ElseIf KBP(F8,PageDown)
    RotateNode(Node,0, _CamSpeed,0,#PB_Relative)      ; Rotation Right
  EndIf
  ;NodeLookAt(Node,0,0,0)  
EndProcedure
;
Procedure GetTexture(Texture,RGB=0)
  Protected Index=CreateTexture(Texture,1,1)
  If Texture=#PB_Any:Texture=Index:EndIf
  StartDrawing(TextureOutput(Texture))
  Plot(0,0,RGB)
  StopDrawing()
  ProcedureReturn Texture
EndProcedure
;
Procedure GetMaterial(Material,Texture,BLendingMode=#PB_Any) ;#PB_Material_Add ,#PB_Material_AlphaBLend,#PB_Material_Color             
  Protected Index=CreateMaterial(Material,TextureID(Texture))
  If Material=#PB_Any:Material=Index:EndIf
  If BLendingMode>#PB_Any
    MaterialBlendingMode(Material,BLendingMode)
  EndIf
  ProcedureReturn Material
EndProcedure 
;
Procedure GetCylinder(Entity,Cylinder,Material,X.D,Y.D,Z.D,Xsiz.D=0,Ysiz.D=0,Zsiz.D=0)
  Protected Index=CreateEntity(Entity, MeshID(Cylinder), MaterialID(Material))
  If Entity=#PB_Any:Entity=Index:EndIf
  EntityLocate(Entity, X,Y,Z)
  ResizeEntity(Entity,Xsiz,Ysiz,Zsiz)
  ;EntityRenderMode(Entity, #PB_Entity_CastShadow) 
  ProcedureReturn Entity
EndProcedure
;
Procedure GetSphere(Entity,Sphere,Material,X.D,Y.D,Z.D,Xsiz.D=0,Ysiz.D=0,Zsiz.D=0)
  Protected Index=CreateEntity(Entity, MeshID(Sphere), MaterialID(Material))
  If Entity=#PB_Any:Entity=Index:EndIf
  EntityLocate(Entity, X,Y,Z)
  ResizeEntity(Entity,Xsiz,Ysiz,Zsiz)
  ;EntityRenderMode(Entity, #PB_Entity_CastShadow)
  ProcedureReturn Entity
EndProcedure
;
Procedure Detach(Node)
  For I=0 To ArraySize(_Attached())
    If _Attached(I)>#PB_Any   
      DetachNodeObject(Node,EntityID(I),#PB_Node_Entity)
      _Attached(I)=#PB_Any
    EndIf  
  Next
EndProcedure
;
Procedure SB(Index,Material,*Sb.Sb,X.D,Y.D,Z.D,Way=#PB_Any,Xsiz.D=0,Ysiz.D=#PB_Any,Zsiz.D=#PB_Any,Node=0)
  With *Sb
    If Ysiz=#PB_Any:Ysiz=Xsiz:EndIf
    If Zsiz=#PB_Any:Zsiz=Xsiz:EndIf
    If Way>#PB_Any ; is stick
      Protected.D Ang1,Ang2
      GetCylinder(Index,\Stick,Material,0,0,0,\Rim,\Sz,\Rim)
      Select Way 
        Case #Left    : Xsiz-\Sz:Ang2=\Ang
        Case #Right   : Xsiz+\Sz:Ang2=\Ang
        Case #Top     : Ysiz+\Sz
        Case #Bottom  : Ysiz-\Sz
        Case #Front   : Zsiz+\Sz:Ang1=\Ang
        Case #Rear    : Zsiz-\Sz:Ang1=\Ang
      EndSelect
      EntityLocate(Index,X+Xsiz,Y+Ysiz,Z+Zsiz)
      RotateEntity(Index,Ang1,0,Ang2)
    Else ; is ball
      GetSphere(Index,\Defball,Material,X,Y,Z,Xsiz,Ysiz,Zsiz)
      ; To Do - here draw label text over ball <<<<<<<<<<<<<<<<<<<<<<<<
    EndIf
    AttachNodeObject(Node,EntityID(Index),#PB_Node_Entity)
    _Attached(Index)  =Index 
  EndWith
EndProcedure
;
Procedure MkGrid(*SB.SB,Xnr=6,Ynr=5,Znr=4) 
  With *SB
    Protected L.D=\Sz*2
    Protected Index,A,X,Y,Z,Xpo,Ypo,Zpo,Lx,Ly,Lz
    Zpo=-Znr/2
    For Z=0 To Znr-1
      Ypo=-Ynr/2
      For Y=0 To Ynr-1
        XPo=-Xnr/2
        For X=0 To Xnr-1
          LX=L*Xpo
          LY=L*Ypo
          LZ=L*Zpo
          If X<Xnr-1 
            SB(Index    , 1,*Sb, LX  ,LY  ,LZ  , #Right) ; stick to Right
          EndIf
          If Y<Ynr-1
            SB(Index+1  , 2,*Sb, LX  ,LY  ,LZ  , #Top)   ; stick to top
          EndIf
          If Z<Znr-1
            SB(Index+2  , 3,*Sb, LX  ,LY  ,LZ  , #Front) ;stick to front
          EndIf
          SB(Index+3, 4,*Sb, LX  , LY  ,LZ  , #PB_Any,\Rad) ; ball
          Xpo+1  
          Index+4  
        Next
        Ypo+1
      Next
      Zpo+1  
    Next
  EndWith  
EndProcedure
;
;<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Define T$="Stick and ball cubic grid - Keys: Left, Right, Up, Down, PageUp, PageDown, Insert, Delete, Home, End, +, -, F1 to F8"
OpenWindow(0, 100, 100,700,500 ,T$,#PB_Window_SystemMenu|#PB_Window_Maximize|#PB_Window_Invisible)
SetWindowColor(0,0)
Wi=WindowWidth(0)
He=WindowHeight(0)
Define X=Wi-200
Define _xCenter=Wi/2 ,_yCenter=He/2
Define Tb1=TrackBarGadget(#PB_Any,X,10,180,26,0,3000)
Define Tb2=TrackBarGadget(#PB_Any,X,40,180,26,0,3000)
Define TG=TextGadget(#PB_Any,0,0,Wi-210,24,"")
;------------------------
AntialiasingMode(#PB_AntialiasingMode_x4) 
OpenWindowedScreen(WindowID(0),0,0,X-10,He,0,0,0,#PB_Screen_SmartSynchronization)
With SB
  \Rim=1
  \SZ=10
  \Rad=2
  \Ang=90 
  SetGadgetState(Tb2, \Rad*500)
  SetGadgetState(Tb1, \Rim*500)
  ;WorldShadows(#PB_Shadow_Additive) ; too slow!!!
  \Ball=CreateSphere(#PB_Any,1)
  ;--------------
  ;\stick=CreateCube(#pb_any,2)          ; alternative 
  ;\Stick=CreateSphere(#pb_any,\Rim)     ; alternative 
  \Stick=CreateCylinder(#PB_Any,\Rim,2)  ; standard stick 
  ;----------
  \DefBall=CreateSphere(#PB_Any,\Rim)
  CreateNode(0,0,0,0)
  ; Textures & Materials
  Define BlendingMode=#PB_Any ;#PB_Material_Color  ;  try #PB_Material_Color for transparency
  GetTexture(0, $232323) :Getmaterial(0,0,BlendingMode)  
  GetTexture(1, $3C14DC) :Getmaterial(1,1,BlendingMode)  
  GetTexture(2, $00FC7C) :Getmaterial(2,2,BlendingMode)  
  GetTexture(3, $FF901E) :Getmaterial(3,3,BlendingMode)
  GetTexture(4, $00FFFF) :Getmaterial(4,4,BlendingMode)
  GetTexture(5, $FF00FF) :Getmaterial(5,5,BlendingMode)
  GetTexture(6, $FFFF00) :Getmaterial(6,6,BlendingMode)
  Define Xnr=6,Ynr=5,Znr=4  ; Test more sizes, but keep it small!!  <<<<<<<<<<<<<<<
  Dim _Attached(Xnr*Ynr*Znr*4)
  For I=0 To ArraySize(_Attached())
    _Attached(I)=#PB_Any
  Next
  MkGrid(SB,Xnr,Ynr,Znr)
  ;.....................
  CreateCamera(0, 0, 0, 100, 100)
  CameraLocate(0, 0, 0,200)
  CreateLight(0, #White , 0  ,-50 ,300)
  CreateLight(1, $C4E4FF, 200, 0  , 0)
  CreateLight(2, $D3D3D3, 0  , 100, 0)
  CreateLight(3, $908070, 0  ,-200, -110)
  AmbientColor($223344)
  Define Hit=6
  Define Draw=#True
  HideWindow(0,0)
  Repeat
    Ev=WindowEvent()
    If Ev
      Select Ev 
        Case #PB_Event_CloseWindow:_Quit=#True
        Case #PB_Event_Gadget
          Select EventGadget()
            Case Tb1
              Detach(0)
              \Rim=GetGadgetState(Tb1)/500
              MkGrid(Sb,Xnr,Ynr,Znr)    
              SetActiveGadget(Tg)
            Case Tb2
              Detach(0)
              \Rad=GetGadgetState(Tb2)/500
              MkGrid(SB,Xnr,Ynr,Znr)    
              SetActiveGadget(Tg)
          EndSelect
      EndSelect
    EndIf
    If ExamineKeyboard() 
      If KeyboardPushed(#PB_Key_Escape):_Quit=#True:EndIf  
      Keymap(0,0) 
      Draw=#True  
    EndIf
    If Draw
      RenderWorld()
      FlipBuffers()
      Draw=0
    EndIf
  Until _Quit
EndWith
End