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
