Meridians and Parallels

Share your advanced PureBasic knowledge/code with the community.
Post Reply
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Re: Meridians and Parallels

Post by einander »

I have nVidia cards on both PCs.
May be a ATI issue?
Top
Thade
Enthusiast
Enthusiast
Posts: 266
Joined: Sun Aug 03, 2003 12:06 am
Location: Austria

Re: Meridians and Parallels

Post by Thade »

Thanks for sharing :D



Btw.: Works without problem on PB 5.00 Beta 3
--------------
Yes, its an Irish Wolfhound.
Height: 107 cm; Weight: 88 kg
Top
User avatar
Comtois
Addict
Addict
Posts: 1431
Joined: Tue Aug 19, 2003 11:36 am
Location: Doubs - France

Re: Meridians and Parallels

Post by Comtois »

einander wrote: I need advice to replace the links between spheres with CreateCylinder instead of CreateLine3D.
How can a cylinder be aligned knowing the x,y,z positions for the top an bottom?
Here all commands needed :

Code: Select all

;First create a cylinder 
Cyl=CreateCylinder(-1, 4, 1)
;Then change his origin
TransformMesh(Cyl, 0, 0.5, 0, 1, 1, 1, 0, 0, 0)

;Create an entity 
CreateEntity(I+Arrsiz+1, MeshID(Cyl), #PB_Material_None, Vx(A)\X,Vx(A)\Y,Vx(A)\Z)
;Scale the entity 
ScaleEntity(I+Arrsiz+1, 1, Distance(Vx(A)\X,Vx(A)\Y,Vx(A)\Z,Vx(I)\X,Vx(I)\Y,Vx(I)\Z), 1) 
;Orientation entity
EntityLookAt(I+Arrsiz+1, Vx(I)\X,Vx(I)\Y,Vx(I)\Z, 0, 1, 0)

i have a bug (if meridian is impair, then it's ok), but here an example showing how to replace the links between spheres with CreateCylinder instead of CreateLine3D.

Code: Select all

;Meridians and Parallels
;by einander
;Adapted to PB 5, small improvements

EnableExplicit
InitEngine3D()
InitKeyboard()
InitSprite()
Global Cyl
;
Structure Vector:X.D:Y.D:Z.D:EndStructure
#RADTODEG=180.0/#PI
Global _CamSpeed.D=1,_VCenter.Vector,_Mainmesh,_BtnLink,_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.f Distance(x1.f, y1.f, z1.f, x2.f, y2.f, z2.f)
  ProcedureReturn Sqr((x1-x2)*(x1-x2)+(y1-y2)*(y1-y2)+(z1-z2)*(z1-z2))
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     
    If GetGadgetState(_btnLink)
      CreateEntity(I+Arrsiz+1, MeshID(Cyl), #PB_Material_None, Vx(A)\X,Vx(A)\Y,Vx(A)\Z)
      ScaleEntity(I+Arrsiz+1, 1, Distance(Vx(A)\X,Vx(A)\Y,Vx(A)\Z,Vx(I)\X,Vx(I)\Y,Vx(I)\Z), 1) 
      EntityLookAt(I+Arrsiz+1, Vx(I)\X,Vx(I)\Y,Vx(I)\Z, 0, 1, 0)
      ;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
        CreateEntity(I+(Arrsiz+1)*2, MeshID(Cyl), #PB_Material_None, Vx(A)\X,Vx(A)\Y,Vx(A)\Z)
        ScaleEntity(I+(Arrsiz+1)*2, 1, Distance(Vx(A)\X,Vx(A)\Y,Vx(A)\Z,Vx(I)\X,Vx(I)\Y,Vx(I)\Z), 1) 
        EntityLookAt(I+(Arrsiz+1)*2, Vx(I)\X,Vx(I)\Y,Vx(I)\Z, 0, 1, 0)
        ;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
    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=7 ; meridians
Define Paral=4  ;parallels
Define Radius.D=1
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)
_BtnLink=ButtonGadget(-1,x1,250,80,30,"Links",#PB_Button_Toggle)
SetGadgetState(_btnlink,1)
Define TBRadius=TrackBarGadget(-1,X1,130,180,26,0,300)
GadgetToolTip(tbRadius,"Balls radius")
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)   
GadgetToolTip(tbx,"Size X")
GadgetToolTip(tby,"Size Y")
GadgetToolTip(tbz,"Size Z")
;
SetGadgetState(TbRadius,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)
Cyl=CreateCylinder(-1, 4, 1)
TransformMesh(Cyl, 0, 0.5, 0, 1, 1, 1, 0, 0, 0)
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))
;
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,_btnlink
          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 TbRadius
          Radius=GetGadgetState(TbRadius)/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
Please correct my english
http://purebasic.developpez.com/
Top
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Re: Meridians and Parallels

Post by einander »

Thanks Comtois. Your solution for the replacement of CreateLine3D for Cylinders is what I was looking for. :D

I'm not at home until tomorrow; then I'll try to rebuild the program.

The I+Arrsiz+1 for Createline3d was a really bad idea of mine, and now there is a mess with the #entity parameter assigned to the spheres and cylinders. As the king of Spain said recently "I was wrong. Will not happen again. :mrgreen: "

Now changing the number of meridians or parallels gives strange shapes(, and some nice mad spaceships :shock: ).
Top
User avatar
idle
Always Here
Always Here
Posts: 5839
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Meridians and Parallels

Post by idle »

The update back on page 1 with the 3D Lines works fine on Ubuntu 12.04 x64
thanks
Windows 11, Manjaro, Raspberry Pi OS
Image
Top
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Re: Meridians and Parallels

Post by einander »

@idle: You're welcome.

Replaced CreateLine3D for cylinders, thanks to Comtois.
Added structure Mesh, and some minor changes.

Seems to work fine, excepting when number of meridians are 2,6,10,14....
(that is (n+2)%4=0); then one row of cylinder/parallels is pointing to a wrong angle. (Line 112). Can't find why.

Code: Select all

;Meridians and Parallels
;by einander
;Thanks Comtois for the cylinders scaling and rotation 
EnableExplicit
Structure Vector:X.D:Y.D:Z.D:EndStructure
#RadToDeg=180.0/#PI
Global _CamSpeed.D=1,_VCenter.Vector,_MainMesh,_BtnLink,_Quit
Define Wi,He,I
;
Structure Mesh
  Array Cyl.I(0)
  Array Sph.I(0)
  Array Vx.Vector(0) 
  Siz.Vector
  Ball.I
  Stick.I
  Merid.L
  Paral.L
EndStructure 
;
Define Mesh.Mesh
;
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.F Distance(X1.F, Y1.F, Z1.F, X2.F, Y2.F, Z2.F)
  ProcedureReturn Sqr((X1-X2)*(X1-X2)+(Y1-Y2)*(Y1-Y2)+(Z1-Z2)*(Z1-Z2))
EndProcedure
;
Procedure MkCyl(*Mesh.Mesh,Index,First,Last)
  With *Mesh
    Last+First
    \Cyl(Index)=CreateEntity(-1, MeshID(\Stick), #PB_Material_None, \Vx(Last)\X,\Vx(Last)\Y,\Vx(Last)\Z)
    ScaleEntity(\Cyl(Index), 1, Distance(\Vx(Last)\X,\Vx(Last)\Y,\Vx(Last)\Z,\Vx(First)\X,\Vx(First)\Y,\Vx(First)\Z), 1)
    EntityLookAt(\Cyl(Index), \Vx(First)\X,\Vx(First)\Y,\Vx(First)\Z, 0, 1, 0)
  EndWith  
EndProcedure
;
Procedure MkWorld(*Mesh.Mesh)
  With *Mesh
    Protected.D K,J, XStp=360/\Merid, YStp=180/(\Paral*2)
    Protected Index,I
    Protected VxSiz=  \Merid*\Paral-1  
    Protected MeridLim=VxSiz-\Merid+1
    For I=0 To ArraySize(\Cyl())
      If IsEntity(\Cyl(I)): FreeEntity(\Cyl(I)):EndIf
    Next
    For I=0 To ArraySize(\Sph())
      If IsEntity(\Sph(I)): FreeEntity(\Sph(I)):EndIf
    Next
    Dim \Vx.Vector(VxSiz)
    Dim \Sph(VxSiz)
    Dim \Cyl((\Merid*\Paral*2-1)*2-\Merid-1)
    Repeat
      K=0
      J+YStp
      Repeat
        \VX(Index)\X =\Siz\X *  Sin((K) / #RadToDeg) * Sin((J) / #RadToDeg)
        \VX(Index)\Y =\Siz\Y *  Cos((K) / #RadToDeg) * Sin((J) / #RadToDeg)
        \VX(Index)\Z =\Siz\Z *  Cos((J) / #RadToDeg)
        Index+1
        K+XStp
      Until K>=359
      J+YStp
    Until J>=179
    Index=0
    For I = 0 To VxSiz 
      \Sph(I)=CreateEntity(-1,MeshID(\Ball),#PB_Material_None,\Vx(I)\X,\Vx(I)\Y,\Vx(I)\Z) ; parallel/meridian balls
      If GetGadgetState(_BtnLink)     ;parallel sticks
        If I%\Merid ; Link with previous node
          ; fails when (number of meridians+2)%4 =0 (2,6,10...)<<  Why??????
          Mkcyl(*Mesh,Index,I,-1)
        Else
          Mkcyl(*Mesh,Index,I,\Merid-1) ; Link last with First 
        EndIf  
        Index+1
        If  I<MeridLim   ; meridian sticks
          Mkcyl(*Mesh,Index,I,\Merid)
          Index+1
        EndIf
      EndIf
    Next
    Dim \Vx(0)
  EndWith  
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
With Mesh
  \Siz\X=100:\Siz\Y=100:\Siz\Z=100
  \Merid=7 ; meridians
  \Paral=4  ;parallels
  Define SphRadius.D=3.25
  Define CylRadius.D=1
  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,210,40,30,1,100,#PB_Spin_Numeric)
  Define SpParal=SpinGadget(-1,X1,250,40,30,1,100,#PB_Spin_Numeric)
  _BtnLink=ButtonGadget(-1,X1,290,80,30,"Links",#PB_Button_Toggle)
  SetGadgetState(_BtnLink,1)
  Define TbSphRadius=TrackBarGadget(-1,X1,130,180,26,0,300)
  GadgetToolTip(TbSphRadius,"Balls radius")
  Define TBCylRadius=TrackBarGadget(-1,X1,170,180,26,0,300)
  GadgetToolTip(TBCylRadius,"Cylinders radius")
  Define TG=TextGadget(-1,0,0, Wi-210,24,"")
  HideGadget(Tg,1)
  Define Draw=1,AutoRotate=1
  TextGadget(0,X1+50,210,80,26,"Meridians")
  TextGadget(1,X1+50,250,80,26,"Parallels")
  SetGadgetColor(0,#PB_Gadget_FrontColor,#White)
  SetGadgetColor(0,#PB_Gadget_BackColor,0)
  SetGadgetColor(1,#PB_Gadget_FrontColor,#White)
  SetGadgetColor(1,#PB_Gadget_BackColor,0)
  SetGadgetState(SpMerid,\Merid)
  SetGadgetState(SpParal,\Paral)
  SetGadgetState(TBX,\Siz\X)   
  SetGadgetState(TBY,\Siz\Y)   
  SetGadgetState(TBZ,\Siz\Z)   
  GadgetToolTip(Tbx,"Size X")
  GadgetToolTip(Tby,"Size Y")
  GadgetToolTip(Tbz,"Size Z")
  ;
  SetGadgetState(TBSphRadius,SphRadius*30)
  SetGadgetState(TbCylRadius,CylRadius*30)
  HideWindow(0,0)
  ; ------------------------
  InitEngine3D()
  InitKeyboard()
  InitSprite()
  OpenWindowedScreen(WindowID(0),0,0,X1-10,He,0,0,0,#PB_Screen_SmartSynchronization)
  AntialiasingMode(#PB_AntialiasingMode_x4)
  KeyboardMode(#PB_Keyboard_International)
  CreateNode(0,0,0,0)
  CreateCamera(0, 0, 0, 100, 100)
  CameraLocate(0, 0, 0, 400)
  AttachNodeObject(0,CameraID(0))
  \Ball=CreateSphere(-1,SphRadius)
  \Stick=CreateCylinder(-1, CylRadius,1/CylRadius)
  TransformMesh(\Stick, 0, 0.5, 0, CylRadius, CylRadius, CylRadius, 0, 0, 0)
  MkWorld(Mesh)
  ;
  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)   
            MkWorld(Mesh)
            SetActiveGadget(Tg)
            Draw=1
          Case SpMerid,SpParal,_BtnLink
            \Merid=GetGadgetState(SpMerid)
            \Paral=GetGadgetState(SpParal)
            MkWorld(Mesh)
            SetActiveGadget(Tg)
            Draw=1
          Case TbSphRadius
            SphRadius=GetGadgetState(TbSphRadius)/30
            If SphRadius<0.1:SphRadius=0.1:EndIf
            \Ball=CreateSphere(-1,SphRadius)
            TransformMesh(\Ball, 0, 0,0, SphRadius, SphRadius, SphRadius, 0, 0, 0)
            MkWorld(Mesh)
            SetActiveGadget(Tg)
            Draw=1
          Case TBCylRadius
            CylRadius=GetGadgetState(TBcylRadius)/30
            If Cylradius<0.1:Cylradius=0.1:EndIf
            \Stick=CreateCylinder(-1, CylRadius,1/CylRadius)
            TransformMesh(\Stick, 0, 0.5, 0, CylRadius, CylRadius, CylRadius, 0, 0, 0)
            MkWorld(Mesh)
            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
EndWith
End
Top
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:
Contact Psychophanta

Re: Meridians and Parallels

Post by Psychophanta »

Just the same behaviour wirh PB5.00B4:
In the line
AntialiasingMode(#PB_AntialiasingMode_x4)
i get
"Invalid memory access: (read error at address 0)"
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
Top
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Re: Meridians and Parallels

Post by einander »

Hi Psychophanta:

Using the Standalone GUI Debugger I get the same error on the line 173 "AntialiasingMode(#PB_AntialiasingMode_x4)", and commenting this line , then on line 175 "Create node(0,0,0,0)", I get the error "Init engine3D must be called before...", but Engine3D is called previously on line 169, so it seems a compiler error.

Without debugger or with the Integrated Ide Debugger, the program runs, but inverting one row of angles when (number of meridians+2)%4 =0 (see lines 108-109). :?:

Tested with Nvidia.
Top
User avatar
Psychophanta
Always Here
Always Here
Posts: 5153
Joined: Wed Jun 11, 2003 9:33 pm
Location: Anare
Contact:
Contact Psychophanta

Re: Meridians and Parallels

Post by Psychophanta »

einander wrote:Hi Psychophanta:

Using the Standalone GUI Debugger I get the same error on the line 173 "AntialiasingMode(#PB_AntialiasingMode_x4)", and commenting this line , then on line 175 "Create node(0,0,0,0)", I get the error "Init engine3D must be called before...", but Engine3D is called previously on line 169, so it seems a compiler error.

Without debugger or with the Integrated Ide Debugger, the program runs, but inverting one row of angles when (number of meridians+2)%4 =0 (see lines 108-109). :?:

Tested with Nvidia.
Definitely the 3D stuff in PB is buggy, very buggy!
http://www.zeitgeistmovie.com

while (world==business) world+=mafia;
Top
User avatar
Comtois
Addict
Addict
Posts: 1431
Joined: Tue Aug 19, 2003 11:36 am
Location: Doubs - France

Re: Meridians and Parallels

Post by Comtois »

einander wrote:Seems to work fine, excepting when number of meridians are 2,6,10,14....
(that is (n+2)%4=0); then one row of cylinder/parallels is pointing to a wrong angle. (Line 112). Can't find why.
Add this line

Code: Select all

    EntityFixedYawAxis(\Cyl(Index), #True)
Before

Code: Select all

    EntityLookAt(\Cyl(Index), \Vx(First)\X,\Vx(First)\Y,\Vx(First)\Z, 0, 1, 0)
Please correct my english
http://purebasic.developpez.com/
Top
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Re: Meridians and Parallels

Post by einander »

@Comtois:Thanks again! Now it works ok with the new EntityFixedYawAxis().
@All: Updated code, works only with PB 5 beta 5.

Code: Select all

;Meridians and Parallels
;by einander
;Thanks Comtois for the cylinders scaling and rotation and usage of EntityFixedYawAxis()
EnableExplicit
;
Structure Vector:X.D:Y.D:Z.D:EndStructure
#RadToDeg=180.0/#PI
Global _CamSpeed.D=1,_VCenter.Vector,_MainMesh,_BtnLink,_Quit
Define Wi,He,I
;
Structure Mesh
  Array Cyl.I(0)
  Array Sph.I(0)
  Array Vx.Vector(0)
  Siz.Vector
  Ball.I
  Stick.I
  Merid.L
  Paral.L
EndStructure
;
Define Mesh.Mesh
;
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.F Distance(X1.F, Y1.F, Z1.F, X2.F, Y2.F, Z2.F)
  ProcedureReturn Sqr((X1-X2)*(X1-X2)+(Y1-Y2)*(Y1-Y2)+(Z1-Z2)*(Z1-Z2))
EndProcedure
;
Procedure MkCyl(*Mesh.Mesh,Index,First,Last)
  With *Mesh
    Last+First
    \Cyl(Index)=CreateEntity(-1, MeshID(\Stick), #PB_Material_None, \Vx(Last)\X,\Vx(Last)\Y,\Vx(Last)\Z)
    ScaleEntity(\Cyl(Index), 1, Distance(\Vx(Last)\X,\Vx(Last)\Y,\Vx(Last)\Z,\Vx(First)\X,\Vx(First)\Y,\Vx(First)\Z), 1)
    EntityFixedYawAxis(\Cyl(Index), #True)  
    EntityLookAt(\Cyl(Index), \Vx(First)\X,\Vx(First)\Y,\Vx(First)\Z, 0, 1, 0)
  EndWith 
EndProcedure
;
Procedure MkWorld(*Mesh.Mesh)
  With *Mesh
    Protected.D K,J, XStp=360/\Merid, YStp=180/(\Paral*2)
    Protected Index,I
    Protected VxSiz=  \Merid*\Paral-1 
    Protected MeridLim=VxSiz-\Merid+1
    For I=0 To ArraySize(\Cyl())
      If IsEntity(\Cyl(I)): FreeEntity(\Cyl(I)):EndIf
    Next
    For I=0 To ArraySize(\Sph())
      If IsEntity(\Sph(I)): FreeEntity(\Sph(I)):EndIf
    Next
    Dim \Vx.Vector(VxSiz)
    Dim \Sph(VxSiz)
    Dim \Cyl((\Merid*\Paral*2-1)*2-\Merid-1)
    Repeat
      K=0
      J+YStp
      Repeat
        \VX(Index)\X =\Siz\X *  Sin((K) / #RadToDeg) * Sin((J) / #RadToDeg)
        \VX(Index)\Y =\Siz\Y *  Cos((K) / #RadToDeg) * Sin((J) / #RadToDeg)
        \VX(Index)\Z =\Siz\Z *  Cos((J) / #RadToDeg)
        Index+1
        K+XStp
      Until K>=359
      J+YStp
    Until J>=179
    Index=0
    For I = 0 To VxSiz
      \Sph(I)=CreateEntity(-1,MeshID(\Ball),#PB_Material_None,\Vx(I)\X,\Vx(I)\Y,\Vx(I)\Z) ; parallel/meridian balls
      If GetGadgetState(_BtnLink)     ;parallel sticks
        If I%\Merid ; Link with previous node
          ; fails when (number of meridians+2)%4 =0 (2,6,10...)<<  Why??????
          Mkcyl(*Mesh,Index,I,-1)
        Else
          Mkcyl(*Mesh,Index,I,\Merid-1) ; Link last with First
        EndIf 
        Index+1
        If  I<MeridLim   ; meridian sticks
          Mkcyl(*Mesh,Index,I,\Merid)
          Index+1
        EndIf
      EndIf
    Next
    Dim \Vx(0)
  EndWith 
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
With Mesh
  \Siz\X=100:\Siz\Y=100:\Siz\Z=100
  \Merid=7 ; meridians
  \Paral=4  ;parallels
  Define SphRadius.D=3.25
  Define CylRadius.D=1
  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,210,40,30,1,100,#PB_Spin_Numeric)
  Define SpParal=SpinGadget(-1,X1,250,40,30,1,100,#PB_Spin_Numeric)
  _BtnLink=ButtonGadget(-1,X1,290,80,30,"Links",#PB_Button_Toggle)
  SetGadgetState(_BtnLink,1)
  Define TbSphRadius=TrackBarGadget(-1,X1,130,180,26,0,300)
  GadgetToolTip(TbSphRadius,"Balls radius")
  Define TBCylRadius=TrackBarGadget(-1,X1,170,180,26,0,300)
  GadgetToolTip(TBCylRadius,"Cylinders radius")
  Define TG=TextGadget(-1,0,0, Wi-210,24,"")
  HideGadget(Tg,1)
  Define Draw=1,AutoRotate=1
  TextGadget(0,X1+50,210,80,26,"Meridians")
  TextGadget(1,X1+50,250,80,26,"Parallels")
  SetGadgetColor(0,#PB_Gadget_FrontColor,#White)
  SetGadgetColor(0,#PB_Gadget_BackColor,0)
  SetGadgetColor(1,#PB_Gadget_FrontColor,#White)
  SetGadgetColor(1,#PB_Gadget_BackColor,0)
  SetGadgetState(SpMerid,\Merid)
  SetGadgetState(SpParal,\Paral)
  SetGadgetState(TBX,\Siz\X)   
  SetGadgetState(TBY,\Siz\Y)   
  SetGadgetState(TBZ,\Siz\Z)   
  GadgetToolTip(Tbx,"Size X")
  GadgetToolTip(Tby,"Size Y")
  GadgetToolTip(Tbz,"Size Z")
  ;
  SetGadgetState(TBSphRadius,SphRadius*30)
  SetGadgetState(TbCylRadius,CylRadius*30)
  HideWindow(0,0)
  ; ------------------------
  InitEngine3D()
  InitKeyboard()
  InitSprite()
  OpenWindowedScreen(WindowID(0),0,0,X1-10,He,0,0,0,#PB_Screen_SmartSynchronization)
  AntialiasingMode(#PB_AntialiasingMode_x4)
  KeyboardMode(#PB_Keyboard_International)
  CreateNode(0,0,0,0)
  CreateCamera(0, 0, 0, 100, 100)
  CameraLocate(0, 0, 0, 400)
  AttachNodeObject(0,CameraID(0))
  \Ball=CreateSphere(-1,SphRadius)
  \Stick=CreateCylinder(-1, CylRadius,1/CylRadius)
  TransformMesh(\Stick, 0, 0.5, 0, CylRadius, CylRadius, CylRadius, 0, 0, 0)
  MkWorld(Mesh)
  ;
  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)   
            MkWorld(Mesh)
            SetActiveGadget(Tg)
            Draw=1
          Case SpMerid,SpParal,_BtnLink
            \Merid=GetGadgetState(SpMerid)
            \Paral=GetGadgetState(SpParal)
            MkWorld(Mesh)
            SetActiveGadget(Tg)
            Draw=1
          Case TbSphRadius
            SphRadius=GetGadgetState(TbSphRadius)/30
            If SphRadius<0.1:SphRadius=0.1:EndIf
            \Ball=CreateSphere(-1,SphRadius)
            TransformMesh(\Ball, 0, 0,0, SphRadius, SphRadius, SphRadius, 0, 0, 0)
            MkWorld(Mesh)
            SetActiveGadget(Tg)
            Draw=1
          Case TBCylRadius
            CylRadius=GetGadgetState(TBcylRadius)/30
            If Cylradius<0.1:Cylradius=0.1:EndIf
            \Stick=CreateCylinder(-1, CylRadius,1/CylRadius)
            TransformMesh(\Stick, 0, 0.5, 0, CylRadius, CylRadius, CylRadius, 0, 0, 0)
            MkWorld(Mesh)
            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
EndWith
End
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5494
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Meridians and Parallels

Post by Kwai chang caine »

One word come to me....incredible !!! :shock:
Works great thanks for sharing 8)
ImageThe happiness is a road...
Not a destination
Top
User avatar
einander
Enthusiast
Enthusiast
Posts: 744
Joined: Thu Jun 26, 2003 2:09 am
Location: Spain (Galicia)

Re: Meridians and Parallels

Post by einander »

@KCC: You're welcome.
Top
Post Reply

Return to “Tricks 'n' Tips”