Semi Cylinder (PB 5.40 LTS)

Everything related to 3D programming
applePi
Addict
Addict
Posts: 1404
Joined: Sun Jun 25, 2006 7:28 pm

Semi Cylinder (PB 5.40 LTS)

Post by applePi »

the easiest way to create a semi Cylinder is to zeroing the z or x vertex coordinate in the left or right side. it is in fact deforming the cylinder
i think i like the new cylinder in which we have 2 open top and bottom so we have a free Tube, if we choose the CloseTop = 0, it should be CloseTop/Bottom = 0
CreateCylinder(#Mesh, Radius.f, Height.f [, NbBaseSegments, NbHeightSegments, CloseTop])
or a better choice is to have the ability to close/open one or the two sides. but if there is no choice i prefer the tube
the following half cylinder is suitable to make a truck, or a house, a garage,.... etc
Image

5.40 beta 10

Code: Select all

Enumeration
   #camera
   #Plane
      
EndEnumeration

#Radius = 6
#cyl = 40

Global Dim MeshData.PB_MeshVertex(0)
Global Dim MeshDataInd.PB_MeshFace(0)

Declare HalfCyl()

Define.f KeyX, KeyY, MouseX, MouseY

ExamineDesktops()
If OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0), "use arrow keys and mouse to move the camera,,...,,, pres 'W' for wire/solid frame", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)

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()
  OpenWindowedScreen(WindowID(0), 0, 0, DesktopWidth(0), DesktopHeight(0), 0, 0, 0)
    
              
    CreateCamera(#camera, 0, 0, 100, 100)
    MoveCamera(#camera, 0, 20, 40, #PB_Absolute)
    ;CameraFOV(#camera, 70)
    CameraBackColor(#camera, RGB(255,200,200))
    CameraLookAt(#camera,0,5,0)
        
    CreateLight(0, RGB(255,255,255), 0, 20, 30)
    AmbientColor(RGB(200, 200, 200))
        
    CreateMaterial(5, LoadTexture(5, "ValetCoeur.jpg")) ; ; Geebee2.bmp ;ValetCoeur.jpg
    MaterialCullingMode(5, #PB_Material_NoCulling)
    CreateMaterial(6, LoadTexture(6, "MRAMOR6X6.jpg"))
    MaterialCullingMode(6, #PB_Material_NoCulling)
    CreateMaterial(7, LoadTexture(7, "flare.png"))
    MaterialShadingMode(7, #PB_Material_Wireframe)
    MaterialCullingMode(7, #PB_Material_NoCulling)
        
    CreatePlane(#Plane, 200, 200, 5, 5, 2, 2) ; the ground
    CreateEntity(#Plane, MeshID(#Plane), MaterialID(6), 0,-15,0)
            
    CreateCylinder(8, 10,40, 16,16,0)
    CreateEntity(8, MeshID(8), MaterialID(5), -15,0,-20)
    RotateEntity(8, 90,0,0)
    
    HalfCyl() ; call the half cylinder procedure

    FinishMesh(1)
  
    CreateEntity(7, MeshID(7), MaterialID(5), 3,6,0)
    RotateEntity(7, 90,0,0)
   
    Repeat
      Event = WindowEvent()
        
      If ExamineMouse()
        MouseX = -MouseDeltaX()/20 
        MouseY = -MouseDeltaY()/20
      EndIf
      
          
      If ExamineKeyboard()
         
        If KeyboardPushed(#PB_Key_Left)
          KeyX = -1
        ElseIf KeyboardPushed(#PB_Key_Right)
          KeyX = 1
        Else
          KeyX = 0
        EndIf
        
        If KeyboardPushed(#PB_Key_Up)
          KeyY = -1
        ElseIf KeyboardPushed(#PB_Key_Down)
          KeyY = 1
        Else
          KeyY = 0
        EndIf
        
       If KeyboardReleased(#PB_Key_W)
          
          If wire = 0
          MaterialShadingMode(5, #PB_Material_Wireframe)
          wire ! 1
        Else
          MaterialShadingMode(5, #PB_Material_Solid)
          wire ! 1
          
        EndIf
      EndIf  
      EndIf
            
       
      RotateCamera(#Camera, MouseY, MouseX, 0, #PB_Relative)
      MoveCamera(#Camera, KeyX, 0, KeyY)
      
      RenderWorld()
      FlipBuffers()
      
    Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1
  EndIf
  
Else
  MessageRequester("Error", "The 3D Engine can't be initialized", 0)
EndIf

End

Procedure HalfCyl()
CreateMesh(7, #PB_Mesh_TriangleList, #PB_Mesh_Dynamic)

  CreateCylinder(#cyl,#Radius, 40, 16, 16, 0)
  GetMeshData(#cyl,0, MeshData(), #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate , 0, MeshVertexCount(#cyl)-1)
  GetMeshData(#cyl,0, MeshDataInd(), #PB_Mesh_Face, 0, MeshIndexCount(#cyl, 0)-1)
  ArrSize = ArraySize(MeshData())
 
   For c=0 To ArrSize
      
      x.f = MeshData(c)\x 
      y.f = MeshData(c)\y
      z.f = MeshData(c)\z
      ;Debug StrF(x)+"  "+StrF(y)+" "+StrF(z)
      If z > 0: z=0: EndIf
      MeshVertexPosition(x,y,z)
      MeshVertexTextureCoordinate(MeshData(c)\u, MeshData(c)\v) 
      MeshVertexNormal(MeshData(c)\NormalX, MeshData(c)\NormalY, MeshData(c)\NormalZ)
         
      
   Next   
   
   ArrSizeInd = ArraySize(MeshDataInd()) 
   
   For i=0 To ArrSizeInd Step 3 
     MeshFace(MeshDataInd(i)\Index, MeshDataInd(i+1)\Index,MeshDataInd(i+2)\Index)
     
   Next  
 EndProcedure
now change line 125 to :

Code: Select all

CreateCylinder(#cyl,#Radius, 40, 4, 16, 0)
and then you get a prism
Last edited by applePi on Sat Oct 17, 2015 1:07 pm, edited 1 time in total.
User avatar
Comtois
Addict
Addict
Posts: 1432
Joined: Tue Aug 19, 2003 11:36 am
Location: Doubs - France

Re: Semi Cylinder (5.40 beta 10)

Post by Comtois »

if you prefere the tube, here it is :)

Code: Select all

Structure Vector3
  x.f
  y.f
  z.f
EndStructure

Procedure Normalize(*V.Vector3)
  Define.f magSq, oneOverMag
  
  magSq = *V\x * *V\x + *V\y * *V\y + *V\z * *V\z
  If magsq > 0
    oneOverMag = 1.0 / Sqr(magSq)
    *V\x * oneOverMag
    *V\y * oneOverMag
    *V\z * oneOverMag
  EndIf 
  
EndProcedure


Procedure CreateTube(meshID, outerRadius.f, innerRadius.f, height.f, numSegBase=16, numSegHeight=1)
  
  Protected 	Normal.Vector3
  
  CreateMesh(meshID)
  
  If numSegBase < 1
    numSegBase = 1
  EndIf
  
  If numSegHeight < 1
    numSegHeight = 1
  EndIf
  
  deltaAngle.f = #PI*2 / numSegBase
  deltaHeight.f = height / numSegHeight
  height2.f = height / 2.0
  offset = 0
  
  For i = 0 To numSegHeight
    For j = 0 To numSegBase
      
      x0.f = outerRadius * Cos(j*deltaAngle)
      z0.f = outerRadius * Sin(j*deltaAngle)
      
      Normal\x = x0
      Normal\y = 0
      Normal\z = z0
      Normalize(@Normal)
      
      MeshVertexPosition(x0, i*deltaHeight-height2, z0)
      MeshVertexNormal(Normal\x, Normal\y, Normal\z)
      MeshVertexTextureCoordinate(j / numSegBase, i / numSegHeight)
      
      If  i <> numSegHeight
        
        MeshIndex(offset + numSegBase + 1)
        MeshIndex(offset)
        MeshIndex(offset + numSegBase)
        MeshIndex(offset + numSegBase + 1)
        MeshIndex(offset + 1)
        MeshIndex(offset)
      EndIf
      offset + 1
    Next
  Next	
  
  For i = 0 To numSegHeight
    For j = 0 To numSegBase
      
      x0.f = innerRadius * Cos(j*deltaAngle)
      z0.f = innerRadius * Sin(j*deltaAngle)
      
      Normal\x = x0
      Normal\y = 0
      Normal\z = z0
      Normalize(@Normal)
      
      MeshVertexPosition(x0, i*deltaHeight-height2, z0)
      MeshVertexNormal(Normal\x, Normal\y, Normal\z)
      MeshVertexTextureCoordinate(j / numSegBase, i / numSegHeight)
      
      If  i <> numSegHeight
        
        MeshIndex(offset + numSegBase + 1)
        MeshIndex(offset + numSegBase)
        MeshIndex(offset)
        MeshIndex(offset + numSegBase + 1)
        MeshIndex(offset)
        MeshIndex(offset + 1)
      EndIf
      offset + 1
    Next
  Next	
  
  
  ;low cap
  For j = 0 To numSegBase
    
    x0.f = innerRadius * Cos(j*deltaAngle)
    z0.f = innerRadius * Sin(j*deltaAngle)
    MeshVertexPosition(x0, -height2, z0)
    MeshVertexNormal(0, -1, 0)
    MeshVertexTextureCoordinate(j / numSegBase, 1)
    
    x0 = outerRadius * Cos(j*deltaAngle)
    z0 = outerRadius * Sin(j*deltaAngle)
    MeshVertexPosition(x0, -height2, z0)
    MeshVertexNormal(0, -1, 0)
    MeshVertexTextureCoordinate(j / numSegBase, 0)
    
    If j <> numSegBase
      
      MeshIndex(offset)
      MeshIndex(offset + 1)
      MeshIndex(offset + 3)
      MeshIndex(offset + 2)
      MeshIndex(offset)
      MeshIndex(offset + 3)
    EndIf
    offset + 2
  Next
  
  
  ;high cap
  For j = 0 To numSegBase
    
    x0.f = innerRadius * Cos(j*deltaAngle)
    z0.f = innerRadius * Sin(j*deltaAngle)
    MeshVertexPosition(x0, height2, z0)
    MeshVertexNormal(0, 1, 0)
    MeshVertexTextureCoordinate(j / numSegBase, 0)
    
    x0 = outerRadius * Cos(j*deltaAngle)
    z0 = outerRadius * Sin(j*deltaAngle)
    MeshVertexPosition(x0, height2, z0)
    MeshVertexNormal(0, 1, 0)
    MeshVertexTextureCoordinate(j / numSegBase, 1)
    
    If j <> numSegBase
      
      MeshIndex(offset + 1)
      MeshIndex(offset)
      MeshIndex(offset + 3)
      MeshIndex(offset)
      MeshIndex(offset + 2)
      MeshIndex(offset + 3)
    EndIf
    offset + 2
  Next
  
  FinishMesh(#True)
EndProcedure	


InitEngine3D()
InitSprite()
InitMouse()
InitKeyboard()

OpenWindow(0, 0, 0, 1024, 768, "hyuuy", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0),0, 0, 1024, 768)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures", #PB_3DArchive_FileSystem)

CreateTube(0, 1, 0.7, 3)

CreateMaterial(0, LoadTexture(0, "RustySteel.jpg"))
CreateEntity(0, MeshID(0), MaterialID(0))

CreateCamera(0, 0, 0, 100, 100)
MoveCamera(0, 0, 4, 3)
CameraLookAt(0,0,0,0)

Repeat
  
  Repeat
    ev = WindowEvent()
  Until ev = 0
  ExamineMouse()
  RotateCamera(0,-MouseDeltaY()* 0.04, -MouseDeltaX()* 0.04, 0, #PB_Relative)
  RotateEntity(0, 0.2, -0.1, 0.4, #PB_Relative)
  RenderWorld()
  
  ExamineKeyboard()
  
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
Please correct my english
http://purebasic.developpez.com/
applePi
Addict
Addict
Posts: 1404
Joined: Sun Jun 25, 2006 7:28 pm

Re: Semi Cylinder (5.40 beta 10)

Post by applePi »

this is a big Gift, thanks Comtois for providing a real thick tube code, i want always to design a thick tube but don't know how to weave one, not an easy task, and with the ability to change numSegHeight to higher number we have more choices such as bending the tube. this thick tube should be added to the official 3D functions.
it seems the above dividing the cylinder works also with the thick tube
my future duty is to remove the ground so to have a real semi tube/cylinder
i have found that deltaAngle.f = #PI*2 / numSegBase /2 will divide the thick tube with few side effects.
here is your CreateTube proc but adding the dividing code using the same code as in cylinder

Code: Select all

Global Dim MeshData.PB_MeshVertex(0)
Global Dim MeshDataInd.PB_MeshFace(0)

Structure Vector3
  x.f
  y.f
  z.f
EndStructure

Procedure Normalize(*V.Vector3)
  Define.f magSq, oneOverMag
  
  magSq = *V\x * *V\x + *V\y * *V\y + *V\z * *V\z
  If magsq > 0
    oneOverMag = 1.0 / Sqr(magSq)
    *V\x * oneOverMag
    *V\y * oneOverMag
    *V\z * oneOverMag
  EndIf 
  
EndProcedure


Procedure CreateTube(meshID, outerRadius.f, innerRadius.f, height.f, numSegBase=16, numSegHeight=1)
  
  Protected    Normal.Vector3
  
  CreateMesh(meshID)
  
  If numSegBase < 1
    numSegBase = 1
  EndIf
  
  If numSegHeight < 1
    numSegHeight = 1
  EndIf
  
  deltaAngle.f = #PI*2 / numSegBase
  deltaHeight.f = height / numSegHeight
  height2.f = height / 2.0
  offset = 0
  
  For i = 0 To numSegHeight
    For j = 0 To numSegBase
      
      x0.f = outerRadius * Cos(j*deltaAngle)
      z0.f = outerRadius * Sin(j*deltaAngle)
      
      Normal\x = x0
      Normal\y = 0
      Normal\z = z0
      Normalize(@Normal)
      
      MeshVertexPosition(x0, i*deltaHeight-height2, z0)
      MeshVertexNormal(Normal\x, Normal\y, Normal\z)
      MeshVertexTextureCoordinate(j / numSegBase, i / numSegHeight)
      
      If  i <> numSegHeight
        
        MeshIndex(offset + numSegBase + 1)
        MeshIndex(offset)
        MeshIndex(offset + numSegBase)
        MeshIndex(offset + numSegBase + 1)
        MeshIndex(offset + 1)
        MeshIndex(offset)
      EndIf
      offset + 1
    Next
  Next   
  
  For i = 0 To numSegHeight
    For j = 0 To numSegBase
      
      x0.f = innerRadius * Cos(j*deltaAngle)
      z0.f = innerRadius * Sin(j*deltaAngle)
      
      Normal\x = x0
      Normal\y = 0
      Normal\z = z0
      Normalize(@Normal)
      
      MeshVertexPosition(x0, i*deltaHeight-height2, z0)
      MeshVertexNormal(Normal\x, Normal\y, Normal\z)
      MeshVertexTextureCoordinate(j / numSegBase, i / numSegHeight)
      
      If  i <> numSegHeight
        
        MeshIndex(offset + numSegBase + 1)
        MeshIndex(offset + numSegBase)
        MeshIndex(offset)
        MeshIndex(offset + numSegBase + 1)
        MeshIndex(offset)
        MeshIndex(offset + 1)
      EndIf
      offset + 1
    Next
  Next   
  
  
  ;low cap
  For j = 0 To numSegBase
    
    x0.f = innerRadius * Cos(j*deltaAngle)
    z0.f = innerRadius * Sin(j*deltaAngle)
    MeshVertexPosition(x0, -height2, z0)
    MeshVertexNormal(0, -1, 0)
    MeshVertexTextureCoordinate(j / numSegBase, 1)
    
    x0 = outerRadius * Cos(j*deltaAngle)
    z0 = outerRadius * Sin(j*deltaAngle)
    MeshVertexPosition(x0, -height2, z0)
    MeshVertexNormal(0, -1, 0)
    MeshVertexTextureCoordinate(j / numSegBase, 0)
    
    If j <> numSegBase
      
      MeshIndex(offset)
      MeshIndex(offset + 1)
      MeshIndex(offset + 3)
      MeshIndex(offset + 2)
      MeshIndex(offset)
      MeshIndex(offset + 3)
    EndIf
    offset + 2
  Next
  
  
  ;high cap
  For j = 0 To numSegBase
    
    x0.f = innerRadius * Cos(j*deltaAngle)
    z0.f = innerRadius * Sin(j*deltaAngle)
    MeshVertexPosition(x0, height2, z0)
    MeshVertexNormal(0, 1, 0)
    MeshVertexTextureCoordinate(j / numSegBase, 0)
    
    x0 = outerRadius * Cos(j*deltaAngle)
    z0 = outerRadius * Sin(j*deltaAngle)
    MeshVertexPosition(x0, height2, z0)
    MeshVertexNormal(0, 1, 0)
    MeshVertexTextureCoordinate(j / numSegBase, 1)
    
    If j <> numSegBase
      
      MeshIndex(offset + 1)
      MeshIndex(offset)
      MeshIndex(offset + 3)
      MeshIndex(offset)
      MeshIndex(offset + 2)
      MeshIndex(offset + 3)
    EndIf
    offset + 2
  Next
  
  FinishMesh(#True)
  
  ;;==========================================================================
  ;;==========================================================================
  CreateMesh(7, #PB_Mesh_TriangleList, #PB_Mesh_Dynamic)

  GetMeshData(0,0, MeshData(), #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate , 0, MeshVertexCount(0)-1)
  GetMeshData(0,0, MeshDataInd(), #PB_Mesh_Face, 0, MeshIndexCount(0, 0)-1)
  ArrSize = ArraySize(MeshData())
   For c=0 To ArrSize
      
      x.f = MeshData(c)\x 
      y.f = MeshData(c)\y
      z.f = MeshData(c)\z
            
      If z > 0 : z=0 :EndIf
         MeshVertexPosition(x,y,z)
         MeshVertexTextureCoordinate(MeshData(c)\u, MeshData(c)\v) 
         MeshVertexNormal(MeshData(c)\NormalX, MeshData(c)\NormalY, MeshData(c)\NormalZ)
         
      
   Next   
   
   ArrSizeInd = ArraySize(MeshDataInd()) 
   
   For i=0 To ArrSizeInd Step 3
     MeshFace(MeshDataInd(i)\Index, MeshDataInd(i+1)\Index,MeshDataInd(i+2)\Index)
   Next 
   
   FinishMesh(#True)
EndProcedure   


InitEngine3D()
InitSprite()
InitMouse()
InitKeyboard()

OpenWindow(0, 0, 0, 800, 600, "hyuuy", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0),0, 0, 800, 600)
Add3DArchive(#PB_Compiler_Home + "examples/3d/Data/Textures", #PB_3DArchive_FileSystem)

CreateTube(0, 1, 0.7, 3)

CreateMaterial(0, LoadTexture(0, "ValetCoeur.jpg"))
;MaterialShadingMode(0, #PB_Material_Wireframe)
CreateEntity(7, MeshID(7), MaterialID(0))

CreateCamera(0, 0, 0, 100, 100)
MoveCamera(0, 0, 4, 3)
CameraLookAt(0,0,0,0)

Repeat
  
  Repeat
    ev = WindowEvent()
  Until ev = 0
  ExamineMouse()
  RotateCamera(0,-MouseDeltaY()* 0.04, -MouseDeltaX()* 0.04, 0, #PB_Relative)
  RotateEntity(7, 0.2, -0.1, 0.4, #PB_Relative)
  RenderWorld()
  
  ExamineKeyboard()
  
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)

Joris
Addict
Addict
Posts: 890
Joined: Fri Oct 16, 2009 10:12 am
Location: BE

Re: Semi Cylinder (5.40 beta 10)

Post by Joris »

With all tree sample codes I get errors. (XP SP3)

[13:10:19] [ERROR] Line: 36
[13:10:19] [ERROR] MoveCamera(): invalid value specified for parameter 'Mode'.

[13:10:59] [ERROR] Line: 41
[13:10:59] [ERROR] CreateLight(): invalid value specified for parameter 'Flags'.

[13:11:47] [ERROR] Line: 171
[13:11:47] [ERROR] MoveCamera(): invalid value specified for parameter 'Mode'.

[13:12:39] [ERROR] Line: 161
[13:12:39] [ERROR] GetMeshData(): invalid value specified for parameter 'Flags'.
Yeah I know, but keep in mind ... Leonardo da Vinci was also an autodidact.
applePi
Addict
Addict
Posts: 1404
Joined: Sun Jun 25, 2006 7:28 pm

Re: Semi Cylinder (5.40 beta 10)

Post by applePi »

@Joris, i remember these errors output was in the versions before PB 5.40 Beta 10 when the debugger is on only. but with beta 10 and the latest 5.40 LTS these debugger errors fixed. try the latest 5.40 LTS. i run the code also in windows xp3, PB 5.40 LTS/x86
User avatar
DK_PETER
Addict
Addict
Posts: 904
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:

Re: Semi Cylinder (PB 5.40 LTS)

Post by DK_PETER »

@Comtois & @applePI

Looks good. I really like the tube and the half cylinder example has potential too. :-)
Thank you both for the examples.
Adding the meshes from StarBootics and we got a nice collection of meshes to work with. :-)

Here's a little something from me. Messy but functioning.

Code: Select all

;NAME: MIDEVAL
;BY DK_PETER
;-----------------------------------------
;Test for CreateCone() and CreateTube()
;-----------------------------------------
Structure Vector3
  x.f
  y.f
  z.f
EndStructure

Procedure Normalize(*V.Vector3)
  Define.f magSq, oneOverMag
  
  magSq = *V\x * *V\x + *V\y * *V\y + *V\z * *V\z
  If magsq > 0
    oneOverMag = 1.0 / Sqr(magSq)
    *V\x * oneOverMag
    *V\y * oneOverMag
    *V\z * oneOverMag
  EndIf
EndProcedure

Procedure CreateTube(meshID, outerRadius.f, innerRadius.f, height.f, numSegBase=16, numSegHeight=1)
  
  Protected    Normal.Vector3, returnMesh.i
  
  If meshID = -1
    returnMesh = CreateMesh(#PB_Any)
  Else
    returnMesh = meshID
    CreateMesh(returnMesh)
  EndIf
  
  If numSegBase < 1
    numSegBase = 1
  EndIf
  
  If numSegHeight < 1
    numSegHeight = 1
  EndIf
  
  deltaAngle.f = #PI*2 / numSegBase
  deltaHeight.f = height / numSegHeight
  height2.f = height / 2.0
  offset = 0
  
  For i = 0 To numSegHeight
    For j = 0 To numSegBase
      
      x0.f = outerRadius * Cos(j*deltaAngle)
      z0.f = outerRadius * Sin(j*deltaAngle)
      
      Normal\x = x0
      Normal\y = 0
      Normal\z = z0
      Normalize(@Normal)
      
      MeshVertexPosition(x0, i*deltaHeight-height2, z0)
      MeshVertexNormal(Normal\x, Normal\y, Normal\z)
      MeshVertexTextureCoordinate(j / numSegBase, i / numSegHeight)
      
      If  i <> numSegHeight
        
        MeshIndex(offset + numSegBase + 1)
        MeshIndex(offset)
        MeshIndex(offset + numSegBase)
        MeshIndex(offset + numSegBase + 1)
        MeshIndex(offset + 1)
        MeshIndex(offset)
      EndIf
      offset + 1
    Next
  Next   
  
  For i = 0 To numSegHeight
    For j = 0 To numSegBase
      
      x0.f = innerRadius * Cos(j*deltaAngle)
      z0.f = innerRadius * Sin(j*deltaAngle)
      
      Normal\x = x0
      Normal\y = 0
      Normal\z = z0
      Normalize(@Normal)
      
      MeshVertexPosition(x0, i*deltaHeight-height2, z0)
      MeshVertexNormal(Normal\x, Normal\y, Normal\z)
      MeshVertexTextureCoordinate(j / numSegBase, i / numSegHeight)
      
      If  i <> numSegHeight
        
        MeshIndex(offset + numSegBase + 1)
        MeshIndex(offset + numSegBase)
        MeshIndex(offset)
        MeshIndex(offset + numSegBase + 1)
        MeshIndex(offset)
        MeshIndex(offset + 1)
      EndIf
      offset + 1
    Next
  Next   
  
  ;low cap
  For j = 0 To numSegBase
    
    x0.f = innerRadius * Cos(j*deltaAngle)
    z0.f = innerRadius * Sin(j*deltaAngle)
    MeshVertexPosition(x0, -height2, z0)
    MeshVertexNormal(0, -1, 0)
    MeshVertexTextureCoordinate(j / numSegBase, 1)
    
    x0 = outerRadius * Cos(j*deltaAngle)
    z0 = outerRadius * Sin(j*deltaAngle)
    MeshVertexPosition(x0, -height2, z0)
    MeshVertexNormal(0, -1, 0)
    MeshVertexTextureCoordinate(j / numSegBase, 0)
    
    If j <> numSegBase
      
      MeshIndex(offset)
      MeshIndex(offset + 1)
      MeshIndex(offset + 3)
      MeshIndex(offset + 2)
      MeshIndex(offset)
      MeshIndex(offset + 3)
    EndIf
    offset + 2
  Next
  
  ;high cap
  For j = 0 To numSegBase
    
    x0.f = innerRadius * Cos(j*deltaAngle)
    z0.f = innerRadius * Sin(j*deltaAngle)
    MeshVertexPosition(x0, height2, z0)
    MeshVertexNormal(0, 1, 0)
    MeshVertexTextureCoordinate(j / numSegBase, 0)
    
    x0 = outerRadius * Cos(j*deltaAngle)
    z0 = outerRadius * Sin(j*deltaAngle)
    MeshVertexPosition(x0, height2, z0)
    MeshVertexNormal(0, 1, 0)
    MeshVertexTextureCoordinate(j / numSegBase, 1)
    
    If j <> numSegBase
      
      MeshIndex(offset + 1)
      MeshIndex(offset)
      MeshIndex(offset + 3)
      MeshIndex(offset)
      MeshIndex(offset + 2)
      MeshIndex(offset + 3)
    EndIf
    offset + 2
  Next
  FinishMesh(#True)
  ProcedureReturn returnMesh
EndProcedure   

;-----------------------------------------------------------------------------------------

InitEngine3D()
InitSprite()
InitMouse()
InitKeyboard()

UseJPEGImageEncoder()
UseJPEGImageDecoder()
UsePNGImageDecoder()

Structure _mesh
  id.i
  mat.i
  mes.i
  tex.i
EndStructure

Structure _Castle
  tow._mesh[4]
  roof._mesh
  walls._mesh[6]
  Bridge._mesh
  pillars._mesh[3]
  base._mesh
  fire._mesh
  smoke._mesh
EndStructure 

Declare.i CreateCastle()
Declare.i CreateClouds()
Declare.i CreateLand()
Declare.i CreateSky()
Declare.f FastDist(x1.f, y1.f, z1.f, x2.f, y2.f, z2.f)

Global cas._Castle, grnd._mesh, cl._mesh, Quit.i = 0, TmpPath.s, fd.f
Define.f KeyX, KeyY

TmpPath = #PB_Compiler_Home + "Examples\3D\Data\Textures\"
OpenWindow(0, 0, 0, 1024, 768, "Mideval - use arrow keys and enter...", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0),0, 0, 1024, 768)
Add3DArchive("..",#PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "Examples\3D\Data\Textures", #PB_3DArchive_FileSystem)
CreateCamera(0, 0, 0, 100, 100)
MoveCamera(0, 0, 1, 40)

CreateLight(0, $FFFFFF, 0, 50, -250, #PB_Light_Directional)
LightLookAt(0, 0, 0, 0)

CreateLand()
CreateSky()
CreateClouds()
CreateCastle()

Repeat
  
  Repeat
    ev = WindowEvent()
    If ev = #PB_Event_CloseWindow : quit = 1 : EndIf
  Until ev = 0
  
  ExamineMouse()
  
  RotateCamera(0,-MouseDeltaY()* 0.04, -MouseDeltaX()* 0.04, 0, #PB_Relative)
  
  ExamineKeyboard()
  
  If KeyboardPushed(#PB_Key_Left)
    KeyX = -0.05
  ElseIf KeyboardPushed(#PB_Key_Right)
    KeyX = 0.05
  Else
    KeyX = 0
  EndIf
  
  If KeyboardPushed(#PB_Key_Up)
    KeyY = -0.05
  ElseIf KeyboardPushed(#PB_Key_Down)
    KeyY = 0.05
  Else
    KeyY = 0
  EndIf
  
  fd = FastDist(CameraX(0), CameraY(0), CameraZ(0), 0, 0, 0) 
  If fd < 90
    RotateEntity(cas\Bridge\id, -fd, 0, 0, #PB_Absolute)
  ElseIf fd > 90
    RotateEntity(cas\Bridge\id, 90, 0, 0, #PB_Absolute)
  EndIf
  MoveCamera(0, KeyX, 0, KeyY)
  MoveCamera(0, CameraX(0), 1, CameraZ(0), #PB_Absolute) 
  RenderWorld()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1


Procedure.i CreateLand()
  Protected iim.i 
  With grnd
    iim = LoadImage(#PB_Any,TmpPath + "grass.jpg")
    \mes = CreatePlane(#PB_Any, 100, 100, 1, 1, 1, 1)
    \tex = CreateTexture(#PB_Any, 2048, 2048)
    StartDrawing(TextureOutput(\tex))
    For x = 0 To 3
      For y = 0 To 3
        DrawImage(ImageID(IIm), x*ImageWidth(iim), y * ImageHeight(iim))
      Next y
    Next x
    FreeImage(iim)
    For y = 0 To 2048 Step 2
      Select Random(100, 0)
        Case 0 To 25
          Ellipse(990+2, y, 60, 5,$06516F)
        Case 26 To 50
          Ellipse(990-2, y, 60, 5,$06516F)
        Case 51 To 75
          Ellipse(990+6, y, 60, 5,$06516F)
        Default
          Ellipse(990-6, y, 60, 5,$06516F)
      EndSelect
      Select Random(100, 0)
        Case 0 To 25
          Ellipse(1000+1, y, 3, 8,$004702)
        Case 26 To 50
          Ellipse(1000-1, y, 3, 8,$004702)
        Case 51 To 75
          Ellipse(1000+1, y, 3, 8,$004702)
        Default
          Ellipse(1000-1, y, 3, 8,$004702)
      EndSelect
      Select Random(100, 0)
        Case 0 To 25
          Ellipse(970+1, y, 9, 16,$082840)
        Case 26 To 50
          Ellipse(970-1, y, 9, 16,$082840)
        Case 51 To 75
          Ellipse(970+1, y, 9, 12,$082840)
        Default
          Ellipse(970-1, y, 9, 16,$082840)
      EndSelect
      Select Random(100, 0)
        Case 0 To 25
          Ellipse(1025+1, y, 9, 16,$082840)
        Case 26 To 50
          Ellipse(1025-1, y, 9, 16,$082840)
        Case 51 To 75
          Ellipse(1025+1, y, 9, 12,$082840)
        Default
          Ellipse(1025-1, y, 9, 16,$082840)
      EndSelect
    Next y  
    StopDrawing()
    \mat = CreateMaterial(#PB_Any, TextureID(\tex))
    \id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat))
  EndWith
EndProcedure

Procedure.i CreateCastle()
  Protected tx.i, piltex.i, Shift.i = 0
  tx = LoadTexture(#PB_Any, "terrain_detail.jpg")
  piltex = LoadTexture(#PB_Any, "Wood.jpg")
  
  With cas\walls[0]
    \mes = CreatePlane(#PB_Any, 5, 6, 10, 10, 1, 1)
    \mat = CreateMaterial(#PB_Any, TextureID(tx))
    MaterialCullingMode(\mat , #PB_Material_NoCulling)
    \id  = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),-5,0,0)
    RotateEntity(\id, 90, 0, 0)
  EndWith
  With cas\walls[1]
    \mes = CreatePlane(#PB_Any, 15, 6, 10, 10, 2, 1)
    \mat = CreateMaterial(#PB_Any, TextureID(tx))
    MaterialCullingMode(\mat , #PB_Material_NoCulling)
    \id  = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),-7.5,0,-7.5)
    RotateEntity(\id, 90, 90, 0)
  EndWith
  With cas\tow[0]
    \mes = CreateTube(#PB_Any, 2, 1, 15, 16, 10)
    \mat = CreateMaterial(#PB_Any, TextureID(tx))
    MaterialCullingMode(\mat , #PB_Material_NoCulling)
    \id  = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),-9,0,-0.5)
  EndWith
  
  With cas\walls[2]
    \mes = CreatePlane(#PB_Any, 5, 6, 10, 10, 1, 1)
    \mat = CreateMaterial(#PB_Any, TextureID(tx))
    MaterialCullingMode(\mat , #PB_Material_NoCulling)
    \id  = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),5,0,0)
    RotateEntity(\id, 90, 0, 0)
  EndWith
  With cas\walls[3]
    \mes = CreatePlane(#PB_Any, 15, 6, 10, 10, 2, 1)
    \mat = CreateMaterial(#PB_Any, TextureID(tx))
    MaterialCullingMode(\mat , #PB_Material_NoCulling)
    \id  = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),7.5,0,-7.5)
    RotateEntity(\id, 90, 90, 0)
  EndWith
  With cas\tow[1]
    \mes = CreateTube(#PB_Any, 2, 1, 15, 16, 10)
    \mat = CreateMaterial(#PB_Any, TextureID(tx))
    MaterialCullingMode(\mat , #PB_Material_NoCulling)
    \id  = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),9,0,-0.5)
  EndWith
  
  With cas\tow[2]
    \mes = CreateTube(#PB_Any, 2, 1, 15, 16, 10)
    \mat = CreateMaterial(#PB_Any, TextureID(tx))
    MaterialCullingMode(\mat , #PB_Material_NoCulling)
    \id  = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),-9,0,-15.5)
  EndWith
  With cas\tow[3]
    \mes = CreateTube(#PB_Any, 2, 1, 15, 16, 10)
    \mat = CreateMaterial(#PB_Any, TextureID(tx))
    MaterialCullingMode(\mat , #PB_Material_NoCulling)
    \id  = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),9,0,-15.5)
  EndWith
  With cas\walls[4]
    \mes = CreatePlane(#PB_Any, 15, 6, 10, 10, 2, 1)
    \mat = CreateMaterial(#PB_Any, TextureID(tx))
    MaterialCullingMode(\mat , #PB_Material_NoCulling)
    \id  = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),0,0,-15)
    RotateEntity(\id, 90, 0, 0)
  EndWith
  With cas\walls[5]
    \mes = CreatePlane(#PB_Any, 15, 3, 10, 10, 2, 1)
    \mat = CreateMaterial(#PB_Any, TextureID(tx))
    MaterialCullingMode(\mat , #PB_Material_NoCulling)
    \id  = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat),0,4.5,0)
    RotateEntity(\id, 90, 0, 0)
  EndWith
  
  With cas\base
    \mes = CreateTube(#PB_Any, 1.3, 1.8, 2.0)
    \mat = CreateMaterial(#PB_Any, TextureID(tx))
    MaterialCullingMode(\mat, #PB_Material_NoCulling)
    \id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 0, 0, -10.5)
  EndWith
  
  With cas\roof
    ;Added CreateCone's NbBaseSegment and NbHeightSegments to make it work with PB x86 and windows. If omitted - an error occur for (Unknown reason?)
    \mes = CreateCone(#PB_Any, 2.3, 1.5, 32, 16)    
    \tex = LoadTexture(#PB_Any, "RustySteel.jpg")
    \mat = CreateMaterial(#PB_Any, TextureID(\tex))
    MaterialCullingMode(\mat, #PB_Material_NoCulling)
    \id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 0, 2.6, -10.5)
  EndWith
  
  With cas\pillars[0]
    \mat = CreateMaterial(#PB_Any, TextureID(piltex))
    \mes = CreateCylinder(#PB_Any, 0.1, 1)
    \id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 0, 1.5, -9)
  EndWith
  
  With cas\pillars[1]
    \mat = CreateMaterial(#PB_Any, TextureID(piltex))
    \mes = CreateCylinder(#PB_Any, 0.1, 1)
    \id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), -1.2, 1.5, -11)
  EndWith
  
  With cas\pillars[2]
    \mat = CreateMaterial(#PB_Any, TextureID(piltex))
    \mes = CreateCylinder(#PB_Any, 0.1, 1)
    \id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 1.2, 1.5, -11)
  EndWith
  
  With cas\Fire
    \tex = CreateTexture(#PB_Any, 10, 10)
    StartDrawing(TextureOutput(\tex))
    DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient)
    FrontColor($FF00FFFF) : BackColor($FF0020FF)
    CircularGradient(5, 7, 5)
    Circle(5, 5, 5)
    StopDrawing()
    \id = CreateParticleEmitter(#PB_Any, 0.6, 0.6, 0.6,#PB_Particle_Point, 0, 0.3, -11)
    \mat = CreateMaterial(#PB_Any, TextureID(\tex))
    MaterialBlendingMode(\mat, #PB_Material_Add)
    MaterialCullingMode(\mat, #PB_Material_NoCulling)
    ParticleEmitterDirection(\id, 0, 1, 0)
    ParticleEmissionRate(\id, 200)
    ParticleSize(\id, 0.1, 0.7)
    ParticleMaterial(\id, MaterialID(\mat))
    ParticleVelocity(\id, 0.1, 1)
    ParticleTimeToLive(\id,0.01, 0.1)
    ParticleSpeedFactor(\id, 0.4)
  EndWith
  
  With cas\smoke
    \tex = LoadTexture(#PB_Any, "smoke.png")
    \id = CreateParticleEmitter(#PB_Any, 0.3, 0.5, 0.5,#PB_Particle_Point, 0, 0.6, -11)
    \mat = CreateMaterial(#PB_Any, TextureID(\tex))
    MaterialBlendingMode(\mat, #PB_Material_AlphaBlend)
    ParticleEmitterDirection(\id, 0, 1, 0)
    ParticleEmissionRate(\id, 30)
    ParticleSize(\id, 1.3, 1.3)
    ParticleMaterial(\id, MaterialID(\mat))
    ParticleVelocity(\id, 0.1, 0.2)
    ParticleTimeToLive(\id,0.6, 1.0)
    ParticleSpeedFactor(\id, 0.1)
  EndWith
  
  With cas\Bridge
    \mat = CreateMaterial(#PB_Any, TextureID(piltex))
    MaterialCullingMode(\mat, #PB_Material_NoCulling)
    \mes = CreatePlane(#PB_Any, 5, 6, 10, 10, 1, 1)
    \id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 0, 0, 0)
    RotateEntity(\id, 90, 0, 0)
  EndWith
EndProcedure

Procedure.i CreateClouds()
  cl\tex = LoadTexture(#PB_Any, "terrain.png")
  cl\mes = CreatePlane(#PB_Any, 300, 300, 10, 10, 1, 1)
  cl\mat = CreateMaterial(#PB_Any, TextureID(cl\tex))
  MaterialBlendingMode(cl\mat, #PB_Material_Color)
  AddMaterialLayer(cl\mat, TextureID(cl\tex), #PB_Material_Add)
  ScaleMaterial(cl\mat, 2, 2, 0) : ScaleMaterial(cl\mat, 2, 2, 1)
  ScrollMaterial(cl\mat, 0.01, 0.01, #PB_Material_Animated,0)
  ScrollMaterial(cl\mat, -0.01, 0.01, #PB_Material_Animated,1)
  MaterialCullingMode(cl\mat, #PB_Material_AntiClockWiseCull)
  cl\id = CreateEntity(#PB_Any, MeshID(cl\mes), MaterialID(cl\mat), 0, 100, 0)
  ScaleEntity(cl\id, 20, 10, 20)
EndProcedure

Procedure.i CreateSky()
  Protected im.i
  im = CreateImage(#PB_Any, 10, 10)
  StartDrawing(ImageOutput(im))
  Box(0, 0, 10, 10, $D6755A)
  StopDrawing()
  SaveImage(im, "sky_FR.jpg", #PB_ImagePlugin_JPEG, 10)
  SaveImage(im, "sky_BK.jpg", #PB_ImagePlugin_JPEG, 10)
  SaveImage(im, "sky_LF.jpg", #PB_ImagePlugin_JPEG, 10)
  SaveImage(im, "sky_RT.jpg", #PB_ImagePlugin_JPEG, 10)
  SaveImage(im, "sky_UP.jpg", #PB_ImagePlugin_JPEG, 10)
  SaveImage(im, "sky_DN.jpg", #PB_ImagePlugin_JPEG, 10)
  SkyBox("sky.jpg")
EndProcedure

Procedure.f FastDist(x1.f, y1.f, z1.f, x2.f, y2.f, z2.f)
  x3.f = x1-x2 : x3 = x3*x3
  y3.f = y1-y2 : y3 = y3*y3
  z3.f = z1-z2 : z3 = z3*z3
  dist.f = x3 + y3 + z3
  ProcedureReturn  dist
EndProcedure
Last edited by DK_PETER on Sun Oct 18, 2015 11:46 am, edited 2 times in total.
Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
applePi
Addict
Addict
Posts: 1404
Joined: Sun Jun 25, 2006 7:28 pm

Re: Semi Cylinder (PB 5.40 LTS)

Post by applePi »

this is a wonderful example DK_PETER thanks, there is an automatic door for the castle, i can go inside the thick tubes and between the inner and outer sides. in general a good castle scene and a base for a possible game. i run your code okay in windows 7/ 64bit.
but in windows xp/x86 it is strange i got the msg:
in line 409 (and in the materials after this line):
\mat = CreateMaterial(#PB_Any, TextureID(piltex))
[error] the specified #Texture is not initialised
while this code run okay in windows 7/64
this is may be a limitation in windows xp/x86

* where is the meshes from StarBootics ?
i will go to sleep, good night, good evening, good morning
applePi
Addict
Addict
Posts: 1404
Joined: Sun Jun 25, 2006 7:28 pm

Re: Semi Cylinder (PB 5.40 LTS)

Post by applePi »

something unusual in PB5.40LTS(x86), i have installed it in win7/64 and it gives the same error, i have downloaded it again just now and the same behaviour. so it is not the windows xp it is the x86 version. even if i change the texture wood.jpg to any other texture.
i have tried the code in v5.31 (x86) after deleting the createcone and it works okay. so this confirms that PB5.40 x86 have a problem . can't imagine what it is.

Edit: if we delete these lines 400- 406 for the Cone:

Code: Select all

With cas\roof
    \mes = CreateCone(#PB_Any, 2.3, 1.5)  
    \tex = LoadTexture(#PB_Any, "RustySteel.jpg")
    \mat = CreateMaterial(#PB_Any, TextureID(\tex))
    MaterialCullingMode(\mat, #PB_Material_NoCulling)
    \id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 0, 2.6, -10.5)
  EndWith
the code run now okay in 5.40(x86) !!
Joris
Addict
Addict
Posts: 890
Joined: Fri Oct 16, 2009 10:12 am
Location: BE

Re: Semi Cylinder (5.40 beta 10)

Post by Joris »

applePi wrote:@Joris, i remember these errors output was in the versions before PB 5.40 Beta 10 when the debugger is on only. but with beta 10 and the latest 5.40 LTS these debugger errors fixed. try the latest 5.40 LTS. i run the code also in windows xp3, PB 5.40 LTS/x86
Problem solved by using the latest PB 5.40 LTS/x86.
Debugger active doesn't matter.

Thanks.
Yeah I know, but keep in mind ... Leonardo da Vinci was also an autodidact.
User avatar
DK_PETER
Addict
Addict
Posts: 904
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:

Re: Semi Cylinder (PB 5.40 LTS)

Post by DK_PETER »

applePi wrote:something unusual in PB5.40LTS(x86), i have installed it in win7/64 and it gives the same error, i have downloaded it again just now and the same behaviour. so it is not the windows xp it is the x86 version. even if i change the texture wood.jpg to any other texture.
i have tried the code in v5.31 (x86) after deleting the createcone and it works okay. so this confirms that PB5.40 x86 have a problem . can't imagine what it is.

Edit: if we delete these lines 400- 406 for the Cone:

Code: Select all

With cas\roof
    \mes = CreateCone(#PB_Any, 2.3, 1.5)  
    \tex = LoadTexture(#PB_Any, "RustySteel.jpg")
    \mat = CreateMaterial(#PB_Any, TextureID(\tex))
    MaterialCullingMode(\mat, #PB_Material_NoCulling)
    \id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 0, 2.6, -10.5)
  EndWith
the code run now okay in 5.40(x86) !!
applePi wrote:something unusual in PB5.40LTS(x86), i have installed it in win7/64 and it gives the same error, i have downloaded it again just now and the same behaviour. so it is not the windows xp it is the x86 version. even if i change the texture wood.jpg to any other texture.
i have tried the code in v5.31 (x86) after deleting the createcone and it works okay. so this confirms that PB5.40 x86 have a problem . can't imagine what it is.

Edit: if we delete these lines 400- 406 for the Cone:

Code: Select all

With cas\roof
    \mes = CreateCone(#PB_Any, 2.3, 1.5)  
    \tex = LoadTexture(#PB_Any, "RustySteel.jpg")
    \mat = CreateMaterial(#PB_Any, TextureID(\tex))
    MaterialCullingMode(\mat, #PB_Material_NoCulling)
    \id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 0, 2.6, -10.5)
  EndWith
the code run now okay in 5.40(x86) !!
That's really weird. I've tried it myself with the same results in x86. :shock:
If you place it at the end of the procedure, it will just ....hang....

I can't explain why, since the following code works perfectly in x86 (w7):

Code: Select all

InitEngine3D()
InitSprite()
InitKeyboard()

Global Quit = 0

OpenWindow(0, 0, 0, 1024, 768, "Cone test x86", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0), 0, 0, 1024, 768)
Add3DArchive(#PB_Compiler_Home + "Examples\3D\Data\Textures", #PB_3DArchive_FileSystem)

CreateCamera(0, 0, 0, 100, 100)

CreateTexture(0, 512, 512)
StartDrawing(TextureOutput(0))
Box(0, 0, 512, 512, $7CACAD)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(0, 250, "Fallaces sunt rerum species", $7C27AD)
StopDrawing()
CreateMaterial(0, TextureID(0))
RotateMaterial(0, 180, #PB_Material_Fixed)
CreateCone(0, 2.5, 2)
CreateEntity(0, MeshID(0), MaterialID(0), 2, 0, -10)

LoadTexture(1, "wood.jpg")
CreateMaterial(1, TextureID(1))
CreateCone(1, 2.5, 2)
CreateEntity(1, MeshID(1), MaterialID(1), -2, 0, -10)

Repeat
  
  Repeat
    ev = WindowEvent()  
    If ev = #PB_Event_CloseWindow : Quit = 1 : EndIf
  Until  ev = 0
  RotateEntity(0, 0, -0.5, 0, #PB_Relative)
  ExamineKeyboard()
  
  RenderWorld()
  
  FlipBuffers()
  
Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1
So...I'm at a loss for the moment.

Anyway: Here's the Starbootic meshes:
http://www.purebasic.fr/english/viewtop ... 36&t=61370

Now we lack a rectangle mesh with the ability to be hollow and 3D newbies will be able to do almost anything without
dwelving into the intricates of mesh creation.
Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
applePi
Addict
Addict
Posts: 1404
Joined: Sun Jun 25, 2006 7:28 pm

Re: Semi Cylinder (PB 5.40 LTS)

Post by applePi »

Hi DK_PETER
just now i have found this:
in (x86) add NbBaseSegments, NbHeightSegments to the createcone:
line 401
\mes = CreateCone(#PB_Any, 2.3, 1.5, 16, 16)
and the code will work okay in (x86)
strangely your last code above works in x86 even there is no NbBaseSegments, NbHeightSegments in the createcone.
so seems the problem with the ... i don't know
here is a cut from your castle code : which works if NbBaseSegments, NbHeightSegments in the createcone exist in (x86) but will not work if we remove it

Code: Select all

InitEngine3D()
InitSprite()
InitMouse()
InitKeyboard()

UseJPEGImageEncoder()
UseJPEGImageDecoder()
UsePNGImageDecoder()


Structure _mesh
  id.i
  mat.i
  mes.i
  tex.i
EndStructure

Structure _Castle
  tow._mesh[4]
  roof._mesh
  walls._mesh[6]
  Bridge._mesh
  pillars._mesh[3]
  base._mesh
  fire._mesh
  smoke._mesh
EndStructure 

Declare.i CreateCastle()
Declare.i CreateClouds()
Declare.i CreateLand()
Declare.i CreateSky()
Declare.f FastDist(x1.f, y1.f, z1.f, x2.f, y2.f, z2.f)

Global cas._Castle, grnd._mesh, cl._mesh, Quit.i = 0, TmpPath.s, fd.f
Define.f KeyX, KeyY

TmpPath = #PB_Compiler_Home + "Examples\3D\Data\Textures\"
OpenWindow(0, 0, 0, 1024, 768, "Mideval - use arrow keys and enter...", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
OpenWindowedScreen(WindowID(0),0, 0, 1024, 768)
Add3DArchive(".",#PB_3DArchive_FileSystem)
;Add3DArchive(#PB_Compiler_Home + "Examples\3D\Data\Textures", #PB_3DArchive_FileSystem)
Add3DArchive(#PB_Compiler_Home + "Examples/3D/Data/Textures", #PB_3DArchive_FileSystem)
CreateCamera(0, 0, 0, 100, 100)
MoveCamera(0, 0, 1, 40)

CreateLight(0, $FFFFFF, 0, 50, -250, #PB_Light_Directional)
LightLookAt(0, 0, 0, 0)

CreateCastle()

Repeat
  
  Repeat
    ev = WindowEvent()
    If ev = #PB_Event_CloseWindow : quit = 1 : EndIf
  Until ev = 0
  
  ExamineMouse()
  
  RotateCamera(0,-MouseDeltaY()* 0.04, -MouseDeltaX()* 0.04, 0, #PB_Relative)
  
  ExamineKeyboard()
  
  If KeyboardPushed(#PB_Key_Left)
    KeyX = -0.05
  ElseIf KeyboardPushed(#PB_Key_Right)
    KeyX = 0.05
  Else
    KeyX = 0
  EndIf
  
  If KeyboardPushed(#PB_Key_Up)
    KeyY = -0.05
  ElseIf KeyboardPushed(#PB_Key_Down)
    KeyY = 0.05
  Else
    KeyY = 0
  EndIf
  
  
  MoveCamera(0, KeyX, 0, KeyY)
  MoveCamera(0, CameraX(0), 1, CameraZ(0), #PB_Absolute) 
  RenderWorld()
  FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape) Or Quit = 1

Procedure.i CreateCastle()
  Protected tx.i, piltex.i, Shift.i = 0
  tx = LoadTexture(#PB_Any, "terrain_detail.jpg")
  piltex = LoadTexture(#PB_Any, "Wood.jpg")
  
  CreateMaterial(7, LoadTexture(7, "Geebee2.bmp"))
  CreateCone(5, 10, 20, 16,16)
  CreateEntity(5, MeshID(5), MaterialID(7), 0,10,0)
  
  
 
 ;CreateMaterial(8, LoadTexture(8, "Geebee2.bmp"))
  
  With cas\pillars[0]
    \mat = CreateMaterial(#PB_Any, TextureID(piltex))
    \mes = CreateCylinder(#PB_Any, 0.1, 1)
    \id = CreateEntity(#PB_Any, MeshID(\mes), MaterialID(\mat), 0, 1.5, 35)
  EndWith
EndProcedure

User avatar
DK_PETER
Addict
Addict
Posts: 904
Joined: Sat Feb 19, 2011 10:06 am
Location: Denmark
Contact:

Re: Semi Cylinder (PB 5.40 LTS)

Post by DK_PETER »

Hey applePi
Yes...It is very odd indeed. :|
I've added the CreateCone()'s parameters to the mideval example above to avoid the error.
I think Comtois should take a look..
Current configurations:
Ubuntu 20.04/64 bit - Window 10 64 bit
Intel 6800K, GeForce Gtx 1060, 32 gb ram.
Amd Ryzen 9 5950X, GeForce 3070, 128 gb ram.
Post Reply