[PB 4.31] A simple light clock

Kelebrindae · Post by **Kelebrindae** » Mon Oct 05, 2009 9:42 am

Hi,
Starting today, I'll post a few codes previously published on the french forums, before the 4.40 makes them all obsolete.

The first one is quite simple: it's a clock. More precisely, a light clock, whose hands are made of shadows; just like a sun dial, but with 3 little suns rotating around the center.
Well, I'm not making much sense, here...

See by yourself, it's easier than explaining.

Side Note: PB is doing remarquably well with lights and shadows!

Code: Select all

;- Initialization
Global FullScreen.b
Resultat = MessageRequester("Light Clock","Full Screen ?",#PB_MessageRequester_YesNo)
If Resultat = 6     
  FullScreen=#True
Else           
  FullScreen=#False
EndIf

If InitEngine3D() = 0
  MessageRequester( "Error" , "Can't initialize 3D, check if engine3D.dll is available" , 0 )
End
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 Or InitMouse() = 0
  MessageRequester( "Error" , "Can't find DirectX 7.0 or above" , 0 )
  End
EndIf

If Fullscreen = #True
  OpenScreen(1440,900,32,"Light Clock")
Else
  OpenWindow(0,0, 0, 800 , 600 ,"Light Clock")
  OpenWindowedScreen(WindowID(0),0,0, 800 , 600,0,0,0)
EndIf

#CAMERA = 0
#RAD2DEGMULT = 57.295779513082320877  ;(180/#PI)
#DEG2RADMULT = 0.0174532925199432958  ;(#PI/180)
#QUALITY = 1  ; 1 = good, 2 = medium, 3 = low, 4 = mini

; Cylinder mesh caps
Enumeration
  #CYLCAP_NONE
  #CYLCAP_BOTH
  #CYLCAP_TOP
  #CYLCAP_BOTTOM
EndEnumeration


;- Structures and global definitions
Structure Vertex
  px.f
  py.f
  pz.f
  nx.f
  ny.f
  nz.f
  Couleur.l
  U.f
  V.f
EndStructure

Structure Polygon
  numVert1.w
  numVert2.w
  numVert3.w
EndStructure

Global groundMesh.i, gnomonMesh.i, boxMesh.i
Global groundEntity.i, gnomonEntity.i
Global Dim boxEntity.i(12)
Global hours.f, mins.f, secs.f
Global oldTimer.i, newTimer.i, movement.i
Global dist.f,hauteur.f,i.i
;- ------ Procedures ------
EnableExplicit

;- -- Meshes and entities --

;************************************************************************************
; Name: createPlainMesh
; Purpose: creates a plain
; Parameters:
;   - number of subdivisions (given "3", the plain will be a 3x3 grid)
;   - sizeX, sizeZ : size of the box
;   - pivotX, pivotZ : location of the pivot of the box, around which it rotates (default = center = 0,0)
;   - Uorigin, Vorigin : UV map coordinates (default = top left of the map = 0,0)
;   - Uscale, Vscale : UV map scale (default = 1,1)
;   - color of the vertices (default = white)
; Return-Value: number of the resulting mesh, -1 if creation failed
;************************************************************************************
Procedure.l createPlainMesh(nbdiv.w,sizeX.f,sizeZ.f,pivotX.f = 0,pivotZ.f = 0,Uorigin.f = 0,Vorigin.f = 0,Uscale.f = 1,Vscale.f = 1,color.l = $FFFFFF)

  Protected sizediv.f
  Protected x1.f,y1.f,z1.f                  ; vertex position
  Protected x2.f,y2.f,z2.f                  ; vertex position
  Protected x3.f,y3.f,z3.f                  ; vertex position
  Protected x4.f,y4.f,z4.f                  ; vertex position
  Protected nx.f,ny.f,nz.f                  ; vertex normals
  Protected u.f,v.f                         ; vertex UV coords (texture mapping)
  Protected numvert.w,numvert0.w            ; vertices of a poly
  Protected *PtrV.Vertex,*PtrV0.Vertex      ; vertices buffer in memory
  Protected *ptrP.Polygon,*ptrP0.Polygon    ; Polys buffer in memory
  Protected *vertexBuffer.l
  Protected *polygonBuffer.l
  Protected num.l,i.l,j.l,nbtri.l,nbvert
  Protected maxSize.f
  Protected newmesh.l                       ; Procedure Result

  nbtri  = (nbDiv * nbDiv * 2) ; nb divisions * nb divisions * 2 triangles per division
  nbvert = (nbDiv * nbDiv * 4) ; nb divisions * nb divisions * 4 vertices per division
 
  ; Allocate the needed memory for vertices
  *vertexBuffer = AllocateMemory(SizeOf(Vertex)*nbVert)
  *PtrV = *vertexBuffer
 
  ; Allocate the needed memory for faces info
  *polygonBuffer=AllocateMemory(SizeOf(Polygon)*nbTri)
  *ptrP=*polygonBuffer

  sizeDiv = 1/nbDiv
  ; Top
  x1=-0.5:y1=0:z1=-0.5
  x2=-0.5+sizeDiv:y2=0:z2 = z1
  x3=x2:y3=0:z3=-0.5+sizeDiv
  x4=x1:y4=0:z4=z3
 
  For i=1 To nbDiv
    For j=1 To nbDiv
     
      ; 1 square = 4 vertices
      *PtrV\px = x1
      *PtrV\py = y1
      *PtrV\pz = z1
      *PtrV\nx = 0
      *PtrV\ny = 1
      *PtrV\nz = 0
      *PtrV\couleur = color
      *PtrV\u = uorigin + (uscale/nbdiv)*(i-1)
      *PtrV\v = vorigin + (vscale/nbdiv)*(j-1)
      *PtrV + SizeOf(Vertex)

      *PtrV\px = x2
      *PtrV\py = y2
      *PtrV\pz = z2
      *PtrV\nx = 0
      *PtrV\ny = 1
      *PtrV\nz = 0
      *PtrV\couleur = color
      *PtrV\u = uorigin + (uscale/nbdiv)*(i-1) + uscale/nbdiv
      *PtrV\v = vorigin + (vscale/nbdiv)*(j-1)
      *PtrV + SizeOf(Vertex)

      *PtrV\px = x3
      *PtrV\py = y3
      *PtrV\pz = z3
      *PtrV\nx = 0
      *PtrV\ny = 1
      *PtrV\nz = 0
      *PtrV\couleur = color
      *PtrV\u = uorigin + (uscale/nbdiv)*(i-1) + uscale/nbdiv
      *PtrV\v = vorigin + (vscale/nbdiv)*(j-1) + vscale/nbdiv
      *PtrV + SizeOf(Vertex)
     
      *PtrV\px = x4
      *PtrV\py = y4
      *PtrV\pz = z4
      *PtrV\nx = 0
      *PtrV\ny = 1
      *PtrV\nz = 0
      *PtrV\couleur = color
      *PtrV\u = uorigin + (uscale/nbdiv)*(i-1)
      *PtrV\v = vorigin + (vscale/nbdiv)*(j-1) + vscale/nbdiv
      *PtrV + SizeOf(Vertex)

      ; 1 square = 2 triangles
      *ptrP\numVert1=numvert+3
      *ptrP\numVert2=numvert+2
      *ptrP\numVert3=numvert
      *ptrP + SizeOf(Polygon)

      *ptrP\numVert1=numvert
      *ptrP\numVert2=numvert+2
      *ptrP\numVert3=numvert+1
      *ptrP + SizeOf(Polygon)
     
      numvert+4     

      z1=z4
      z2=z3
      z3+sizeDiv
      z4=z3

    Next j
   
    x1=x2
    x4=x3
    x2+sizeDiv
    x3=x2
    z1=-0.5
    z2=z1
    z3=-0.5+sizeDiv
    z4=z3
     
  Next i
  numvert0=numvert
 

  ; Resize
  If sizeX<>1 Or sizeZ<>1
    *ptrV = *vertexBuffer
    For i=1 To nbVert
      *PtrV\px = *PtrV\px*sizeX - pivotX
      *PtrV\pz = *PtrV\pz*sizeZ - pivotZ
     
      *PtrV+SizeOf(vertex)
    Next i
  EndIf

  ; Create mesh from stored infos
  maxSize = sizeX
  If sizeZ > maxSize
    maxSize = sizeZ
  EndIf
 
  newMesh = CreateMesh(#PB_Any,maxSize)
  If IsMesh(newMesh)
    SetMeshData(newMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color,*vertexBuffer,nbVert)
    SetMeshData(newMesh,#PB_Mesh_Face,*polygonBuffer,nbTri)     
    FreeMemory(*vertexBuffer)
    FreeMemory(*polygonBuffer)
    ProcedureReturn newMesh
  Else
    ; free memory if "createMesh" has failed
    FreeMemory(*vertexBuffer)
    FreeMemory(*polygonBuffer)
    ProcedureReturn -1   
  EndIf

EndProcedure
;************************************************************************************
; Name: createBoxMesh
; Purpose: creates a "box" mesh
; Parameters:
;   - number of subdivisions (given "3", each face of the box will be a 3x3 grid)
;   - sizeX, sizeY, sizeZ : size of the box
;   - pivotX, pivotY, pivotZ : location of the pivot of the box, around which it rotates (default = center = 0,0,0)
;   - Uorigin, Vorigin : UV map coordinates (default = top left of the map = 0,0)
;   - Uscale, Vscale : UV map scale (default = 1,1)
;   - color of the vertices (default = white)
; Return-Value: number of the resulting mesh, -1 if creation failed
;************************************************************************************
Procedure.l createBoxMesh(nbdiv.w,sizeX.f,sizeY.f,sizeZ.f,pivotX.f = 0,pivotY.f = 0,pivotZ.f = 0,Uorigin.f = 0,Vorigin.f = 0,Uscale.f = 1,Vscale.f = 1,color.l = $FFFFFF)

  Protected sizediv.f
  Protected x1.f,y1.f,z1.f                  ; vertex position
  Protected x2.f,y2.f,z2.f                  ; vertex position
  Protected x3.f,y3.f,z3.f                  ; vertex position
  Protected x4.f,y4.f,z4.f                  ; vertex position
  Protected nx.f,ny.f,nz.f                  ; vertex normals
  Protected u.f,v.f                         ; vertex UV coords (texture mapping)
  Protected numvert.w,numvert0.w            ; vertices of a poly
  Protected *PtrV.Vertex,*PtrV0.Vertex      ; vertices buffer in memory
  Protected *ptrP.Polygon,*ptrP0.Polygon    ; Polys buffer in memory
  Protected *vertexBuffer.l
  Protected *polygonBuffer.l
  Protected num.l,i.l,j.l,nbtri.l,nbvert
  Protected maxSize.f
  Protected newmesh.l                       ; Procedure Result

  nbtri  = 6 * (nbDiv * nbDiv * 2) ; 6 sides * nb divisions * nb divisions * 2 triangles per division
  nbvert = 6 * (nbDiv * nbDiv * 4) ; 6 sides * nb divisions * nb divisions * 4 vertices per division
 
  ; Allocate the needed memory for vertices
  *vertexBuffer = AllocateMemory(SizeOf(Vertex)*nbVert)
  *PtrV = *vertexBuffer
 
  ; Allocate the needed memory for faces info
  *polygonBuffer=AllocateMemory(SizeOf(Polygon)*nbTri)
  *ptrP=*polygonBuffer

  sizeDiv = 1/nbDiv
  ; Top
  x1=-0.5:y1=0.5:z1=-0.5
  x2=-0.5+sizeDiv:y2=0.5:z2 = z1
  x3=x2:y3=0.5:z3=-0.5+sizeDiv
  x4=x1:y4=0.5:z4=z3
 
  For i=1 To nbDiv
    For j=1 To nbDiv
     
      ; 1 square = 4 vertices
      *PtrV\px = x1
      *PtrV\py = y1
      *PtrV\pz = z1
      *PtrV\nx = *PtrV\px
      *PtrV\ny = *PtrV\py
      *PtrV\nz = *PtrV\pz
      *PtrV\couleur = color
      *PtrV\u = uorigin + (uscale/nbdiv)*(i-1)
      *PtrV\v = vorigin + (vscale/nbdiv)*(j-1)
      *PtrV + SizeOf(Vertex)

      *PtrV\px = x2
      *PtrV\py = y2
      *PtrV\pz = z2
      *PtrV\nx = *PtrV\px
      *PtrV\ny = *PtrV\py
      *PtrV\nz = *PtrV\pz
      *PtrV\couleur = color
      *PtrV\u = uorigin + (uscale/nbdiv)*(i-1) + uscale/nbdiv
      *PtrV\v = vorigin + (vscale/nbdiv)*(j-1)
      *PtrV + SizeOf(Vertex)

      *PtrV\px = x3
      *PtrV\py = y3
      *PtrV\pz = z3
      *PtrV\nx = *PtrV\px
      *PtrV\ny = *PtrV\py
      *PtrV\nz = *PtrV\pz
      *PtrV\couleur = color
      *PtrV\u = uorigin + (uscale/nbdiv)*(i-1) + uscale/nbdiv
      *PtrV\v = vorigin + (vscale/nbdiv)*(j-1) + vscale/nbdiv
      *PtrV + SizeOf(Vertex)
     
      *PtrV\px = x4
      *PtrV\py = y4
      *PtrV\pz = z4
      *PtrV\nx = *PtrV\px
      *PtrV\ny = *PtrV\py
      *PtrV\nz = *PtrV\pz
      *PtrV\couleur = color
      *PtrV\u = uorigin + (uscale/nbdiv)*(i-1)
      *PtrV\v = vorigin + (vscale/nbdiv)*(j-1) + vscale/nbdiv
      *PtrV + SizeOf(Vertex)

      ; 1 square = 2 triangles
      *ptrP\numVert1=numvert+3
      *ptrP\numVert2=numvert+2
      *ptrP\numVert3=numvert
      *ptrP + SizeOf(Polygon)

      *ptrP\numVert1=numvert
      *ptrP\numVert2=numvert+2
      *ptrP\numVert3=numvert+1
      *ptrP + SizeOf(Polygon)
     
      numvert+4     

      z1=z4
      z2=z3
      z3+sizeDiv
      z4=z3

    Next j
   
    x1=x2
    x4=x3
    x2+sizeDiv
    x3=x2
    z1=-0.5
    z2=z1
    z3=-0.5+sizeDiv
    z4=z3
     
  Next i
  numvert0=numvert
 
  ; Bottom
  *PtrV0 = *vertexBuffer   
  For i=1 To numvert0
    *PtrV\px = -*PtrV0\px
    *PtrV\py = -*PtrV0\py
    *PtrV\pz = *PtrV0\pz
    *PtrV\nx = *PtrV\px
    *PtrV\ny = *PtrV\py
    *PtrV\nz = *PtrV\pz
    *PtrV\couleur = *PtrV0\couleur
    *PtrV\u = *PtrV0\u
    *PtrV\v = *PtrV0\v
   
    *PtrV + SizeOf(Vertex)
    *PtrV0 + SizeOf(Vertex)
    numvert+1
   
    If i%4=0
      *ptrP\numVert1=numvert - 2
      *ptrP\numVert2=numvert - 3
      *ptrP\numVert3=numvert - 4
      *ptrP + SizeOf(Polygon)
   
      *ptrP\numVert1=numvert - 4
      *ptrP\numVert2=numvert - 1
      *ptrP\numVert3=numvert - 2
      *ptrP + SizeOf(Polygon)   
    EndIf
   
  Next i

  ; Right
  *PtrV0 = *vertexBuffer   
  For i=1 To numvert0
    *PtrV\px = *PtrV0\py
    *PtrV\py = -*PtrV0\px
    *PtrV\pz = *PtrV0\pz
    *PtrV\nx = *PtrV\px
    *PtrV\ny = *PtrV\py
    *PtrV\nz = *PtrV\pz
    *PtrV\couleur = *PtrV0\couleur
    *PtrV\u = 1-*PtrV0\v
    *PtrV\v = *PtrV0\u
   
    *PtrV + SizeOf(Vertex)
    *PtrV0 + SizeOf(Vertex)
    numvert+1
   
    If i%4=0
      *ptrP\numVert1=numvert - 2
      *ptrP\numVert2=numvert - 3
      *ptrP\numVert3=numvert - 4
      *ptrP + SizeOf(Polygon)
     
      *ptrP\numVert1=numvert - 4
      *ptrP\numVert2=numvert - 1
      *ptrP\numVert3=numvert - 2
      *ptrP + SizeOf(Polygon)
    EndIf
   
  Next i

  ; Left
  *PtrV0 = *vertexBuffer   
  For i=1 To numvert0
    *PtrV\px = -*PtrV0\py
    *PtrV\py = -*PtrV0\px
    *PtrV\pz = *PtrV0\pz
    *PtrV\nx = *PtrV\px
    *PtrV\ny = *PtrV\py
    *PtrV\nz = *PtrV\pz
    *PtrV\couleur = *PtrV0\couleur
    *PtrV\u = *PtrV0\v
    *PtrV\v = *PtrV0\u
   
    *PtrV + SizeOf(Vertex)
    *PtrV0 + SizeOf(Vertex)
    numvert+1
   
    If i%4=0
      *ptrP\numVert1=numvert - 4
      *ptrP\numVert2=numvert - 3
      *ptrP\numVert3=numvert - 2
      *ptrP + SizeOf(Polygon)
   
      *ptrP\numVert1=numvert - 2
      *ptrP\numVert2=numvert - 1
      *ptrP\numVert3=numvert - 4
      *ptrP + SizeOf(Polygon)
    EndIf
   
  Next i

  ; Front
  *PtrV0 = *vertexBuffer   
  For i=1 To numvert0
    *PtrV\px = -*PtrV0\pz
    *PtrV\py = -*PtrV0\px
    *PtrV\pz = -*PtrV0\py
    *PtrV\nx = *PtrV\px
    *PtrV\ny = *PtrV\py
    *PtrV\nz = *PtrV\pz
    *PtrV\couleur = *PtrV0\couleur
    *PtrV\u = *PtrV0\v
    *PtrV\v = *PtrV0\u
   
    *PtrV + SizeOf(Vertex)
    *PtrV0 + SizeOf(Vertex)
    numvert+1
   
    If i%4=0
      *ptrP\numVert1=numvert - 4
      *ptrP\numVert2=numvert - 3
      *ptrP\numVert3=numvert - 2
      *ptrP + SizeOf(Polygon)
   
      *ptrP\numVert1=numvert - 2
      *ptrP\numVert2=numvert - 1
      *ptrP\numVert3=numvert - 4
      *ptrP + SizeOf(Polygon)
    EndIf
   
  Next i
 
  ; Back
  *PtrV0 = *vertexBuffer   
  For i=1 To numvert0
    *PtrV\px = -*PtrV0\pz
    *PtrV\py = -*PtrV0\px
    *PtrV\pz = *PtrV0\py
    *PtrV\nx = *PtrV\px
    *PtrV\ny = *PtrV\py
    *PtrV\nz = *PtrV\pz
    *PtrV\couleur = *PtrV0\couleur
    *PtrV\u = 1-*PtrV0\v
    *PtrV\v = *PtrV0\u
   
    *PtrV + SizeOf(Vertex)
    *PtrV0 + SizeOf(Vertex)
    numvert+1
   
    If i%4=0
      *ptrP\numVert1=numvert - 2
      *ptrP\numVert2=numvert - 3
      *ptrP\numVert3=numvert - 4
      *ptrP + SizeOf(Polygon)
   
      *ptrP\numVert1=numvert - 4
      *ptrP\numVert2=numvert - 1
      *ptrP\numVert3=numvert - 2
      *ptrP + SizeOf(Polygon)
    EndIf
   
  Next i

  ; Resize
  If sizeX<>1 Or sizeY<>1 Or sizeZ<>1
    *ptrV = *vertexBuffer
    For i=1 To nbVert
      *PtrV\px = *PtrV\px*sizeX - pivotX
      *PtrV\py = *PtrV\py*sizeY - pivotY
      *PtrV\pz = *PtrV\pz*sizeZ - pivotZ
     
      *PtrV+SizeOf(vertex)
    Next i
  EndIf

  ; Create mesh from stored infos
  maxSize = sizeX
  If sizeY > sizeX
    maxSize = sizeY
  EndIf
  If sizeZ > maxSize
    maxSize = sizeZ
  EndIf
 
  newMesh = CreateMesh(#PB_Any,maxSize)
  If IsMesh(newMesh)
    SetMeshData(newMesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color,*vertexBuffer,nbVert)
    SetMeshData(newMesh,#PB_Mesh_Face,*polygonBuffer,nbTri)     
    FreeMemory(*vertexBuffer)
    FreeMemory(*polygonBuffer)
    ProcedureReturn newMesh
  Else
    ; free memory if "createMesh" has failed
    FreeMemory(*vertexBuffer)
    FreeMemory(*polygonBuffer)
    ProcedureReturn -1   
  EndIf

EndProcedure


;************************************************************************************
; Name: createCylinderMesh
; Purpose: create a cylinder mesh
; Parameters:
;   - number of sides ("3" gives a prism, "4" gives a box)
;   - height
;   - radius
;   - uncapped (=0), caps on top an bottom (=1), top cap only (=2), bottom cap only (=3). (default = 1)
;   - color of the vertices (default = white)
; Return-Value: number of the resulting mesh, -1 if creation failed
;************************************************************************************
Procedure.l createCylinderMesh(nbSides.l,height.f,radius.f,capped.b = 1,coul.l = $FFFFFF)
  Protected *PtrV.Vertex,*vertexBuffer.l    ; vertices buffer in memory
  Protected *PtrF.Polygon,*facetriBuffer.l  ; Faces buffer in memory
  Protected i.l,nbVert.l,nbTri.l, numVertTop.l,numVertBottom.l
  Protected h2.f,theta.f
  Protected newmesh.l                       ; Procedure Result
   
  If nbSides<3
    ProcedureReturn 0
  EndIf

  h2 = height / 2.0
  nbVert = 4*(nbSides+1)+2
  If capped = #CYLCAP_TOP Or capped = #CYLCAP_BOTTOM
    nbVert-1
  Else
    If capped = #CYLCAP_NONE
      nbVert-2
    EndIf
  EndIf   
 
  *vertexBuffer = AllocateMemory(SizeOf(Vertex)*nbVert)
  *PtrV = *vertexBuffer
   
  ;Vertices at the bottom of the cylinder
  For i = 0 To nbSides
    theta =2*#PI*i/nbSides
     
    *PtrV\px = radius*Cos(theta)
    *PtrV\py = -h2
    *PtrV\pz = radius*Sin(theta)
    *PtrV\nx = Cos(theta)
    *PtrV\ny = 0
    *PtrV\nz = Sin(theta)
    *PtrV\couleur = Coul
    *PtrV\u = Theta / (2.0*#PI)
    *PtrV\v = 0
    *PtrV + SizeOf(Vertex)
  Next i

   
  ;Vertices at the top of the cylinder
  For i = 0 To nbSides
    theta =2*#PI*i/nbSides
     
    *PtrV\px = radius*Cos(theta)
    *PtrV\py = h2
    *PtrV\pz = radius*Sin(theta)
    *PtrV\nx = Cos(theta)
    *PtrV\ny = 0
    *PtrV\nz = Sin(theta)
    *PtrV\couleur = Coul
    *PtrV\u = Theta / (2.0*#PI)
    *PtrV\v = 1
    *PtrV + SizeOf(Vertex)
  Next i

     
  ;Vertices at the bottom of the cylinder
  For i = 0 To nbSides
    theta =2*#PI*i/nbSides
     
    *PtrV\px = radius*Cos(theta)
    *PtrV\py = -h2
    *PtrV\pz = radius*Sin(theta)
    *PtrV\nx = 0
    *PtrV\ny = -1
    *PtrV\nz = 0
    *PtrV\couleur = Coul
    *PtrV\u = Theta / (2.0*#PI)
    *PtrV\v = 1
    *PtrV + SizeOf(Vertex)
  Next i
               
  ;Vertices at the top of the cylinder
  For i = 0 To nbSides
    theta =2*#PI*i/nbSides
     
    *PtrV\px = radius*Cos(theta)
    *PtrV\py = h2
    *PtrV\pz = radius*Sin(theta)
    *PtrV\nx = 0
    *PtrV\ny = 1
    *PtrV\nz = 0
    *PtrV\couleur = Coul
    *PtrV\u = Theta / (2.0*#PI)
    *PtrV\v = 1
    *PtrV + SizeOf(Vertex)
  Next i
   
  ;Bottom cap center
  If capped = #CYLCAP_BOTH Or capped = #CYLCAP_BOTTOM
    numVertBottom = (*PtrV - *vertexBuffer) / SizeOf(Vertex)
   
    *PtrV\px = 0
    *PtrV\py = -h2
    *PtrV\pz = 0
    *PtrV\nx = 0
    *PtrV\ny = -1
    *PtrV\nz = 0
    *PtrV\couleur = Coul
    *PtrV\u = 0.5
    *PtrV\v = 0.5
    *PtrV + SizeOf(Vertex)
  EndIf
 
  ;Top cap center
  If capped = #CYLCAP_BOTH Or capped = #CYLCAP_TOP
    numVertTop = (*PtrV - *vertexBuffer) / SizeOf(Vertex)
   
    *PtrV\px = 0
    *PtrV\py = h2
    *PtrV\pz = 0
    *PtrV\nx = 0
    *PtrV\ny = 1
    *PtrV\nz = 0
    *PtrV\couleur = Coul
    *PtrV\u = 0.5
    *PtrV\v = 0.5
  EndIf
   
  ;Facets
  nbTri = 4*nbSides
  If capped = #CYLCAP_BOTTOM Or capped = #CYLCAP_TOP
    nbTri - nbSides
  Else
    If capped = #CYLCAP_NONE
      nbTri - (nbSides*2)
    EndIf
  EndIf
   
  *facetriBuffer=AllocateMemory(SizeOf(Polygon)*nbTri)
  *PtrF=*facetriBuffer
 
  For i=0 To nbSides-1
      *PtrF\numVert3=i
      *PtrF\numVert2=i + 1
      *PtrF\numVert1=nbSides + i + 2
      *PtrF + SizeOf(Polygon)
   
   
      *PtrF\numVert1=i
      *PtrF\numVert3=nbSides + i + 2
      *PtrF\numVert2=nbSides + i + 1
      *PtrF + SizeOf(Polygon)
  Next i
   
 
  ;Bottom cap
  If capped = #CYLCAP_BOTH Or capped = #CYLCAP_BOTTOM   
    For i=0 To nbSides-1
      *PtrF\numVert1= numVertBottom
      *PtrF\numVert2= 2 * nbSides + 2 + i
      *PtrF\numVert3= 2 * nbSides + 3 + i
      *PtrF + SizeOf(Polygon)
    Next i     
  EndIf
  ;Top cap
  If capped = #CYLCAP_BOTH Or capped = #CYLCAP_TOP
    For i=0 To nbSides-1
      *PtrF\numVert1= numVertTop
      *PtrF\numVert3= 3 * nbSides + 3 + i
      *PtrF\numVert2= 3 * nbSides + 4 + i
      *PtrF + SizeOf(Polygon)
    Next i     
  EndIf
 
  ; Create mesh from stored infos
  newmesh = CreateMesh(#PB_Any,radius)
  If IsMesh(newmesh)
    SetMeshData(newmesh,#PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color,*vertexBuffer,nbVert)
    SetMeshData(newmesh,#PB_Mesh_Face,*facetriBuffer,nbTri)
    ; and don't forget to free memory
    FreeMemory(*vertexBuffer)
    FreeMemory(*facetriBuffer)
    ProcedureReturn newmesh
  Else
    ; even if "createMesh" has failed
    FreeMemory(*vertexBuffer)
    FreeMemory(*facetriBuffer)
    ProcedureReturn -1   
  EndIf
   
EndProcedure

DisableExplicit

;- ----- Main -----

;- Camera
CreateCamera(#CAMERA, 0, 0, 100, 100)
CameraLocate(#CAMERA, 50, 120, 0)
CameraLookAt(#CAMERA,0,0,0)

;- Light
AmbientColor(RGB(20,20,20))
CreateLight(0,RGB(255, 0, 0))
CreateLight(1,RGB(0, 255, 0))
CreateLight(2,RGB(0, 0, 255))
WorldShadows(#PB_Shadow_Additive)

;- Materials
Add3DArchive(".", #PB_3DArchive_FileSystem)
CreateImage(0,64,64)
StartDrawing(ImageOutput(0))
  Box(0,0,64,64,$FFFFFF)
StopDrawing()
SaveImage(0,"temp.bmp")
LoadTexture(0,"temp.bmp")
CreateMaterial(0,TextureID(0))
;MaterialAmbientColor(0,#PB_Material_AmbientColors)

LoadFont(1, "Times new roman", 48,#PB_Font_Bold|#PB_Font_HighQuality)
StartDrawing(ImageOutput(0))
DrawingMode(#PB_2DDrawing_Transparent)
DrawingFont(FontID(1))
For i = 1 To 12
  Box(0,0,64,64,$FFFFFF)
  DrawText((64 - TextWidth(Str(i)))/2, (64 - TextHeight(Str(i)))/2, Str(i), $000000)
  SaveImage(0,"temp"+Str(i)+".bmp")
  LoadTexture(i,"temp"+Str(i)+".bmp")
  DeleteFile("temp" + Str(i) + ".bmp")
  CreateMaterial(i,TextureID(i))   
Next i
StopDrawing()
FreeImage(0)

;- Meshes
groundmesh = CreatePlainMesh(30/#QUALITY,200,200)
gnomonMesh = createCylinderMesh(16/#QUALITY,20,2,#CYLCAP_TOP,$FFFFFF)
boxMesh = createBoxMesh(8/#QUALITY,15,20,1)

;- Entities
groundEntity = CreateEntity(#PB_Any,MeshID(groundmesh),MaterialID(0))
EntityRenderMode(groundEntity,0)
gnomonEntity = CreateEntity(#PB_Any,MeshID(gnomonMesh),MaterialID(0))
EntityLocate(gnomonEntity,0,10,0)

For i=1 To 12
  boxEntity(i) = CreateEntity(#PB_Any,MeshID(boxMesh),MaterialID(i))
  EntityLocate(boxEntity(i),50*Cos((180+30*i)*#DEG2RADMULT),10,50*Sin((180+30*i)*#DEG2RADMULT))
  RotateEntity(boxEntity(i),0,90 + i*-30,0)
Next i

;- **** MAIN LOOP *******************************************************************************
secs = Second(Date())
mins = Minute(Date()) + secs/60
hours = Hour(Date()) + mins/60 + secs/3600
oldtimer = ElapsedMilliseconds()
dist = 40
hauteur = 18
Repeat
  If FullScreen = #False
    While WindowEvent() : Wend
  EndIf
 
  ;- Keyboard
  ExamineKeyboard()
 
  If KeyboardReleased(#PB_Key_F1)
    MessageRequester("Statistics",Str(CountRenderedTriangles()) + " polygons, " + Str(Engine3DFrameRate(#PB_Engine3D_Average)) + " Fps")
  EndIf

  ;- Move lights
  newtimer = ElapsedMilliseconds()
  movement = newtimer-oldtimer
  oldtimer = newtimer
  secs+movement/1000
  If secs>=60
    secs-60
  EndIf
  LightLocate(1,dist*Cos(secs*6*#DEG2RADMULT),hauteur,dist*Sin(secs*6*#DEG2RADMULT))
 
  mins+movement/60000
  If mins>=60
    mins-60
  EndIf
  LightLocate(0,dist*Cos(mins*6*#DEG2RADMULT),38,dist*Sin(mins*6*#DEG2RADMULT))
 
  hours+movement/3600000
  If hours>=24
    hours-24
  EndIf
  LightLocate(2,dist*Cos(hours*30*#DEG2RADMULT),45,dist*Sin(hours*30*#DEG2RADMULT))

  ; Show it all
  RenderWorld()
 
  ; Flip buffers to avoid tearing
  FlipBuffers()
 
  Delay(1)
Until KeyboardPushed(#PB_Key_Escape)

dige · Post by **dige** » Mon Oct 05, 2009 10:14 am

Very cool and a very good example for using PB 3D
stuff, especially vertex and normals.
Thx a lot!

Kelebrindae · Post by **Kelebrindae** » Mon Oct 05, 2009 10:23 am

You're welcome.

I must say, most of mesh creation code is from Comtois (only slightly modified for my needs).

PB · Post by PB » Mon Oct 05, 2009 10:31 am

Fails in full-screen with this error:

Code: Select all

Line: 752 - Invalid memory access. (read error at address 0)

Looks good in a window, though. Although, too colorful for my liking. Can it be made grayscale perhaps?

dige · Post by **dige** » Mon Oct 05, 2009 10:44 am

ORGE need a supported screensize. Try 800x600 ... instead of 1.440x900

jamirokwai · Post by **jamirokwai** » Mon Oct 05, 2009 10:53 am

Kelebrindae wrote:Hi,
Starting today, I'll post a few codes previously published on the french forums, before the 4.40 makes them all obsolete.

The first one is quite simple: it's a clock. More precisely, a light clock, whose hands are made of shadows; just like a sun dial, but with 3 little suns rotating around the center.
Well, I'm not making much sense, here... See by yourself, it's easier than explaining.

Side Note: PB is doing remarquably well with lights and shadows!

Cool effect! Works great on Mac OS X/PB 4.40b3 (fullscreen and windowed). However I had to change line 774 to

LoadFont(1, "Arial", 48,#PB_Font_Bold|#PB_Font_HighQuality)

to make it work. I would also change the colors to grayscale e.g., because it looks a bit eyecancerish

Fangbeast · Post by **Fangbeast** » Mon Oct 05, 2009 12:14 pm

This is stunning in full screen. Thanks to Dige's hint about the screen size else it would not have worked here. Phew!

Love it.

Tomi · Post by **Tomi** » Mon Oct 05, 2009 12:35 pm

Cute project ,Thanks Kelebrindae

netmaestro · Post by **netmaestro** » Mon Oct 05, 2009 2:08 pm

Very nice and instructive too. Thanks for sharing!

WilliamL · Post by **WilliamL** » Mon Oct 05, 2009 5:41 pm

Wow

(@ jamirokwai thanks for the fix)

Works great here too on Mac 4.40x86b3.

Really heats up the computer...

rsts · Post by **rsts** » Mon Oct 05, 2009 6:05 pm

Very impressive. Thanks for sharing with us.

cheers

Rook Zimbabwe · Post by **Rook Zimbabwe** » Mon Oct 05, 2009 7:11 pm

I LOVE IT!!! Mesh Creation and all! Thank you for sharing!!!

We need more cross pollination of the forums!!!

dige · Post by **dige** » Mon Oct 05, 2009 7:32 pm

I've played a little bit around. To have a closer look add this after ExamineKeyboard()

Code: Select all

  ;- Keyboard
  ExamineKeyboard()
  
  If KeyboardReleased(#PB_Key_F1)
    MessageRequester("Statistics",Str(CountRenderedTriangles()) + " polygons, " + Str(Engine3DFrameRate(#PB_Engine3D_Average)) + " Fps")
    
  ElseIf KeyboardPushed(#PB_Key_PageDown) 
    MoveCamera(#CAMERA, 0, 0, 1)
    
  ElseIf KeyboardPushed(#PB_Key_PageUp) 
    MoveCamera(#CAMERA, 0, 0, -1)
  
  ElseIf KeyboardPushed(#PB_Key_Left)  
    RotateCamera(#CAMERA, 0, 1, 0, #PB_Relative)
    
  ElseIf KeyboardPushed(#PB_Key_Right)  
    RotateCamera(#CAMERA, 0, -1, 0, #PB_Relative)
    
  ElseIf KeyboardPushed(#PB_Key_Up)  
    RotateCamera(#CAMERA, 1, 0, 0, #PB_Relative)
    
  ElseIf KeyboardPushed(#PB_Key_Down)  
    RotateCamera(#CAMERA, -1, 0, 0, #PB_Relative)
    
  EndIf

And for less color style:

Code: Select all

CreateLight(0,$FA9A9A)
CreateLight(1,$FA7A7A)
CreateLight(2,$FAAAAA)

Kelebrindae · Post by **Kelebrindae** » Tue Oct 06, 2009 9:07 am

Thanks a lot to all of you for your positive feedback !

Second post is here: http://www.purebasic.fr/english/viewtop ... 16&t=39378

Blue · Post by **Blue** » Wed Oct 07, 2009 6:41 pm

@ Kelebrindae Thank you. Wonderful.

@dige

I've played a little bit around. ...

I'm glad you did. Nice additions.

But i was getting seasick and lost!

So i added a Reset, using the HOME key:

Code: Select all

ElseIf KeyboardPushed(#PB_Key_Home)  
    CameraLocate(#CAMERA, 50, 120, 0)
    CameraLookAt(#CAMERA,0,0,0)

@anyone:
in fullscreen mode, the message box (from F1) remains hidden behind the clock screen. is there any way to force it to the front ? (I'm under WIndows 7 x64).

PureBasic Forums - English

[PB 4.31] A simple light clock

[PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock

Re: [PB 4.31] A simple light clock