PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

PureBlock updated 5.10

https://www.purebasic.fr/english/viewtopic.php?t=53656

Page 1 of 1

PureBlock updated 5.10

Posted: Sun Feb 24, 2013 8:53 pm
by Comtois
I do not have time to update the full game, but here's the snipet updated.

for more information, see this old post :
http://www.purebasic.fr/english/viewtop ... 16&t=28519

Code: Select all

InitEngine3D()
InitSprite()
InitKeyboard()

Enumeration
  #Nord
  #Est
  #Sud
  #Ouest
  #Vertical
EndEnumeration

#Taille=12
#Taille2 = #Taille/2

Structure f_Vecteur
  x.f
  y.f
  z.f
EndStructure

Structure i_Vecteur
  x.i
  y.i
  z.i
EndStructure

Structure s_Cube
  Angle.f
  p.f_Vecteur
  s.f_Vecteur
  t.f_Vecteur 
  Type.l
  Sens.l
  Case1.I_Vecteur
  Case2.I_Vecteur
  Origine.I_Vecteur
EndStructure

Structure s_Vertex
  px.f
  py.f
  pz.f
  nx.f
  ny.f
  nz.f
  u.f
  v.f
EndStructure

Global Cube.s_Cube, Px.l, Pz.l, Perdu.l, MapX.l, MapZ.l
Define.l Options, i, j, Tombe

Restore Niveau1
Read MapX
Read MapZ
Dim Map(MapX+1,MapZ+1)
Read Cube\Origine\X
Read Cube\Origine\Z
For j=1 To MapZ
  For i = 1 To MapX
    Read Map(i,j)
  Next i 
Next j

;Initialise le cube
Cube\p\x=Cube\Origine\X*#Taille
Cube\p\y=#Taille
Cube\p\z=Cube\Origine\Z*#Taille
Cube\Type = #Vertical
Cube\Sens = #Vertical

;- Ouverture de la fenêtre et de l'écran
ExamineDesktops()
OpenScreen(DesktopWidth(0),DesktopHeight(0),DesktopDepth(0),"Test")

;- Declaration des procédures
Declare CreateBlock()
Declare UpdateBlock()
Declare Animation()

Macro TEXTURE(Texture, Couleur)
  CreateTexture(Texture, 128, 128)
  ;Remplissage de la texture en blanc
  StartDrawing(TextureOutput(Texture))
  Box(0, 0, TextureWidth(Texture), TextureHeight(Texture), Couleur)
  DrawingMode(#PB_2DDrawing_Outlined)
  Box(0, 0, TextureWidth(Texture), TextureHeight(Texture), $FF0000)
  StopDrawing()
EndMacro

Macro GAGNE()
  Repeat
    tombe - 1
    MoveNode(#Entity, 0, -1, 0)
    RenderWorld()
    FlipBuffers()   
  Until Tombe < -150
  tombe = 0
EndMacro

;-Mesh
#Mesh = 0

CreateBlock()


#MeshN=1
CreateCube(#MeshN, 1)

;-Textures
#Texture = 0
Texture(#Texture, $BA8E3A)

#TextureSol = 1
Texture(#TextureSol, $FFFFFF)

;-Matière
#Matiere = 0
CreateMaterial(#Matiere, TextureID(#Texture))

#MatiereSol = 1
CreateMaterial(#MatiereSol, TextureID(#TextureSol))

;-Entity
#Entity = 0
;CreateEntity(#Entity, MeshID(#Mesh), MaterialID(#Matiere))
SetMeshMaterial(#Mesh, MaterialID(#Matiere))
CreateNode(#Entity)
AttachNodeObject(#entity,MeshID(#mesh))

UpdateBlock()

#EntitySol = 1
For j=1 To MapZ
  For i=1 To MapX
    If Map(i,j)=1
      Map(i,j)= CreateEntity(#PB_Any, MeshID(#MeshN), MaterialID(#TextureSol))
      ScaleEntity(Map(i,j), #Taille, 2, #Taille)
      MoveEntity(Map(i,j), i*#Taille, -1, j*#Taille, #PB_Absolute)
    EndIf
  Next i
Next j     

;-Camera
#Camera = 0
CreateCamera(#Camera, 0, 0, 100, 100)
MoveCamera(#Camera, 0, 110, 16*#Taille, #PB_Absolute)
CameraLookAt(#Camera, 5*#Taille, 0, 3*#Taille)

;-Light
AmbientColor(RGB(185,185,185))
CreateLight(0,$FFFFFF,500,500,500)

;- **** MAIN ****

Repeat
  
  If ExamineKeyboard()
    
    If Cube\Sens = #Vertical 
      If KeyboardPushed(#PB_Key_Left)
        Cube\Sens = #Ouest : UpdateBlock()
      ElseIf KeyboardPushed(#PB_Key_Right)
        Cube\Sens = #Est   : UpdateBlock()
      ElseIf KeyboardPushed(#PB_Key_Up)
        Cube\Sens = #Nord  : UpdateBlock()
      ElseIf KeyboardPushed(#PB_Key_Down)
        Cube\Sens = #Sud   : UpdateBlock()
      EndIf
    EndIf
    
  EndIf
  
  Animation()
  
  ;Test position
  Perdu = #False
  If Cube\type = #Vertical
    Px = Cube\p\x / #Taille
    Pz = Cube\p\z / #Taille
    If Map(Px, Pz)=2
      GAGNE()
      Perdu = #True
    ElseIf Map(Px, Pz)=0
      Perdu = #True
    EndIf
  ElseIf Cube\type = #Nord Or Cube\type = #Sud
    Px = Cube\p\x / #Taille
    Pz = (Cube\p\z + #Taille2) / #Taille
    If Map(Px, Pz)=0
      Perdu = #True
    EndIf
    Pz = (Cube\p\z - #Taille2) / #Taille
    If Map(Px, Pz)=0
      Perdu = #True
    EndIf
  ElseIf Cube\type = #Est Or Cube\type = #Ouest
    Px = (Cube\p\x + #Taille2) / #Taille
    Pz = Cube\p\z  / #Taille
    If Map(Px, Pz)=0
      Perdu = #True
    EndIf
    Px = (Cube\p\x - #Taille2) / #Taille
    If Map(Px, Pz)=0
      Perdu = #True
    EndIf
  EndIf       
  
  
  If Perdu
    ;Initialise le cube
    Cube\p\x=Cube\Origine\X*#Taille
    Cube\p\y=#Taille
    Cube\p\z=Cube\Origine\Z*#Taille
    Cube\Type = #Vertical
    Cube\Sens = #Vertical 
    UpdateBlock()
  EndIf
  RenderWorld()
  
  FlipBuffers()
  
Until KeyboardPushed(#PB_Key_Escape)


Procedure CreateBlock()
  CreateMesh(#Mesh, #PB_Mesh_TriangleList, #PB_Mesh_Dynamic)
  Restore Sommets
  For i = 1 To 24
    Read.f x.f
    Read.f y.f
    Read.f z.f
    Read.f nx.f
    Read.f ny.f
    Read.f nz.f
    Read.f u.f
    Read.f v.f
    
    MeshVertexPosition(x,y,z)
    MeshVertexNormal(nx, ny, nz)
    MeshVertexTextureCoordinate(u, v)
    
  Next i
  Restore Triangles
  For i = 1 To 12
    Read.w t1.w
    Read.w t2.w
    Read.w t3.w
    
    MeshFace(t1,t2,t3)
  Next i
  FinishMesh(#False)
EndProcedure

Procedure UpdateBlock()
  Define.i i
  Protected *Sommet, *Ptr.s_Vertex
  
  UpdateMesh(#Mesh, 0)
  
  *Sommet=AllocateMemory(SizeOf(s_Vertex)*24) ; 24 sommets et 36 octets par sommet
  
  CopyMemory(?Sommets,*Sommet,SizeOf(s_Vertex)*24)
  
  With Cube
    Select \type
      Case #Vertical
        \s\x = 1 : \s\y = 2 : \s\z = 1
      Case #Nord, #Sud
        \s\x = 1 : \s\y = 1 : \s\z = 2
      Case #Ouest, #Est
        \s\x = 2 : \s\y = 1 : \s\z = 1
    EndSelect
    
    Select \Sens
      Case #Nord
        \t\x = 0.5 : \t\y = 0.5 : \t\z = 0.5
      Case #Sud
        \t\x = 0.5 : \t\y = 0.5 : \t\z = -0.5
      Case #Ouest
        \t\x = 0.5 : \t\y = 0.5 : \t\z = 0
      Case #Est
        \t\x = -0.5 : \t\y = 0.5 : \t\z = 0
      Case #Vertical
        \t\x = 0 : \t\y = 0.5 : \t\z = 0
    EndSelect
    
    *Ptr=*Sommet
    
    For i = 1 To 24
      *Ptr\px = (*Ptr\px + \t\x) * \s\x*#Taille
      *Ptr\py = (*Ptr\py + \t\y) * \s\y*#Taille
      *Ptr\pz = (*Ptr\pz + \t\z) * \s\z*#Taille
      
      MeshVertexPosition(*Ptr\px,*Ptr\py,*Ptr\pz)
      MeshVertexNormal(*Ptr\nx, *Ptr\ny, *Ptr\nz)
      MeshVertexTextureCoordinate(*Ptr\u, *Ptr\v)
      *Ptr + SizeOf(s_Vertex)
    Next i
    
    Restore Triangles
    For i = 1 To 12
      Read.w t1.w
      Read.w t2.w
      Read.w t3.w
      
      MeshFace(t1,t2,t3)
    Next i
    FinishMesh(#False)
    
    RotateNode(#Entity,0,0,0,#PB_Absolute)
    MoveNode(#Entity, \p\x-\t\x*\s\x*#Taille, 0, \p\z-\t\z*\s\z*#taille, #PB_Absolute)
    
  EndWith
  FreeMemory(*Sommet)
  
EndProcedure

Procedure Animation()
  Define.f Delta
  Delta = 4.5
  
  Select Cube\Sens
      
    Case #Ouest
      Cube\Angle + Delta
      RotateNode(#Entity,0,0,Cube\Angle)
      
      If Int(Cube\Angle) = 90
        Cube\Angle = 0 : Cube\Sens = #Vertical
        If Cube\Type = #Vertical
          Cube\Type = #Ouest
          Cube\p\x - 1.5*#Taille
        ElseIf Cube\Type = #Est Or Cube\Type = #Ouest
          Cube\Type = #Vertical
          Cube\p\x - 1.5*#Taille
        Else
          Cube\p\x - #Taille
        EndIf
      EndIf
      
    Case #Est
      Cube\Angle - Delta
      RotateNode(#Entity,0,0,Cube\Angle)
      
      If Int(Cube\Angle) = -90
        Cube\Angle = 0 : Cube\Sens = #Vertical
        
        If Cube\Type = #Vertical
          Cube\Type = #Est
          Cube\p\x + 1.5*#Taille
        ElseIf Cube\Type = #Est Or Cube\Type = #Ouest
          Cube\Type = #Vertical
          Cube\p\x + 1.5*#Taille
        Else
          Cube\p\x + #Taille
        EndIf
        
      EndIf   
      
    Case #Nord
      Cube\Angle - Delta
      RotateNode(#Entity,Cube\Angle,0, 0)
      
      If Int(Cube\Angle) = -90
        Cube\Angle = 0 : Cube\Sens = #Vertical
        
        If Cube\Type = #Vertical
          Cube\Type = #Nord
          Cube\p\z - 1.5*#Taille
        ElseIf Cube\Type = #Nord Or Cube\Type = #Sud
          Cube\Type = #Vertical
          Cube\p\z - 1.5*#Taille
        Else
          Cube\p\z - #Taille
        EndIf
        
      EndIf
      
    Case #Sud
      Cube\Angle + Delta
      RotateNode(#Entity,Cube\Angle,0, 0)
      
      If Int(Cube\Angle) = 90
        Cube\Angle = 0 :  Cube\Sens = #Vertical
        
        If Cube\Type = #Vertical
          Cube\Type = #Sud
          Cube\p\z + 1.5*#Taille
        ElseIf Cube\Type = #Nord Or Cube\Type = #Sud
          Cube\Type = #Vertical
          Cube\p\z + 1.5*#Taille
        Else
          Cube\p\z + #Taille
        EndIf
        
      EndIf
  EndSelect
  
EndProcedure

;{ Définition du cube
DataSection
  Sommets:
  ;Dessus 0 à 3
  Data.f -0.5,0.5,-0.5
  Data.f 0,1,0
  Data.f 0,0
  
  Data.f 0.5,0.5,-0.5
  Data.f 0,1,0
  Data.f 0,1
  
  Data.f 0.5,0.5,0.5
  Data.f 0,1,0
  Data.f 1,1
  
  Data.f -0.5,0.5,0.5
  Data.f 0,1,0
  Data.f 1,0
  
  ;Dessous 4 à 7
  Data.f -0.5,-0.5,0.5
  Data.f 0,-1,0
  Data.f 0,0
  
  Data.f 0.5,-0.5,0.5
  Data.f 0,-1,0
  Data.f 0,1
  
  Data.f 0.5,-0.5,-0.5
  Data.f 0,-1,0
  Data.f 1,1
  
  Data.f -0.5,-0.5,-0.5
  Data.f 0,-1,0
  Data.f 1,0
  
  ;Devant 8 à 11
  Data.f -0.5,0.5,0.5
  Data.f 0,0,1
  Data.f 0,0
  
  Data.f 0.5,0.5,0.5
  Data.f 0,0,1
  Data.f 0,1
  
  Data.f 0.5,-0.5,0.5
  Data.f 0,0,1
  Data.f 1,1
  
  Data.f -0.5,-0.5,0.5
  Data.f 0,0,1
  Data.f 1,0
  
  ;Derrière 12 à 15
  Data.f 0.5,0.5,-0.5
  Data.f 0,0,-1
  Data.f 0,0
  
  Data.f -0.5,0.5,-0.5
  Data.f 0,0,-1
  Data.f 0,1
  
  Data.f -0.5,-0.5,-0.5
  Data.f 0,0,-1
  Data.f 1,1
  
  Data.f 0.5,-0.5,-0.5
  Data.f 0,0,-1
  Data.f 1,0
  
  ;Cote gauche 16 à 19
  Data.f -0.5,0.5,-0.5
  Data.f -1,0,0
  Data.f 0,0
  
  Data.f -0.5,0.5,0.5
  Data.f -1,0,0
  Data.f 0,1
  
  Data.f -0.5,-0.5,0.5
  Data.f -1,0,0
  Data.f 1,1
  
  Data.f -0.5,-0.5,-0.5
  Data.f -1,0,0
  Data.f 1,0
  
  ;Cote droit 20 à 23
  Data.f 0.5,0.5,0.5
  Data.f 1,0,0
  Data.f 0,0
  
  Data.f 0.5,0.5,-0.5
  Data.f 1,0,0
  Data.f 0,1
  
  Data.f 0.5,-0.5,-0.5
  Data.f 1,0,0
  Data.f 1,1
  
  Data.f 0.5,-0.5,0.5
  Data.f 1,0,0
  Data.f 1,0
  
  Triangles:
  ;Face en Haut
  Data.w 2,1,0
  Data.w 0,3,2
  ;Face en Bas
  Data.w 6,5,4
  Data.w 4,7,6
  ;Face Avant
  Data.w 10,9,8
  Data.w 8,11,10
  ;Face Arrière
  Data.w 14,13,12
  Data.w 12,15,14
  ;Face Gauche
  Data.w 18,17,16
  Data.w 16,19,18
  ;Face Droite
  Data.w 22,21,20
  Data.w 20,23,22
  
  Niveau1:
  Data.l 10,6
  Data.l 2, 2
  Data.l 1,1,1,0,0,0,0,0,0,0
  Data.l 1,1,1,1,1,1,0,0,0,0
  Data.l 1,1,1,1,1,1,1,1,1,0
  Data.l 0,1,1,1,1,1,1,1,1,1
  Data.l 0,0,0,0,0,1,1,2,1,1
  Data.l 0,0,0,0,0,0,1,1,1,0
  Niveau2:
  Data.l 15,6
  Data.l 2, 5
  Data.l 0,0,0,0,0,0,1,1,1,1,0,0,1,1,1
  Data.l 1,1,1,1,0,0,1,1,4,1,0,0,1,2,1
  Data.l 1,1,3,1,0,0,1,1,1,1,0,0,1,1,1
  Data.l 1,1,1,1,0,0,1,1,1,1,0,0,1,1,1
  Data.l 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
  Data.l 1,1,1,1,0,0,1,1,1,1,0,0,0,0,0
EndDataSection
;}

Re: PureBlock updated 5.10

Posted: Sun Feb 24, 2013 10:12 pm
by A.D.
very nice! good idea, mate !
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited