PureBasic Forums - English

Posted: **Mon Dec 08, 2014 2:48 pm**

part 1 of the tubes post are here thick and thin lines, and tubes of all shapes
part 2 making a circular tube the usual way (one mesh) , then making its material to scroll
try to go inside the tube ...
possible usages: UFO, fantasia demos, Aliens Factory, another world, ...
keys usages in the example title bar

from inside the tube

Code: Select all

Enumeration
  #Window = 500
  #ground
  #Camera
  #Light1
  #sphere
  #plane
  #RedMaterial
  #tube      
EndEnumeration

#CameraSpeed = 2

Global bands = 8 ;number of points of every ring (circle)
#Rings = 2 ;number of Rings over all the smallest tube (always 2, start ring and end ring)
Global divisions = 100
Structure vector3d
  x.f
  y.f
  z.f
EndStructure

Structure vertex
  x.f
  y.f
  z.f
EndStructure


Declare DrawTube (x.f, y.f,z.f, x2.f, y2.f, z2.f, Radius.f, bands)
Declare tubesCircle()

Define.f KeyX, KeyY, MouseX, MouseY



; beginning of the frenet sqaure approximation 5 procedures  
Procedure vector_cross(*v1.vector3d, *v2.vector3d, *vout.vector3d)
    *vout\x = (*v1\y * *v2\z) - (*v2\y * *v1\z)
    *vout\y = (*v1\z * *v2\x) - (*v2\z * *v1\x)
    *vout\z = (*v1\x * *v2\y) - (*v2\x * *v1\y)
EndProcedure

Procedure.f vector_magnitude(*v.vector3d)
    mag.f
    mag = Sqr(*v\x * *v\x + *v\y * *v\y + *v\z * *v\z)
    If mag = 0:mag = 1:EndIf
    ProcedureReturn mag
EndProcedure

Procedure vector_normalize (*v.vector3d)
    mag.f
    mag = vector_magnitude(*v)
    *v\x = *v\x / mag
    *v\y = *v\y / mag
    *v\z = *v\z / mag
EndProcedure


Procedure vector_add (*v1.vector3d, *v2.vector3d, *vout.vector3d)
    *vout\x = *v1\x + *v2\x
    *vout\y = *v1\y + *v2\y
    *vout\z = *v1\z + *v2\z
EndProcedure

Procedure vector_sub (*v1.vector3d, *v2.vector3d, *vout.vector3d)
    *vout\x = *v1\x - *v2\x
    *vout\y = *v1\y - *v2\y
    *vout\z = *v1\z - *v2\z
EndProcedure

; End of the frenet sqaure approximation 5 procedures 

If InitEngine3D()
  
  ;Add3DArchive(".", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Textures", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Models", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Scripts",#PB_3DArchive_FileSystem)
    
 ; Parse3DScripts()
  
  InitSprite()
  InitKeyboard()
  InitMouse()
  
ExamineDesktops()
DesktopW = DesktopWidth(0)
DesktopH = DesktopHeight(0)

If OpenWindow(#Window, 0, 0, DesktopW, DesktopH, "W toggle wire/solid Frame ..,Space: toggle rotation.. ..mouse and arrow keys to move/ rotate the camera ")
  If OpenWindowedScreen(WindowID(#Window), 0, 0, DesktopW, DesktopH, 0, 0, 0)
    Parse3DScripts()
    CreateCamera(#Camera, 0, 0, 100, 100)
    MoveCamera(#Camera, 200, 300, 150, #PB_Absolute)
    CameraLookAt(#Camera,0,0,0)
    CameraBackColor(#Camera, RGB(200,255,200))
        
    CreateMaterial(2, LoadTexture(2, "ground_diffuse.png"))
    MaterialCullingMode(2, #PB_Material_NoCulling)
    DisableMaterialLighting(2, #True)
    ScrollMaterial(2, 0, 0, #PB_Material_Animated) 
    SetMaterialColor(2, #PB_Material_AmbientColor, RGB(250, 255, 0))
    SetMaterialColor(2, #PB_Material_SpecularColor, RGB(255, 255, 0))
    
    CreateMaterial(0, LoadTexture(0, "wood.jpg"))
    DisableMaterialLighting(0, #True)
    
    GetScriptMaterial(#RedMaterial, "Color/Red")
    
    CreateLight(#Light1, RGB(255, 255, 255), 0, 100, 50)
    AmbientColor(RGB(255, 255, 255))
  
  EndIf
EndIf

EnableWorldPhysics(#True)
WorldGravity(-100)
CreateCube(#plane,1)
CreateEntity(#plane,MeshID(#plane),MaterialID(0), 0, -21, 0)
ScaleEntity(#plane, 300,1, 300)
EntityPhysicBody(#plane, #PB_Entity_StaticBody)

wireFrame = 1

tubesCircle()
CreateSphere(#sphere, 7)
CreateEntity(#sphere, MeshID(#sphere), MaterialID(#RedMaterial), 95, 10,0)
EntityPhysicBody(#sphere, #PB_Entity_SphereBody, 1,5,1)
EntityPhysicBody(#tube, #PB_Entity_StaticBody)

Tex1  = LoadTexture(#PB_Any, "MRAMOR6X6.jpg")
AddMaterialLayer(2, TextureID(Tex1), #PB_Material_Modulate)
rot=1
Repeat
  
  Event = WindowEvent()
        
      If ExamineMouse()
        MouseX = -MouseDeltaX()/20 
        MouseY = -MouseDeltaY()/20
      EndIf
      
          
      If ExamineKeyboard()
           
        If KeyboardPushed(#PB_Key_Left)
          KeyX = -#CameraSpeed
        ElseIf KeyboardPushed(#PB_Key_Right)
          KeyX = #CameraSpeed
        Else
          KeyX = 0
        EndIf
        
        If KeyboardPushed(#PB_Key_Up)
          KeyY = -#CameraSpeed
        ElseIf KeyboardPushed(#PB_Key_Down)
          KeyY = #CameraSpeed
        Else
          KeyY = 0
        EndIf
        
        If KeyboardPushed(#PB_Key_E)
          x.f+0.001
          ScrollMaterial(2, x, 0, #PB_Material_Fixed  , 1)    
         EndIf 
        
        If KeyboardReleased(#PB_Key_W)
          If wireFrame
            MaterialShadingMode(2, #PB_Material_Wireframe)
          wireFrame ! 1
        Else 
            MaterialShadingMode(2, #PB_Material_Solid)
          wireFrame ! 1
        EndIf
        EndIf
            
      EndIf
      
      x.f+0.003
      ScrollMaterial(2, x, 0, #PB_Material_Fixed  , 1)
  
      RotateCamera(#Camera, MouseY, MouseX, 0, #PB_Relative)
      MoveCamera(#Camera, KeyX, 0, KeyY)
      RotateEntity(#tube, 0,rot,0, #PB_Relative)
      
      ttt+1
      If ttt=100 ; give the sphere a pulse every 100 loops
        ApplyEntityImpulse(#sphere, 0, 200, 0,  0,1,-1)
        ttt=0
      EndIf
      If KeyboardReleased(#PB_Key_Space)
            rot ! 1
      EndIf
      
      RenderWorld()
            
      FlipBuffers()
    Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1
    
Else
  MessageRequester("Error", "The 3D Engine can't be initialized",0)
EndIf
  
End

Procedure  DrawTube (x.f, y.f,z.f, x2.f, y2.f,z2.f, Radius.f, bands)
  x.f+0.00001 : y.f+0.00001 : z.f+0.00001 ; in rare cases when x,y,z where all zero:
  x2.f+0.00001 : y2.f+0.00001 : z2.f+0.00001; then without adding 0.00001 will gives erroneous shape 
  
  Dim vertx.vertex(2)
  lineVec.vector3d

   u.f: r.f
      
  txu.f : txv.f
   
  x1.f = x
  y1.f = y
  z1.f = z
  
  
  ;vector of the line between start vertex and the end vertex
  lineVec\x = x2 - x1
  lineVec\y = y2 - y1
  lineVec\z = z2 - z1
  
  
  tt.f = 0
  
  For i=0 To #Rings
        
      x = x1 + lineVec\x * tt 
      y = y1 + lineVec\y * tt 
      z = z1 + lineVec\z * tt
      tt + 1
      
       vertx(i)\x = x
       vertx(i)\y = y
       vertx(i)\z = z
       
   Next 
        
     current_point.vector3d
        next_point.vector3d
        T.vector3d
        B.vector3d
        N.vector3d
        p.f
     For i = 0 To #Rings-1
     
        ;center point
                
        current_point\x = vertx(i)\x
        current_point\y = vertx(i)\y
        current_point\z = vertx(i)\z
        ;next point For Frenet square
        
        next_point\x = vertx(i+1)\x
        next_point\y = vertx(i+1)\y
        next_point\z = vertx(i+1)\z

        ;T  = P' - P
        vector_sub(next_point, current_point, T)

        ;N = P' + P
        vector_add(next_point, current_point, N)

        ;B = T x N
        vector_cross(T, N, B)

        ;N = B x T
        vector_cross(B, T, N)

        ;Normalize vectors Or Else it won't work
        vector_normalize(B)
        vector_normalize(N)
        
        For j = 0 To bands
              new_point_x.f
              new_point_y.f
              
              ;rotate around the current point using normal rotation makes bands
            new_point_x = Sin(j * (#PI*2) / bands) * RADIUS
            new_point_y = Cos(j * (#PI*2) / bands) * RADIUS
            
                ;this is the coordinates of our point along the curve
            x = N\x * new_point_x + B\x * new_point_y + current_point\x
            y = N\y * new_point_x + B\y * new_point_y + current_point\y
            z = N\z * new_point_x + B\z * new_point_y + current_point\z
            
            MeshVertexPosition(x, y, z)
            MeshVertexTextureCoordinate(txu, txv)
            MeshVertexNormal(x, y, z)
            txv = txv + 1/#Rings
                         
         Next 
         txv = 0
         txu = txu + 1/bands
         
      Next 

      
         

  EndProcedure

  
  Procedure tubesCircle()
  CreateMesh(#tube , #PB_Mesh_TriangleList, #PB_Mesh_Static )  
  For i=1 To divisions
    ;divide the circle Circumference to arbitrary divisions      
    ;coordinates of a single point on the circle Circumference
      X.f=X+#PI*2/divisions 
      Z.f=Z+#PI*2/divisions
      XX.f=Cos(X)*100 ; 100 here is the radius of the big circle (big tube)
      ZZ.f=Sin(Z)*100
            
      X.f=X+#PI*2/divisions
      Z.f=Z+#PI*2/divisions
      XX2.f=Cos(X)*100
      ZZ2.f=Sin(Z)*100
      yy.f=0: yy2.f=0
            
      Radius = 20; radius of the tube cross section (lets say thickness/2)
      Bands = 8
            
      ; we gives the two adjacent points on the circle Circumference to the procedure
      ; which draws around every point a small circle made from arbitray divisions called bands, here it is 8
      DrawTube (xx, yy, zz, xx2, yy2, zz2, Radius, Bands)
            
    Next
   
      v.l=0
      For i = 0 To divisions+12 ;divisions is the number of circles the whole tube are made from
      For j = 0 To bands - 1 ; bands is the number of divisions every small circle (tube thickness) are made
          MeshFace(v,v+1,v + bands+1)
          MeshFace(v + bands+1,v + bands+2,v+1 )
          
          v + 1   
      Next
      Next  
   
    
    FinishMesh(#True)
    
    CreateEntity(#tube,MeshID(#tube),MaterialID(2) )
    NormalizeMesh(#tube)
    BuildMeshTangents(#tube)
    
  EndProcedure

Posted: **Mon Dec 08, 2014 3:57 pm**

Fantastic stuff applePi. You are very productive, good at solving problems. If you live in the UK I'm going to vote for you to be the new Prime Minister next year!

Posted: **Mon Dec 08, 2014 8:21 pm**

Thank you IdeasVacuum for encouraging me, in fact before making the above version which are made from one mesh which are better, i have tried experimentation with a version with 100 small tubes around a circle,so we have 100 meshes , but this is useful more as a building construction not movable nor rotating even it is possible to attach it to a node or using AttachEntityObject. some one may find this version useful , i have presented the big tube divisions = 10 to see it as a cartoon figure. you can make divisions = 100 or more.
on my geforce 520 the fps = about 60. more divisions then less fps.
not optimized

Code: Select all

Enumeration
  #Window = 500
  #ground
  #Camera
  #Light1
  #sphere
  #plane
    
EndEnumeration

#CameraSpeed = 4
#RADIUS  = 20 ;tube thickness

Global bands = 8 ;number of points of every ring (circle)
#Rings = 2 ;number of Rings over all the tube Line (always 2, start ring and end ring)
Global divisions = 10
Structure vector3d
  x.f
  y.f
  z.f
EndStructure

Structure vertex
  x.f
  y.f
  z.f
EndStructure


Declare DrawTube (x.f, y.f,z.f, x2.f, y2.f, z2.f)
Declare LineXYZ (Line3D, x.f, y.f, z.f, x2.f, y2.f, z2.f)
Declare tubesCircle()

Global.f x0, y0
;Global tubeee
x0 = 0: y0 = 0
Define.f KeyX, KeyY, MouseX, MouseY

  
Procedure vector_cross(*v1.vector3d, *v2.vector3d, *vout.vector3d)
    *vout\x = (*v1\y * *v2\z) - (*v2\y * *v1\z)
    *vout\y = (*v1\z * *v2\x) - (*v2\z * *v1\x)
    *vout\z = (*v1\x * *v2\y) - (*v2\x * *v1\y)
EndProcedure

Procedure.f vector_magnitude(*v.vector3d)
    mag.f
    mag = Sqr(*v\x * *v\x + *v\y * *v\y + *v\z * *v\z)
    If mag = 0:mag = 1:EndIf
    ProcedureReturn mag
EndProcedure

Procedure vector_normalize (*v.vector3d)
    mag.f
    mag = vector_magnitude(*v)
    *v\x = *v\x / mag
    *v\y = *v\y / mag
    *v\z = *v\z / mag
EndProcedure


Procedure vector_add (*v1.vector3d, *v2.vector3d, *vout.vector3d)
    *vout\x = *v1\x + *v2\x
    *vout\y = *v1\y + *v2\y
    *vout\z = *v1\z + *v2\z
EndProcedure

Procedure vector_sub (*v1.vector3d, *v2.vector3d, *vout.vector3d)
    *vout\x = *v1\x - *v2\x
    *vout\y = *v1\y - *v2\y
    *vout\z = *v1\z - *v2\z
EndProcedure
  
  
    
Define.f KeyX, KeyY, MouseX, MouseY

If InitEngine3D()
  
  ;Add3DArchive(".", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Textures", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Models", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Scripts",#PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home+"Examples\3D\Data\GUI",#PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Packs/desert.zip", #PB_3DArchive_Zip)
 ; Parse3DScripts()
  
  InitSprite()
  InitKeyboard()
  InitMouse()
  
ExamineDesktops()
DesktopW = DesktopWidth(0)
DesktopH = DesktopHeight(0)

If OpenWindow(#Window, 0, 0, DesktopW, DesktopH, "thick lines , W toggle wire/solid Frame ...., mouse and arrow keys to move/ rotate the camera ")
  If OpenWindowedScreen(WindowID(#Window), 0, 0, DesktopW, DesktopH, 0, 0, 0)
    Parse3DScripts()
    OpenWindow3D(33,0,0,200,100,"Engine Stats")
    TextGadget3D(33,2,0,70,30,"")
    
    ShowGUI(255,0)
         
    CreateCamera(#Camera, 0, 0, 100, 100)
    MoveCamera(#Camera, 200, 300, 150, #PB_Absolute)
    CameraLookAt(#Camera,0,0,0)
    CameraBackColor(#Camera, RGB(200,255,200))
    
    CreateMaterial(0, LoadTexture(0, "white.jpg"))
    DisableMaterialLighting(0, #False)
    SetMaterialColor(0, #PB_Material_AmbientColor, RGB(250, 255, 0))
    SetMaterialColor(0, #PB_Material_SpecularColor, RGB(255, 255, 0))

    CreateMaterial(1, LoadTexture(1, "MRAMOR6X6.jpg"))
    MaterialCullingMode(1, #PB_Material_NoCulling)

    CreateMaterial(2, LoadTexture(2, "ground_diffuse.png"))
    ;CreateMaterial(2, LoadTexture(2, "wood.jpg"))
    MaterialCullingMode(2, #PB_Material_NoCulling)
    DisableMaterialLighting(2, #False)
    SetMaterialColor(2, #PB_Material_AmbientColor, RGB(250, 255, 0))
    SetMaterialColor(2, #PB_Material_SpecularColor, RGB(255, 255, 0))
    
    CreateMaterial(0, LoadTexture(0, "wood.jpg"))
    DisableMaterialLighting(0, #True)
    
    CreateLight(#Light1, RGB(255, 255, 255), 0, 20, 20)
    AmbientColor(RGB(255, 255, 255))
  
  EndIf
EndIf

CreateCube(#plane,1)
CreateEntity(#plane,MeshID(#plane),MaterialID(0), 0, -21, 0)
ScaleEntity(#plane, 300,1, 300)

wireFrame = 1

tubesCircle()
;CreateCube(#ground, 1)
;CreateEntity(#ground,MeshID(#ground),MaterialID(0), 120, -25, 100)
;ScaleEntity(#ground, 300,1, 300)

Repeat
  
  Event = WindowEvent()
        
      If ExamineMouse()
        MouseX = -MouseDeltaX()/20 
        MouseY = -MouseDeltaY()/20
      EndIf
      
          
      If ExamineKeyboard()
           
        If KeyboardPushed(#PB_Key_Left)
          KeyX = -#CameraSpeed
        ElseIf KeyboardPushed(#PB_Key_Right)
          KeyX = #CameraSpeed
        Else
          KeyX = 0
        EndIf
        
        If KeyboardPushed(#PB_Key_Up)
          KeyY = -#CameraSpeed
        ElseIf KeyboardPushed(#PB_Key_Down)
          KeyY = #CameraSpeed
        Else
          KeyY = 0
        EndIf
        
        If KeyboardReleased(#PB_Key_W)
          If wireFrame
            MaterialShadingMode(2, #PB_Material_Wireframe)
          wireFrame ! 1
        Else 
            MaterialShadingMode(2, #PB_Material_Solid)
          wireFrame ! 1
        EndIf
        EndIf
            
      EndIf
  
      RotateCamera(#Camera, MouseY, MouseX, 0, #PB_Relative)
      MoveCamera(#Camera, KeyX, 0, KeyY)
         
      RenderWorld()
      
            
      FlipBuffers()
      
      SetGadgetText3D(33,"FPS: "+StrF(Engine3DStatus(#PB_Engine3D_Current),2))
              
    Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1
    
Else
  MessageRequester("Error", "The 3D Engine can't be initialized",0)
EndIf
  
End

Procedure  DrawTube (x.f, y.f,z.f, x2.f, y2.f,z2.f)
  
  Dim vertx.vertex(10)
  lineVec.vector3d

   u.f: r.f
      
  txu.f : txv.f
   
  x1.f = x
  y1.f = y
  z1.f = z
  
  
  ;vector of the line between start vertex and the end vertex
  lineVec\x = x2 - x1
  lineVec\y = y2 - y1
  lineVec\z = z2 - z1
  
   
  tt.f = 0
  
  For i=0 To #Rings
        
       x = x1 + lineVec\x * tt 
      y = y1 + lineVec\y * tt 
      z = z1 + lineVec\z * tt
      tt + 1
      
       vertx(i)\x = x
       vertx(i)\y = y
       vertx(i)\z = z
       
   Next 
        
     current_point.vector3d
        next_point.vector3d
        T.vector3d
        B.vector3d
        N.vector3d
        p.f
     For i = 0 To #Rings-1
     
        ;center point
                
        current_point\x = vertx(i)\x
        current_point\y = vertx(i)\y
        current_point\z = vertx(i)\z
        ;next point For Frenet square
        
        next_point\x = vertx(i+1)\x
        next_point\y = vertx(i+1)\y
        next_point\z = vertx(i+1)\z

        ;T  = P' - P
        vector_sub(next_point, current_point, T)

        ;N = P' + P
        vector_add(next_point, current_point, N)

        ;B = T x N
        vector_cross(T, N, B)

        ;N = B x T
        vector_cross(B, T, N)

        ;Normalize vectors Or Else it won't work
        vector_normalize(B)
        vector_normalize(N)
        
        For j = 0 To bands
              new_point_x.f
              new_point_y.f
              
              ;rotate around the current point using normal rotation makes bands
            new_point_x = Sin(j * (#PI*2) / bands) * #RADIUS
            new_point_y = Cos(j * (#PI*2) / bands) * #RADIUS
            
                ;this is the coordinates of our point along the curve
            x = N\x * new_point_x + B\x * new_point_y + current_point\x
            y = N\y * new_point_x + B\y * new_point_y + current_point\y
            z = N\z * new_point_x + B\z * new_point_y + current_point\z
            
            MeshVertexPosition(x, y, z)
            MeshVertexTextureCoordinate(txu, txv)
            MeshVertexNormal(x, y, z)
            txv = txv + 1/#Rings
                         
         Next 
         txv = 0
         txu = txu + 1/bands
         
      Next 

      v.l
      For j = 0 To bands -1
          MeshFace(v,v+1,v + bands+1)
          MeshFace(v + bands+1,v + bands+2,v+1 )
         
          v + 1   
          
    Next 
         

  EndProcedure

  
  Procedure LineXYZ (Line3D, x.f, y.f,z.f, x2.f, y2.f,z2.f)
    
    
    tube = Line3D
    CreateMesh(tube , #PB_Mesh_TriangleList, #PB_Mesh_Dynamic )
    SetMeshMaterial(tube , MaterialID(2))
    ;; 0.00001 : necessary if all x,t,z are zero
    DrawTube (x+0.00001, y+0.00001, z+0.00001, x2, y2, z2)
    FinishMesh(tube)
    NormalizeMesh(tube)
    BuildMeshTangents(tube)
    CreateEntity(tube,MeshID(tube),MaterialID(2))
    
  EndProcedure
  
  Procedure tubesCircle()
  For i=1 To divisions
    tubeee+1
      X.f=tempX.f:Z.f=tempZ.f
      X.f=X+#PI*2/divisions
      Z.f=Z+#PI*2/divisions
      XX.f=Cos(X)*100
      ZZ.f=Sin(Z)*100
      tempX.f=X: tempZ.f=Z
      
      X.f=X+#PI*2/divisions
      Z.f=Z+#PI*2/divisions
      XX2.f=Cos(X)*100
      ZZ2.f=Sin(Z)*100
      LineXYZ(tubeee,  xx,0,zz,  xx2, 0, zz2)
      
    Next
  EndProcedure

Posted: **Tue Dec 09, 2014 9:53 am**

Very cool demo, applePi! (if a little nausea-inducing, but though...)

And I would totally vote for you as the next UK's Prime Minister if I could; t'would be fun.

Posted: **Tue Dec 09, 2014 5:22 pm**

@appliePi

Another very nice demo. Works on Mac, too.

Posted: **Tue Dec 09, 2014 8:17 pm**

Thank you Kelebrindae and davido ,
i want to design windows on the ufo tube, but now in the example at the top of this page replace lines 337-338
MeshFace(v,v+1,v + bands+1)
MeshFace(v + bands+1,v + bands+2,v+1 )

with this:

Code: Select all

Select j
              Case 0,3,4,5
          
              MeshFace(v,v+1,v + bands+1)
              MeshFace(v + bands+1,v + bands+2,v+1 )
                 
          EndSelect

and we will get a torn tube, with the ball inside.

Posted: **Wed Dec 10, 2014 1:13 am**

Pretty freaky applePi, after being inside the tube for a while and quit, my vision adjustment goes a bit screwy for a bit.

Posted: **Wed Dec 10, 2014 2:41 pm**

you are welcome electrochrisso thank you

Posted: **Wed Dec 10, 2014 5:07 pm**

Sometime and it's not often...i not found the world

Perhaps ..simply splendid

Thanks for sharing ..

Posted: **Wed Dec 10, 2014 8:20 pm**

@applePi,
Nice idea; just enough to stop the ball escaping!

Posted: **Wed Dec 10, 2014 8:50 pm**

you are welcome KCC, thank you
davido, here is other tubes, Conical and Pyramidal, it is exactly like the straight tubes but with a different radius for the tube start and tube end.
the form of the new function is this:
Declare TubeXYZ (tube, x.f, y.f, z.f, x2.f, y2.f, z2.f, RadiusS.f, RadiusE.f, TubeShape, Material)
note that TubeShape can be 4,5,6,...,etc to denote that it has 4 or 5 or 6 sides
RadiusS is the radius of the tube start circle
RadiusE is the radius of the tube end circle
an example of the square Pyramid:
TubeXYZ(3, 0,0,0, 0,15,0, 8, 0, 4, 2)
here is the bottom radius is 8 and the pyramid top radius is zero, change it to 1 to have a small hole at the top.
note that if you want to make the object to rotate around itself then make it at the center then move it anywhere like this pyramid and after that rotate it.

Code: Select all

Define.f KeyX, KeyY, MouseX, MouseY

Enumeration
  #Window = 500
  #Plane
  #Camera
  #Light1
  #sphere
  #sphere2
  #sphere3
  #mat
    
EndEnumeration

#CameraSpeed = 1
#Rings = 2 ;number of Rings over all the Line (always 2, start ring and end ring)
#RedMaterial = 18

Structure vector3d
  x.f
  y.f
  z.f
EndStructure

Structure vertex
  x.f
  y.f
  z.f
EndStructure

Dim vertx.vertex(32)

Declare DrawTube (x.f, y.f,z.f, x2.f, y2.f, z2.f, RadiusS.f, RadiusE.f, TubeShape)
Declare TubeXYZ (tube, x.f, y.f, z.f, x2.f, y2.f, z2.f, RadiusS.f, RadiusE.f, TubeShape, Material)

    
Procedure vector_cross(*v1.vector3d, *v2.vector3d, *vout.vector3d)
    *vout\x = (*v1\y * *v2\z) - (*v2\y * *v1\z)
    *vout\y = (*v1\z * *v2\x) - (*v2\z * *v1\x)
    *vout\z = (*v1\x * *v2\y) - (*v2\x * *v1\y)
EndProcedure

Procedure.f vector_magnitude(*v.vector3d)
    mag.f
    mag = Sqr(*v\x * *v\x + *v\y * *v\y + *v\z * *v\z)
    If mag = 0:mag = 1:EndIf
    ProcedureReturn mag
EndProcedure

Procedure vector_normalize (*v.vector3d)
    mag.f
    mag = vector_magnitude(*v)
    *v\x = *v\x / mag
    *v\y = *v\y / mag
    *v\z = *v\z / mag
EndProcedure


Procedure vector_add (*v1.vector3d, *v2.vector3d, *vout.vector3d)
    *vout\x = *v1\x + *v2\x
    *vout\y = *v1\y + *v2\y
    *vout\z = *v1\z + *v2\z
EndProcedure

Procedure vector_sub (*v1.vector3d, *v2.vector3d, *vout.vector3d)
    *vout\x = *v1\x - *v2\x
    *vout\y = *v1\y - *v2\y
    *vout\z = *v1\z - *v2\z
EndProcedure


If InitEngine3D()
  
  Add3DArchive("\", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Textures", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Models", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Scripts",#PB_3DArchive_FileSystem)
    
  ;Parse3DScripts()
  
  InitSprite()
  InitKeyboard()
  InitMouse()
  
ExamineDesktops()
DesktopW = DesktopWidth(0)
DesktopH = DesktopHeight(0)

If OpenWindow(#Window, 0, 0, DesktopW, DesktopH, "Tubes of several shapes , W toggle wire/solid Frame ...., mouse and arrow keys to move/ rotate the camera ")
  If OpenWindowedScreen(WindowID(#Window), 0, 0, DesktopW, DesktopH, 0, 0, 0)
    Parse3DScripts()
    CreateCamera(#Camera, 0, 0, 100, 100)
    MoveCamera(#Camera, 0, 50, 110, #PB_Absolute)
    CameraLookAt(#Camera,0,0,0)
    CameraBackColor(#Camera, RGB(200,200,200))
    
    CreateMaterial(0, LoadTexture(0, "white.jpg"))
    DisableMaterialLighting(0, #True)
    
    CreateMaterial(1, LoadTexture(1, "snow_1024.jpg"))
    MaterialCullingMode(1, #PB_Material_NoCulling)

    CreateMaterial(2, LoadTexture(2, "ground_diffuse.png"))
    MaterialCullingMode(2, #PB_Material_NoCulling)
    DisableMaterialLighting(2, #False)
        
    CreateMaterial(3, LoadTexture(3, "wood.jpg"))
    DisableMaterialLighting(3, #False)
    MaterialCullingMode(3, #PB_Material_NoCulling)
    
    GetScriptMaterial(#RedMaterial, "Color/Red")
    
    CreateLight(#Light1, RGB(255, 255, 255), 0, 20, 20)
    AmbientColor(RGB(255, 255, 255))
    
    ; transparent Texture from example CreateTextureAlpha.pb in Purebasic 3D folder
      CreateTexture(#mat, 256, 256)
      StartDrawing(TextureOutput(#mat))
      DrawingMode(#PB_2DDrawing_AllChannels | #PB_2DDrawing_AlphaBlend)
      Box(0, 0, 256, 256, RGBA(0, 0, 0, 255))
      Box(0, 0, 256, 256, RGBA(100, 255, 0, 70)) 
      ;Circle(127, 127, 50, RGBA(0, 0, 0, 0))
      StopDrawing()
      CreateMaterial(#mat, TextureID(#mat))
      MaterialBlendingMode(#mat, #PB_Material_AlphaBlend)
      MaterialCullingMode(#mat, #PB_Material_NoCulling)
      DisableMaterialLighting(#mat, 1)
  
  EndIf
EndIf

CreatePlane(#plane, 200, 200, 50, 50, 10, 10)
CreateEntity(#plane,MeshID(#plane),MaterialID(1), 0, 0, 0)

glLineWidth_(5)
CreateLine3D(7, 0, 0.02, 0, RGB(255,   0,   0), 50,  0.02,  0, RGB(255,   0,   0))  ; Axis X
CreateLine3D(8, 0, 0, 0, RGB(  0, 255,   0),  0, 50,  0, RGB(  0, 255,   0))  ; Axis Y
CreateLine3D(9, 0, 0.02, 0, RGB(  0,   0, 255),  0,  0.02, 50, RGB(  0,   0, 255))  ; Axis Z

wireFrame = 1

;doc: draw thick lines from x,y,z to x2,y2,z2 with thickness Radius and TubeShape is the number of points makes the tube cross section polygon
;doc: TubeXYZ(#mesh, x,y,z, x2,y2,z2, RadiusS.f,RadiusE.f, TubeShape, Material)
TubeXYZ(1,  -20,8,-2,  -20,30,-2, 3,15, 16, 2) 
SetEntityMaterial(1, MaterialID(#mat))
TubeXYZ(2,  20,0,-2,  20,30,-2, 15, 5, 16, 2) 
TubeXYZ(3,  0,0,0,  0,15,0,  8, 0, 4, 2) ;this is the pyramid; if you want the object to rotate around itself, make it in the center
MoveEntity(3, -20,0,40, #PB_Absolute)    ; and move it anywhere (before giving it physics if needed)
TubeXYZ(4,  0,0,0,  0,15,0,  5, 5, 5, 2)
MoveEntity(4, 20,0,45, #PB_Absolute)

EnableWorldPhysics(#True)
CreateSphere(#sphere , 2)
CreateEntity(#sphere, MeshID(#sphere), MaterialID(#RedMaterial) , -32,38,-2)
CreateSphere(#sphere2 , 3.5)
CreateEntity(#sphere2, MeshID(#sphere2), MaterialID(#RedMaterial) , -32,60,-2)
CreateSphere(#sphere3 , 2)
CreateEntity(#sphere3, MeshID(#sphere3), MaterialID(#RedMaterial) , -32,80,-2)

EntityPhysicBody(#sphere, #PB_Entity_SphereBody)
EntityPhysicBody(#sphere2, #PB_Entity_SphereBody)
EntityPhysicBody(#sphere3, #PB_Entity_SphereBody)
EntityPhysicBody(1, #PB_Entity_StaticBody)
EntityPhysicBody(2, #PB_Entity_StaticBody)
EntityPhysicBody(#plane, #PB_Entity_StaticBody, 1, 1, 0.1)


Repeat
  
  Event = WindowEvent()
        
      If ExamineMouse()
        MouseX = -MouseDeltaX()/20 
        MouseY = -MouseDeltaY()/20
      EndIf
      
          
      If ExamineKeyboard()
           
        If KeyboardPushed(#PB_Key_Left)
          KeyX = -#CameraSpeed
        ElseIf KeyboardPushed(#PB_Key_Right)
          KeyX = #CameraSpeed
        Else
          KeyX = 0
        EndIf
        
        If KeyboardPushed(#PB_Key_Up)
          KeyY = -#CameraSpeed
        ElseIf KeyboardPushed(#PB_Key_Down)
          KeyY = #CameraSpeed
        Else
          KeyY = 0
        EndIf
        
        If KeyboardReleased(#PB_Key_W)
          If wireFrame
            MaterialShadingMode(2, #PB_Material_Wireframe)
          wireFrame ! 1
        Else 
            MaterialShadingMode(2, #PB_Material_Solid)
          wireFrame ! 1
        EndIf
        EndIf
            
      EndIf
      
      DisableEntityBody(#sphere, 0)
      RotateCamera(#Camera, MouseY, MouseX, 0, #PB_Relative)
      MoveCamera(#Camera, KeyX, 0, KeyY)
      RotateEntity(3, 0,1,0, #PB_Relative)
      RotateEntity(4, 0,1,0, #PB_Relative)
      RenderWorld()
      
            
      FlipBuffers()
    Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1
    
Else
  MessageRequester("Error", "The 3D Engine can't be initialized",0)
EndIf
  
End

Procedure  DrawTube (x.f, y.f,z.f, x2.f, y2.f,z2.f, RadiusS.f, RadiusE.f, TubeShape)
  
  Dim vertx.vertex(2)
  lineVec.vector3d

  u.f: r.f
      
  txu.f : txv.f
   
  x1.f = x
  y1.f = y
  z1.f = z
  
  bands = TubeShape
    
  ;vector of the line between start vertex and the end vertex
  lineVec\x = x2 - x1
  lineVec\y = y2 - y1
  lineVec\z = z2 - z1
  

  tt.f = 0
  
  For i=0 To 2
      
      x = x1 + lineVec\x * tt 
      y = y1 + lineVec\y * tt 
      z = z1 + lineVec\z * tt
      tt + 1
      
       vertx(i)\x = x
       vertx(i)\y = y
       vertx(i)\z = z
       
   Next 
        
     current_point.vector3d
        next_point.vector3d
        T.vector3d
        B.vector3d
        N.vector3d
        p.f
     For i = 0 To 1
       If i=0 ; to manage the radius of tube start and tube end
         Radius.f = RadiusS
         Else 
           Radius.f=RadiusE
       EndIf
        ;center point
                
        current_point\x = vertx(i)\x
        current_point\y = vertx(i)\y
        current_point\z = vertx(i)\z
        ;next point For Frenet square
        
        next_point\x = vertx(i+1)\x
        next_point\y = vertx(i+1)\y
        next_point\z = vertx(i+1)\z

        ;T  = P' - P
        vector_sub(next_point, current_point, T)

        ;N = P' + P
        vector_add(next_point, current_point, N)

        ;B = T x N
        vector_cross(T, N, B)

        ;N = B x T
        vector_cross(B, T, N)

        ;Normalize vectors Or Else it won't work
        vector_normalize(B)
        vector_normalize(N)
        
        For j = 0 To bands
              new_point_x.f
              new_point_y.f
              
              ;rotate around the current point using normal rotation makes bands
            new_point_x = Sin(j * (#PI*2) / bands) * Radius
            new_point_y = Cos(j * (#PI*2) / bands) * Radius
            
                ;this is the coordinates of our point along the curve
            x = N\x * new_point_x + B\x * new_point_y + current_point\x
            y = N\y * new_point_x + B\y * new_point_y + current_point\y
            z = N\z * new_point_x + B\z * new_point_y + current_point\z
            
            MeshVertexPosition(x, y, z)
            MeshVertexTextureCoordinate(txu, txv)
            MeshVertexNormal(x, y, z)
            txv = txv + 1/#Rings
                         
         Next 
         txv = 0
         txu = txu + 1/bands
         
      Next 

      v.l
      For j = 0 To bands -1
          MeshFace(v,v+1,v + bands+1)
          MeshFace(v + bands+1,v + bands+2,v+1 )
         
          v + 1   
          
      Next 
 
  EndProcedure
  
  Procedure TubeXYZ (tube, x.f, y.f,z.f, x2.f, y2.f,z2.f, RadiusS.f, RadiusE.f, TubeShape, Material)
    x.f+0.00001 : y.f+0.00001 : z.f+0.00001 ; +0.00001 necessary if x,y,z or x2,y2,z2 are zero !!!
    x2.f+0.00001 : y2.f+0.00001 : z2.f+0.00001     
    
    CreateMesh(tube , #PB_Mesh_TriangleList, #PB_Mesh_Dynamic )
    
    DrawTube (x, y, z, x2, y2, z2, RadiusS, RadiusE, TubeShape)
    FinishMesh(tube)
    NormalizeMesh(tube)
    BuildMeshTangents(tube)
    CreateEntity(tube,MeshID(tube),MaterialID(Material))
      
      
    
  EndProcedure

Posted: **Mon Dec 22, 2014 1:06 am**

Hello,

I would like to run the examples above but I get "The specified 'Texture' is null. " on all *.jpg texture.
Furthermore, the OpenWindowedScreen() didn't work, the only thing I get it's a window with nothing.

I'm using PureBasic 5.31 x64 on Linux Ubuntu 14.10 x64

Best regards
StarBootics

Posted: **Wed Dec 24, 2014 6:38 am**

StarBootics wrote:Hello,

I would like to run the examples above but I get "The specified 'Texture' is null. " on all *.jpg texture.
Furthermore, the OpenWindowedScreen() didn't work, the only thing I get it's a window with nothing.

I'm using PureBasic 5.31 x64 on Linux Ubuntu 14.10 x64

Best regards
StarBootics

Try setting Library Subsystem to opengl in the Compiler Options.

Posted: **Sun Dec 28, 2014 3:28 pm**

electrochrisso wrote:Try setting Library Subsystem to opengl in the Compiler Options.

When I try this I get :

PureBasic - Compler Error
The following subsystem cannot be found: opengl

Best regards
StarBootics

Posted: **Mon Dec 29, 2014 11:17 am**

I have never needed to install opengl (Open Graphics Library) on my windows systems, perhaps you need to install it onto ubuntu, there is some information on google how to do it.

Just checked the PB manual and it says Linux uses opengl as default, and their are no available subsystems to use, so that explains the error, I think you need a Ubuntu expert from this forum to help with setting up your graphics hardware/software combination to work properly with PB.

PureBasic Forums - English

Circular Tube ( UFO ) & Conical and Pyramidal tubes

Circular Tube ( UFO ) & Conical and Pyramidal tubes

Re: Circular Tube ( UFO )

Re: Circular Tube ( UFO )

Re: Circular Tube ( UFO )

Re: Circular Tube ( UFO )

Re: Circular Tube ( UFO )

Re: Circular Tube ( UFO )

Re: Circular Tube ( UFO )

Re: Circular Tube ( UFO )

Re: Circular Tube ( UFO )

Re: Circular Tube ( UFO )

Re: Circular Tube ( UFO ) & Conical and Pyramidal tubes

Re: Circular Tube ( UFO ) & Conical and Pyramidal tubes

Re: Circular Tube ( UFO ) & Conical and Pyramidal tubes

Re: Circular Tube ( UFO ) & Conical and Pyramidal tubes