Code: Select all
;Meridians and Parallels
;by einander
;PB 4.60
EnableExplicit
InitEngine3D()
InitKeyboard()
InitSprite()
;
Structure Vector:X.D:Y.D:Z.D:EndStructure
#RADTODEG=180.0/#PI
Global _CamSpeed.D=1,_VCenter.Vector,_Mainmesh,_Quit
Define Wi,He,I,Siz.Vector
;
Macro GadRGB(Gad,RGB1=$FFFFFF,RGB2=0)
SetGadgetColor(Gad,1,RGB1)
SetGadgetColor(Gad,2,RGB2)
EndMacro
;
Procedure KeyMap(Node,Cam) ; Control moving and rotating with Keyboard
; -------
Macro KBP(Key1,Key2)
(KeyboardPushed(#PB_Key_#Key1) Or KeyboardPushed(#Pb_Key_#Key2))
EndMacro
; -------
If KBP(Add,F1)
MoveCamera(Cam, 0,0, -_CamSpeed*2) ; Move to front
ElseIf KBP(Subtract,F2)
MoveCamera(Cam, 0, 0,_CamSpeed*2) ; Move to rear
; ------------------------------
; Arrow keys; move camera to 4 Directions
ElseIf KeyboardPushed(#PB_Key_Left)
MoveNode(Node, _CamSpeed, 0, 0) ; Move to screen Left
ElseIf KeyboardPushed(#PB_Key_Right)
MoveNode(Node, -_CamSpeed, 0, 0) ; Move to screen Right
ElseIf KeyboardPushed(#PB_Key_Up)
MoveNode(Node, 0,-_CamSpeed, 0) ; Move to screen Top
ElseIf KeyboardPushed(#PB_Key_Down)
MoveNode(Node, 0,_CamSpeed, 0) ; Move to screen Bottom
; -------------------
;PageUp - Insert
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
EndProcedure
;
Procedure MkSphere(Sph,Merid,Paral,*Siz.Vector)
RandomSeed(2)
Paral*2
Protected.D K, J, XStp=360/Merid, YStp=180/Paral
Protected N,A,I, RGB,Arrsiz
Protected Dim Vx.Vector(0)
Repeat
K.D=0
J+YStp
Repeat
ReDim Vx(N)
VX(N)\X =*Siz\X * Sin((K) / #Radtodeg) * Sin((J) / #Radtodeg)
VX(N)\Y =*Siz\Y * Cos((K) / #Radtodeg) * Sin((J) / #Radtodeg)
VX(N)\Z =*Siz\Z * Cos((J) / #Radtodeg)
N+1
K+XStp
Until K>=359
J+YStp
Until J>=179
Arrsiz=ArraySize(Vx())
For I = 0 To Arrsiz
If I%Merid=0
RGB=Random($FFFFFF)
EndIf
CreateEntity(I,MeshID(Sph),#PB_Material_None,Vx(I)\X,Vx(I)\Y,Vx(I)\Z) ; parallels
If I%Merid: A=I-1
Else : A=I+Merid-1
EndIf
CreateLine3D(I,Vx(A)\X,Vx(A)\Y,Vx(A)\Z,RGB,Vx(I)\X,Vx(I)\Y,Vx(I)\Z,RGB)
If I<Arrsiz-Merid+1
A=I+Merid
CreateLine3D(I+Arrsiz+1,Vx(A)\X,Vx(A)\Y,Vx(A)\Z,RGB,Vx(I)\X,Vx(I)\Y,Vx(I)\Z,RGB) ; meridians
EndIf
Next
Dim Vx(0)
ProcedureReturn Arrsiz
EndProcedure
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Define T$= "Keys: Left, Right, Up, Down, PageUp, PageDown, Insert, Delete, Home, End, +, -, F1 to F8, <Spc> to auto rotation."
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 X1=Wi-200
Siz\X=100:Siz\Y=100:Siz\Z=100
Define Merid=6 ; meridians
Define Paral=4 ;parallels
Define Radius.D=0
Define TBX=TrackBarGadget(-1,X1,10,180,26,0,500)
Define TBY=TrackBarGadget(-1,X1,50,180,26,0,500)
Define TBZ=TrackBarGadget(-1,X1,90,180,26,0,500)
Define SpMerid=SpinGadget(-1,X1,170,80,30,1,100,#PB_Spin_Numeric)
Define SpParal=SpinGadget(-1,X1,210,80,30,1,100,#PB_Spin_Numeric)
Define TBSphere=TrackBarGadget(-1,X1,130,180,26,0,300)
Define TG=TextGadget(-1,0,0, Wi-210,24,"")
Define Draw=1,AutoRotate=1
TextGadget(0,X1+90,170,80,26,"Meridians")
TextGadget(1,X1+90,210,80,26,"Parallels")
GadRGB(0,$FFFFFF,0)
GadRGB(1,$FFFFFF,0)
SetGadgetState(SpMerid,Merid)
SetGadgetState(SpParal,Paral)
SetGadgetState(TBX,Siz\X)
SetGadgetState(TBY,Siz\Y)
SetGadgetState(TBZ,Siz\Z)
SetGadgetState(TbSphere,Radius*10)
GadRGB(Tg,$FFFFFF,0)
HideWindow(0,0)
; ------------------------
AntialiasingMode(#PB_AntialiasingMode_x4)
OpenWindowedScreen(WindowID(0),0,24,X1-10,He,0,0,0,#PB_Screen_SmartSynchronization)
KeyboardMode(#PB_Keyboard_International)
Define Sph=CreateSphere(-1,Radius)
Define Arrsiz=MkSphere(Sph,Merid,Paral,Siz)
;
CreateNode(0,0,0,0)
CreateCamera(0, 0, 0, 100, 100)
CameraLocate(0, 0, 0, 400)
AttachNodeObject(0,CameraID(0),#PB_Node_Camera)
;
CreateLight(0, $Ddeeff ,-200, 0 ,-100)
CreateLight(1, $Bbccdd , 200, 0 , 100)
CreateLight(2, $FFff , 0 , 200, 0)
AmbientColor($112233)
Repeat
Select WindowEvent()
Case #PB_Event_CloseWindow :_Quit=#True
Case #PB_Event_Gadget
Select EventGadget()
Case TBX,TBY,TBZ
Siz\X=GetGadgetState(TBX)
Siz\Y=GetGadgetState(TBY)
Siz\Z=GetGadgetState(TBZ)
Arrsiz=MkSphere(Sph,Merid,Paral,Siz)
SetActiveGadget(Tg)
Draw=1
Case SpMerid,SpParal
For I=0 To ArrSiz*2
If IsEntity(I):FreeEntity(I):EndIf
If IsMesh(I) :FreeMesh(I) :EndIf
Next
Merid=GetGadgetState(SpMerid)
Paral=GetGadgetState(SpParal)
Arrsiz=MkSphere(Sph,Merid,Paral,Siz)
SetActiveGadget(Tg)
Draw=1
Case TbSphere
Radius=GetGadgetState(TbSphere)/10
FreeMesh(Sph)
Sph=CreateSphere(-1,Radius)
Arrsiz=MkSphere(Sph,Merid,Paral,Siz)
SetActiveGadget(Tg)
Draw=1
EndSelect
Default
If ExamineKeyboard() Or Draw
If KeyboardPushed(#PB_Key_Escape) :_Quit=#True :EndIf
If KeyboardReleased(#PB_Key_Space):AutoRotate!1:EndIf
If Draw=0:Keymap(0,0) :EndIf
Draw=1
EndIf
EndSelect
If AutoRotate Or Draw
If AutoRotate
RotateNode(0,0,0,0.2,#PB_Relative)
RotateNode(0,0,0.5,0,#PB_Relative)
Draw=1
EndIf
RenderWorld()
FlipBuffers()
Draw=0
EndIf
Until _Quit
End