PureBasic Forums - English

Posted: **Sat Jul 16, 2016 7:51 pm**

UsePNGImageDecoder()
UsePNGImageEncoder()
UseJPEGImageDecoder()
UseJPEGImageEncoder()

If InitEngine3D(#PB_Engine3D_DebugOutput) = 0
  MessageRequester("3D Error", "Unable to run the engine" + #CRLF$ + "Read the log file for clues")
  End
EndIf
If InitSprite() = 0
  MessageRequester("Sprite error", "Unable to initialize...")
  End
EndIf
If InitMouse() = 0
  End
EndIf
If InitKeyboard() = 0
  End
EndIf

;WORKS WITH PB V5.50 ONLY!! A fast pc is preferable!!!
;-----------------------------------------------------
;Testing some of the new 3D commands. (Thank you team!)
;-----------------------------------------------------
;TITLE: SIMPLE STAR CHART EXAMPLE
;-----------------------------------------------------
;CREATOR: DK_PETER
;-----------------------------------------------------
;Keys: WASD to move around
;-----------------------------------------------------
;ESCAPE KEY TO EXIT PROGRAM
;-----------------------------------------------------
Structure _object
  id.i
  ma.i
  ms.i
  tx.i[2]
  ds.s
EndStructure

Structure _Special
  rib.i[5]
  ribnode.i[3]
  ma.i[3]
  tx.i[3]
  nod.i
EndStructure

Structure _Par
  id.i
  ma.i
  tx.i
EndStructure

Structure _BB
  id._Par[5]
  List tx.s()
EndStructure

Structure _Objects
  hull._object
  floor._object
  base._object
  pillar._object[7]
  Tube._object
  Habitat._object[2]
  sky._object
  sp._Special[6]
  eng._object
  exhaust._Par
  con._object
  rnod.i
EndStructure

Structure _Navi
  x.f
  y.f
  z.f
  my.f
  mx.f
  kx.f
  kz.f
EndStructure

Declare.i Hull()
Declare.i Floor()
Declare.i Sky()
Declare.i Pillar()
Declare.i Crsr()
Declare.i Light()
Declare.i Stars()
Declare.i Special()
Declare.i Suns()
Declare.i TheRest()
Declare.i DoMain(DeskTopSize.i = #True, Width.i = 1024, Height.i = 768)
Declare.i ScaleThreading(Indexvalue.i)
Declare.i DrawSun(RGBColor.i, Texture.i = #True)
Declare.f RandomF(min.f, Max.f, SeedVal.i = #PB_Ignore)

Global ob._Objects, nav._Navi, sp.i, ev.i, Quit.i
Global Dim pa._Par(4), bb._BB


Procedure.i Special()
  Protected x.i
  
  With ob\sp[0]
    \nod = CreateNode(#PB_Any, 0, 0, 0)
    \tx[0] = CreateTexture(#PB_Any, 32, 32, "First")
    StartDrawing(TextureOutput(\tx[0]))
    Box(0, 0, 32, 32, $FFD3D3D3)
    StopDrawing()
    \ma[0] = CreateMaterial(#PB_Any, TextureID(\tx[0]))
    MaterialCullingMode(\ma[0], #PB_Material_NoCulling)
    
    \rib[0] = CreateRibbonEffect(#PB_Any, MaterialID(\ma[0]), 1, 1000, 600)
    RibbonEffectWidth(\rib[0], 0, 0.1, 0.5)
    \ribnode[0] = CreateNode(#PB_Any, -2, 2, -3)
    AttachRibbonEffect(\rib[0], NodeID(\ribnode[0]))
    AttachNodeObject(\nod, NodeID(\ribnode[0]))
    
    \rib[1] = CreateRibbonEffect(#PB_Any, MaterialID(\ma[0]), 1, 1000, 500)
    RibbonEffectWidth(\rib[1], 0, 0.1, 0.3)
    \ribnode[1] = CreateNode(#PB_Any, 2, -1, 3)
    AttachRibbonEffect(\rib[1], NodeID(\ribnode[1]))
    AttachNodeObject(\nod, NodeID(\ribnode[1]))
    
    \rib[2] = CreateRibbonEffect(#PB_Any, MaterialID(\ma[0]), 1, 1000, 400)
    RibbonEffectWidth(\rib[2], 0, 0.1, 0.3)
    \ribnode[2] = CreateNode(#PB_Any, 3, -2, -3)
    AttachRibbonEffect(\rib[2], NodeID(\ribnode[2]))
    AttachNodeObject(\nod, NodeID(\ribnode[2]))
    
    ScaleNode(\nod, 10, 10, 10)
  EndWith
  
  With ob\sp[1]
    \nod = CreateNode(#PB_Any, 0, 0, 0)
    \tx[1] = CreateTexture(#PB_Any, 32, 32, "Second")
    StartDrawing(TextureOutput(\tx[1]))
    Box(0, 0, 32, 32, $FFFFE600)
    StopDrawing()
    \ma[1] = CreateMaterial(#PB_Any, TextureID(\tx[1]))
    MaterialCullingMode(\ma[1], #PB_Material_NoCulling)
    
    \rib[0] = CreateRibbonEffect(#PB_Any, MaterialID(\ma[1]), 1, 1000, 400)
    RibbonEffectWidth(\rib[0], 0, 0.1, 0.5)
    \ribnode[0] = CreateNode(#PB_Any, -2, 2, -3)
    AttachRibbonEffect(\rib[0], NodeID(\ribnode[0]))
    AttachNodeObject(\nod, NodeID(\ribnode[0]))
    
    \rib[1] = CreateRibbonEffect(#PB_Any, MaterialID(\ma[1]), 1, 1000, 600)
    RibbonEffectWidth(\rib[1], 0, 0.1, 0.3)
    \ribnode[1] = CreateNode(#PB_Any, 3, -2, -1)
    AttachRibbonEffect(\rib[1], NodeID(\ribnode[1]))
    AttachNodeObject(\nod, NodeID(\ribnode[1]))
    
    \rib[2] = CreateRibbonEffect(#PB_Any, MaterialID(\ma[1]), 1, 1000, 500)
    RibbonEffectWidth(\rib[2], 0, 0.1, 0.3)
    \ribnode[2] = CreateNode(#PB_Any, -1, -2, -3)
    AttachRibbonEffect(\rib[2], NodeID(\ribnode[2]))
    AttachNodeObject(\nod, NodeID(\ribnode[2]))
    
    ScaleNode(\nod, 10, 10, 10)
  EndWith
  
  With ob\sp[2]
    \nod = CreateNode(#PB_Any, 0, 0, 0)
    \tx[2] = CreateTexture(#PB_Any, 32, 32, "Third")
    StartDrawing(TextureOutput(\tx[2]))
    Box(0, 0, 32, 32, $FF00F8DB)
    StopDrawing()
    \ma[2] = CreateMaterial(#PB_Any, TextureID(\tx[2]))
    MaterialCullingMode(\ma[2], #PB_Material_NoCulling)
    
    \rib[0] = CreateRibbonEffect(#PB_Any, MaterialID(\ma[2]), 1, 1000, 600)
    RibbonEffectWidth(\rib[0], 0, 0.1, 0.5)
    \ribnode[0] = CreateNode(#PB_Any, -2.2, -2.6, -1.5)
    AttachRibbonEffect(\rib[0], NodeID(\ribnode[0]))
    AttachNodeObject(\nod, NodeID(\ribnode[0]))
    
    \rib[1] = CreateRibbonEffect(#PB_Any, MaterialID(\ma[2]), 1, 1000, 600)
    RibbonEffectWidth(\rib[1], 0, 0.1, 0.3)
    \ribnode[1] = CreateNode(#PB_Any, 2, 1.9, 1.5)
    AttachRibbonEffect(\rib[1], NodeID(\ribnode[1]))
    AttachNodeObject(\nod, NodeID(\ribnode[1]))
    
    \rib[2] = CreateRibbonEffect(#PB_Any, MaterialID(\ma[2]), 1, 1000, 800)
    RibbonEffectWidth(\rib[2], 0, 0.1, 0.3)
    \ribnode[2] = CreateNode(#PB_Any, -2, 2, -2.3)
    AttachRibbonEffect(\rib[2], NodeID(\ribnode[2]))
    AttachNodeObject(\nod, NodeID(\ribnode[2]))
    
    ScaleNode(\nod, 10, 10, 10)
  EndWith
  ProcedureReturn #True
EndProcedure


Procedure.i Hull()
  Protected im.i, tm.i, x.i, y.i
  im = LoadImage(#PB_Any, #PB_Compiler_Home + "Examples\3D\Data\Textures\clouds.jpg")
  tm = CreateTexture(#PB_Any, 2048, 2048, "HullTex")
  StartDrawing(TextureOutput(tm))
  DrawingMode(#PB_2DDrawing_Default)
  DrawImage(ImageID(im), 0, 0, 2048, 2048)
  DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Outlined)
  StopDrawing()
  
  With ob\hull
    \ms = CreateSphere(#PB_Any, 60, 60, 60)
    CreateMaterial(\ma, TextureID(tm))
    MaterialBlendingMode(\ma, #PB_Material_Add)
    AddMaterialLayer(\ma, TextureID(tm), #PB_Material_Modulate)
    MaterialCullingMode(\ma, #PB_Material_AntiClockWiseCull)
    SetMaterialAttribute(\ma, #PB_Material_DepthCheck, #True)
    SetMaterialAttribute(\ma, #PB_Material_DepthWrite, #False)
    ScaleMaterial(\ma, 1, 0.1, 0)
    ScaleMaterial(\ma, 1, 0.1, 1)
    ScrollMaterial(\ma, 0, 0.2, #PB_Material_Animated, 0)
    ScrollMaterial(\ma, 0, -0.2, #PB_Material_Animated, 1)
    \id = CreateEntity(#PB_Any, MeshID(\ms), MaterialID(\ma), 0, 0, 0)
    ScaleEntity(\id, 1.01, 0.77, 1.01)
  EndWith
  
  With ob\Tube
    \ms    = CreateTube(#PB_Any, 5, 4.6, 300, 10, 20)
    \tx[0] = LoadTexture(#PB_Any, "glass_Dirt.png")
    \ma    = CreateMaterial(#PB_Any, TextureID(\tx[0]))
    ScaleMaterial(\ma, 0.5, 0.005)
    \id    = CreateEntity(#PB_Any, MeshID(\ms), MaterialID(\ma), 209, 0, 0)
    RotateEntity(\id, 0, 0, 90)
  EndWith
  
  With ob\Habitat[0]
    \ms = CreateCapsule(#PB_Any, 10, 60, 40, 50, 60)
    \tx[0] = LoadTexture(#PB_Any, "glass_Dirt.png")
    \tx[1] = CreateTexture(#PB_Any, 2048, 2048, "")
    StartDrawing(TextureOutput(\tx[1]))
    For x = 0 To 2048 Step 128
      For y = 0 To 2048 Step 128
        Box(x, y, 20, 80, RGBA(240, 240, 240, Random(255,10)))
      Next y
    Next x
    StopDrawing()
    \ma = CreateMaterial(#PB_Any, TextureID(\tx[0]))
    AddMaterialLayer(\ma, TextureID(\tx[1]), #PB_Material_Add)
    ScaleMaterial(\ma, 0.1, 0.1, 1)
    MaterialFilteringMode(\ma, #PB_Material_Anisotropic, 10)
    \id = CreateEntity(#PB_Any, MeshID(\ms), MaterialID(\ma), 300, 0, 30)
    RotateEntity(\id, 0, 0, 90)
    ob\Habitat[1]\id = CopyEntity(\id, #PB_Any)
    RotateEntity(ob\Habitat[1]\id, 0, 0, 90)
    MoveEntity(ob\Habitat[1]\id, 300, 0, -30)
  EndWith
  
  With ob\con
    \ms = CreateCube(#PB_Any, 9)
    \tx[0] = LoadTexture(#PB_Any, "glass_Dirt.png")
    \ma = CreateMaterial(#PB_Any, TextureID(\tx[0]))
    ScaleMaterial(\ma, 0.5, 1)
    \id = CreateEntity(#PB_Any, MeshID(\ms), MaterialID(\ma),300, 0, 0)
    ScaleEntity(\id, 1, 1, 6)
  EndWith
  
  With ob\eng
    \ms = CreateCone(#PB_Any, 10, 20, 32, 32)
    \tx[0] = LoadTexture(#PB_Any, "terrain.png")
    \ma = CreateMaterial(#PB_Any, TextureID(\tx[0]))
    \id = CreateEntity(#PB_Any, MeshID(\ms), MaterialID(\ma), 350, 0, 0)
    RotateEntity(\id, 0, 0, 90)
  EndWith
  
  With ob\exhaust
    \id = CreateParticleEmitter(#PB_Any, 1, 5, 5, #PB_Particle_Point, 360, 0, 0)
    \tx = LoadTexture(#PB_Any, "Lensflare5.jpg")
    \ma = CreateMaterial(#PB_Any, TextureID(\tx))
    MaterialBlendingMode(\ma, #PB_Material_Add)
    ParticleMaterial(\id, MaterialID(\ma))
    ParticleColorRange(\id, $0FFF8946, $0FFFB846)
    ParticleEmissionRate(\id, 40)
    ParticleSize(\id, 18, 18)
    ParticleEmitterDirection(\id, 0.05, 0, 0)
    ParticleVelocity(\id, #PB_Particle_MinimumVelocity, 0.1)
    ParticleVelocity(\id, #PB_Particle_MaximumVelocity, 2)
  EndWith
  ob\rnod = CreateNode(#PB_Any, -40, 0, 0)
  AttachNodeObject(ob\rnod, EntityID(ob\Habitat[0]\id))
  AttachNodeObject(ob\rnod, EntityID(ob\Habitat[1]\id))
  AttachNodeObject(ob\rnod, EntityID(ob\con\id))
  ProcedureReturn #True
EndProcedure

Procedure.i Floor()
  Protected x.i
  With ob\floor
    \ms = CreateSphere(#PB_Any, 56, 120, 240)
    \tx[0] = CreateTexture(#PB_Any, 2048, 2048, "Floor")
    StartDrawing(TextureOutput(\tx[0]))
    For x = 0 To 2048 Step 64
      LineXY(0, x, 2048, x, $88AA88)
      LineXY(0, x+1, 2048, x+1, $88FF88)
      LineXY(0, x+2, 2048, x+2, $88AA88)
    Next x
    StopDrawing()
    \tx[1] = CreateTexture(#PB_Any, 2048, 2048, "Floor2")
    StartDrawing(TextureOutput(\tx[1]))
    DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient)
    FrontColor($048A7C08) : BackColor($07F5E563)
    BoxedGradient(1000, 0, 100, 2048)
    Box(1000, 0, 100, 2048)
    StopDrawing()
    \ma = CreateMaterial(#PB_Any, TextureID(\tx[0]))
    MaterialBlendingMode(\ma, #PB_Material_Add)
    AddMaterialLayer(\ma, TextureID(\tx[1]), #PB_Material_Add)
    RotateMaterial(\ma, 90, #PB_Material_Fixed,1)
    ScrollMaterial(\ma, 0, 0.03, #PB_Material_Animated, 0)
    ScrollMaterial(\ma, 0, 0.25, #PB_Material_Animated, 1)
    MaterialFilteringMode(\ma, #PB_Material_Anisotropic, 10)
    \id = CreateEntity(#PB_Any, MeshID(\ms), MaterialID(\ma), 0, -9, 0)
    ScaleEntity(\id, 1, 0.01, 1)
  EndWith
  ProcedureReturn #True
EndProcedure

Procedure.i Sky()
  Protected xp.i, x.i, im.i, yp.i, sz.i
  im = CreateImage(#PB_Any, 2048, 2048)
  StartDrawing(ImageOutput(im))
  DrawingMode(#PB_2DDrawing_AlphaBlend|#PB_2DDrawing_Gradient)
  FrontColor($FF111111) : BackColor($FFFFFFFF)
  For x = 0 To 2000
    xp = Random(2048,0) : yp = Random(2048,0) : sz = Random(3,1)
    CircularGradient(xp, yp, sz)
    Circle(xp, yp, sz)
  Next x
  StopDrawing()
  SaveImage(im, "Skybox_FR.jpg", #PB_ImagePlugin_JPEG, 10)
  SaveImage(im, "Skybox_BK.jpg", #PB_ImagePlugin_JPEG, 10)
  SaveImage(im, "Skybox_LF.jpg", #PB_ImagePlugin_JPEG, 10)
  SaveImage(im, "Skybox_RT.jpg", #PB_ImagePlugin_JPEG, 10)
  SaveImage(im, "Skybox_UP.jpg", #PB_ImagePlugin_JPEG, 10)
  SaveImage(im, "Skybox_DN.jpg", #PB_ImagePlugin_JPEG, 10)
  SkyBox("Skybox.jpg")
  ProcedureReturn #True
EndProcedure

Procedure.i Pillar()
  Protected x.i, nx.f
  With ob\pillar[0]
    \ms = CreateTorus(#PB_Any, 59.8, 0.5, 6, 64)
    \tx[0] = CreateTexture(#PB_Any, 1024, 1024, "")
    StartDrawing(TextureOutput(\tx[0]))
    DrawingMode(#PB_2DDrawing_Default)
    Box(0, 0, 1024, 1024, $675E5F)
    DrawingMode(#PB_2DDrawing_Gradient)
    FrontColor($FFFF68) : BackColor($8B0100)
    For x = 0 To 2048 Step 512
      BoxedGradient(0, x, 2048, 256)
      Box(0, x, 2048, 256)
    Next x
    StopDrawing()
    \ma = CreateMaterial(#PB_Any, TextureID(\tx[0]))
    MaterialFilteringMode(\ma, #PB_Material_Anisotropic, 8)
    \id = CreateEntity(#PB_Any, MeshID(\ms), MaterialID(\ma), 0, 0, 0)
    RotateEntity(\id, 0, 0, 90)
    ScaleEntity(\id, 0.7, 1, 1, #PB_Absolute)
  EndWith
  For x = 1 To 5
    ob\pillar[x]\id = CopyEntity(ob\pillar[0]\id, #PB_Any)
    ob\pillar[x]\ma = CopyMaterial(ob\pillar[0]\ma, #PB_Any)
    RotateEntity(ob\pillar[x]\id, (x * 30) , 0 , 90 * -1)
    ScaleEntity(ob\pillar[x]\id, 0.7, 1, 1, #PB_Absolute)
  Next x
  ob\pillar[6]\id = CopyEntity(ob\pillar[0]\id, #PB_Any)
  RotateEntity(ob\pillar[6]\id, 90, 90 , 90)
  ScaleEntity(ob\pillar[6]\id, 1, 1, 1, #PB_Absolute)
  ProcedureReturn #True
EndProcedure

Procedure.i Crsr()
  Protected x.i
  sp = CreateSprite(#PB_Any, ScreenWidth(), ScreenHeight())
  StartDrawing(SpriteOutput(sp))
  DrawingMode(#PB_2DDrawing_Outlined)
  For x = 0 To 5
    RoundBox(x, x, OutputWidth()-(x*2), OutputHeight()-(x*2), 8, 8, $F0CB01)
  Next x
  Circle(OutputWidth()/2, OutputHeight()/2, 3, $F0CB01)
  Circle(OutputWidth()/2, OutputHeight()/2, 4, $F0CB01)
  StopDrawing()
  TransparentSpriteColor(sp, 0)
  ProcedureReturn #True
EndProcedure

Procedure.i TheRest()
  Protected x.i
  
  With pa(0)
    \id = CreateParticleEmitter(#PB_Any, 1, 1, 1, #PB_Particle_Point, -1000, 200, 0)
    \tx = LoadTexture(#PB_Any, "flare.png")
    \ma = CreateMaterial(#PB_Any, TextureID(\tx))
    MaterialBlendingMode(\ma, #PB_Material_Add)
    ParticleMaterial(\id, MaterialID(\ma))
    ParticleEmissionRate(\id, 2000)
    ParticleSize(\id, 0.5, 0.5)
    ParticleTimeToLive(\id, 1, 10)
    ParticleVelocity(\id, #PB_Particle_MinimumVelocity, 100.1)
    ParticleVelocity(\id, #PB_Particle_MaximumVelocity, 200.6)
    ParticleEmitterDirection(\id, 1, 0, 0)
  EndWith
  With pa(1)
    \id = CreateParticleEmitter(#PB_Any, 1, 1, 1, #PB_Particle_Point, -1000, -200, 0)
    \tx = LoadTexture(#PB_Any, "flare.png")
    \ma = CreateMaterial(#PB_Any, TextureID(\tx))
    MaterialBlendingMode(\ma, #PB_Material_Add)
    ParticleMaterial(\id, MaterialID(\ma))
    ParticleEmissionRate(\id, 500)
    ParticleSize(\id, 1, 1)
    ParticleTimeToLive(\id, 1, 10)
    ParticleVelocity(\id, #PB_Particle_MinimumVelocity, 100)
    ParticleVelocity(\id, #PB_Particle_MaximumVelocity, 150.4)
    ParticleEmitterDirection(\id, 1, 0, 0)
  EndWith
  
  With pa(0)
    \id = CreateParticleEmitter(#PB_Any, 1, 1, 1, #PB_Particle_Point, -1000, 0, 200)
    \tx = LoadTexture(#PB_Any, "flare.png")
    \ma = CreateMaterial(#PB_Any, TextureID(\tx))
    MaterialBlendingMode(\ma, #PB_Material_Add)
    ParticleMaterial(\id, MaterialID(\ma))
    ParticleEmissionRate(\id, 250)
    ParticleSize(\id, 3.7, 1.7)
    ParticleTimeToLive(\id, 1, 10)
    ParticleVelocity(\id, #PB_Particle_MinimumVelocity, 100.1)
    ParticleVelocity(\id, #PB_Particle_MaximumVelocity, 400.1)
    ParticleEmitterDirection(\id, 1, 0, 0)
  EndWith
  ProcedureReturn #True
EndProcedure


Procedure.i DrawSun(RGBColor.i, Texture.i = #True)
  Protected tx.i, im.i, x.i
  Protected Dim xy.i(2)
  im = CreateImage(#PB_Any,  2048, 2048)
  xy(0) = Red(RGBColor) : xy(1) = Green(RGBColor) : xy(2) = Blue(RGBColor) 
  StartVectorDrawing(ImageVectorOutput(im))
  MovePathCursor(1024, 1024)
  MovePathCursor(1024, 1024)
  VectorSourceCircularGradient(1024, 1024, 600, 0, 0)
  VectorSourceGradientColor(RGBA(xy(0), xy(1), xy(2), 255), 0.0) 
  VectorSourceGradientColor(RGBA(xy(0), xy(1), xy(2), 255), 0.2)
  FillVectorOutput()
  StopVectorDrawing()
  If Texture = #True
    tx = CreateTexture(#PB_Any, 2048, 2048 , "")
    StartDrawing(TextureOutput(tx))
    DrawImage(ImageID(im), 0, 0)
    StopDrawing()
    FreeImage(im)
    ProcedureReturn tx
  Else
    ProcedureReturn im
  EndIf
EndProcedure

Procedure.f RandomF(min.f, Max.f, SeedVal.i = #PB_Ignore)
  If SeedVal = #PB_Ignore : SeedVal = ElapsedMilliseconds() : EndIf
  ProcedureReturn (Min + (Max - Min) * Random(SeedVal) / SeedVal)
EndProcedure

Procedure.i Suns() ;Weird suns ;-D
  Protected x.i, y.i, z.i, c.i ,im.i, tm.i
  
  bb\id[0]\tx  = DrawSun($FFA300)
  bb\id[1]\tx  = DrawSun($00DF00)
  bb\id[2]\tx  = DrawSun($00DFFF)
  bb\id[3]\tx  = DrawSun($0096FF)
  
  bb\id[0]\ma  = CreateMaterial(#PB_Any, TextureID(bb\id[0]\tx))
  MaterialBlendingMode(bb\id[0]\ma, #PB_Material_Add)
  AddMaterialLayer(bb\id[0]\ma, TextureID(bb\id[0]\tx), #PB_Material_Add)
  bb\id[0]\id = CreateBillboardGroup(#PB_Any, MaterialID(bb\id[0]\ma), 0.5, 0.5, 0, 0, 0)
  
  bb\id[1]\ma  = CreateMaterial(#PB_Any, TextureID(bb\id[1]\tx))
  MaterialBlendingMode(bb\id[1]\ma, #PB_Material_Add)
  AddMaterialLayer(bb\id[1]\ma, TextureID(bb\id[1]\tx), #PB_Material_Add)
  bb\id[1]\id = CreateBillboardGroup(#PB_Any, MaterialID(bb\id[1]\ma), 0.5, 0.5, 0, 0, 0)
  
  bb\id[2]\ma  = CreateMaterial(#PB_Any, TextureID(bb\id[2]\tx))
  MaterialBlendingMode(bb\id[2]\ma, #PB_Material_Add)
  AddMaterialLayer(bb\id[2]\ma, TextureID(bb\id[2]\tx), #PB_Material_Add)
  bb\id[2]\id = CreateBillboardGroup(#PB_Any, MaterialID(bb\id[2]\ma), 0.5, 0.5, 0, 0, 0)
  
  bb\id[3]\ma  = CreateMaterial(#PB_Any, TextureID(bb\id[3]\tx))
  MaterialBlendingMode(bb\id[3]\ma, #PB_Material_Add)
  AddMaterialLayer(bb\id[3]\ma, TextureID(bb\id[3]\tx), #PB_Material_Add)
  bb\id[3]\id = CreateBillboardGroup(#PB_Any, MaterialID(bb\id[3]\ma), 0.5, 0.5, 0, 0, 0)

  For c = 0 To 250
    x = RandomF(-25,25) : y = RandomF(-25,25) : z = RandomF(-25,25)
    Select x
      Case 0 To 30
        AddBillboard(bb\id[0]\id, x, y, z)
      Case 31 To 60
        AddBillboard(bb\id[1]\id, x, y, z)
      Case 61 To 90
        AddBillboard(bb\id[2]\id, x, y, z)
      Default
        AddBillboard(bb\id[3]\id, x, y, z)
    EndSelect
    CreateText3D(c, "Sun: " + Str(c))
    ScaleText3D(c, 0.5, 0.5, 0.5)
    MoveText3D(c, x-1.5, y, z, #PB_Absolute)
  Next c  
    
  ProcedureReturn #True
  
EndProcedure

Procedure.i ScaleThreading(Indexvalue.i)
  Protected x.i, out.i = #True, Scalevalue.f = 1.0
  Repeat
    For x = 0 To 250
      If out = #True And Scalevalue < 1.4    
        Scalevalue + 0.000001
      Else
        out  = #False
      EndIf
      If out = #False And Scalevalue > 1.0
        Scalevalue - 0.000001
      Else
        out = #True
      EndIf
      ScaleMaterial(bb\id[0]\ma, Scalevalue, Scalevalue, 1)
      ScaleMaterial(bb\id[1]\ma, Scalevalue, Scalevalue, 1)
      ScaleMaterial(bb\id[2]\ma, Scalevalue, Scalevalue, 1)
      ScaleMaterial(bb\id[3]\ma, Scalevalue, Scalevalue, 1)
    Next x
  Until Quit = 1
  
EndProcedure

Procedure.i DoMain(DeskTopSize.i = #True, Width.i = 1024, Height.i = 768)
  Protected ret.i, threadedScale.i
  If DeskTopSize = #True
    ExamineDesktops()
    OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0), "Simple Star Chart", #PB_Window_ScreenCentered|#PB_Window_BorderLess)
    OpenWindowedScreen(WindowID(0), 0, 0, DesktopWidth(0), DesktopHeight(0), #False, 0, 0, #PB_Screen_SmartSynchronization)
  Else
    OpenWindow(0, 0, 0, Width, Height, "Simple Star Chart", #PB_Window_ScreenCentered|#PB_Window_SystemMenu)
    OpenWindowedScreen(WindowID(0), 0, 0, Width, Height, #False, 0, 0, #PB_Screen_SmartSynchronization)
  EndIf
  Add3DArchive(".", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples\3D\Data\Textures", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples\3D\Data\fonts", #PB_3DArchive_FileSystem)
  Add3DArchive(#PB_Compiler_Home + "Examples\3D\Data\Textures\Nvidia", #PB_3DArchive_FileSystem)
  Parse3DScripts()
  
  CreateCamera(0, 0, 0, 100, 100)
  ;CameraRange(0, 0, 500)  ;Edit...rem'ed this to see skybox.
  ret = Suns() : ret = Sky()     :  ret = Hull()   : ret = Floor() 
  ret = Crsr() : ret = Special() : ret = Pillar()  : ret = TheRest() 
  
  threadedScale = CreateThread(@ScaleThreading(), 1)
  Repeat
    
    Repeat 
      ev = WindowEvent() 
    Until ev = 0
    
    ExamineMouse()
    nav\mx = MouseDeltaX() * 0.04
    nav\my = MouseDeltaY() * 0.04
    RotateCamera(0, nav\my, -nav\mx, 0, #PB_Relative)
    
    ExamineKeyboard()
    
    If KeyboardPushed(#PB_Key_Up)
      nav\x + 0.01
    ElseIf KeyboardPushed(#PB_Key_Down)
      nav\x - 0.01
    EndIf
    
    If KeyboardPushed(#PB_Key_Left)
      nav\z + 0.01
    ElseIf KeyboardPushed(#PB_Key_Right)
      nav\z - 0.01
    EndIf
    
    If KeyboardPushed(#PB_Key_W)
      nav\kx = -0.5
    ElseIf KeyboardPushed(#PB_Key_S)
      nav\kx = 0.5
    Else
      nav\kx = 0
    EndIf
    
    If KeyboardPushed(#PB_Key_A)
      nav\kz = -0.5
    ElseIf KeyboardPushed(#PB_Key_D)
      nav\kz = 0.5
    Else
      nav\kz = 0
    EndIf
    
    If CameraY(0) <> 0
      MoveCamera(0, CameraX(0), 0, CameraZ(0), #PB_Absolute)
    EndIf
    MoveCamera(0, nav\kz, 0, nav\kx)
    
    RotateNode(ob\sp[0]\nod,  0.6, 0.7, -0.6, #PB_Relative)
    RotateNode(ob\sp[1]\nod, -0.6, 0.7,  1.6, #PB_Relative)
    RotateNode(ob\sp[2]\nod, -1.6, 1.5, -0.4, #PB_Relative)
    RotateNode(ob\rnod, 0.3, 0, 0, #PB_Relative)
    
    If KeyboardPushed(#PB_Key_Escape)
      Quit = #True
    EndIf
    
    RenderWorld()
    
    DisplayTransparentSprite(sp, 0, 0)
    
    FlipBuffers()
      
  Until Quit = #True 
EndProcedure

DoMain(#True)

Bye.

Posted: **Sat Jul 16, 2016 10:44 pm**

Even if I'm regularly no 3D programmer... - impressive!

Posted: **Sun Jul 17, 2016 3:09 am**

Awesomely impressive !!!

Posted: **Wed Jul 20, 2016 10:59 am**

Incredible
Splendid
Awesome
Great
Wonderfull
Giant
Enormous
Impressive

Ruffling

Have i forgotten a word ?

Never i believe it's possible to do that with PB

all the universe at the end of my mouse...
Thanks a lot for sharing this jewel

Posted: **Wed Jul 20, 2016 1:48 pm**

Very impressive

Thanks for sharing.

Posted: **Wed Jul 20, 2016 3:27 pm**

It's just perfect

Posted: **Wed Jul 20, 2016 3:40 pm**

Works fine without Debugger!

With Debugger on Linux (x64) comes:
Line 514: ScaleText3D(...)
and
[ERROR] The specified #Text3D is not initialised.

Posted: **Mon Jul 25, 2016 8:39 pm**

I'm not a graphics guy (remember this) but the starchart is impressive and I was looking at the code to gain enlightenment.

I noticed that CreateTexture has 4 parameters in the program but only 3 in the manual.
So my question is...
Is that 4th parameter some kind of secret handshake or is the documentation lacking something?

Posted: **Wed Jul 27, 2016 11:49 am**

it's the texture's name, not needed in this example.

It was added for Alexi

http://www.purebasic.fr/english/viewtop ... =3&t=65275

Posted: **Wed Jul 27, 2016 12:56 pm**

Comtois wrote:it's the texture's name, not needed in this example.

It was added for Alexi
http://www.purebasic.fr/english/viewtop ... =3&t=65275

Well..If that's the only purpose of the name parameter, then there's something quite wrong with the creation of textures now.

Remove the name parameter from the CreateTexture() and the textures looks quite differently in the example.

Posted: **Wed Jul 27, 2016 1:15 pm**

Ok, thanks for the info, but it seems the documentation should say something about this.
I added a documentation bug on CreateTexture to cover this.

Posted: **Wed Jul 27, 2016 9:14 pm**

DK_PETER wrote:
Comtois wrote:it's the texture's name, not needed in this example.

It was added for Alexi
http://www.purebasic.fr/english/viewtop ... =3&t=65275
Well..If that's the only purpose of the name parameter, then there's something quite wrong with the creation of textures now.

Remove the name parameter from the CreateTexture() and the textures looks quite differently in the example.

You are right, last parameter should be forced

Code: Select all

CreateTexture(#PB_Any,32,32,"")

PureBasic Forums - English

An Onboard star chart example

An Onboard star chart example

Re: An Onboard star chart example

Re: An Onboard star chart example

Re: An Onboard star chart example

Re: An Onboard star chart example

Re: An Onboard star chart example

Re: An Onboard star chart example

Re: An Onboard star chart example

Re: An Onboard star chart example

Re: An Onboard star chart example

Re: An Onboard star chart example

Re: An Onboard star chart example