PureBoard

Code: Alles auswählen

;_______________________________________________________________________________________
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
; Type Fichier : Inclusion PureBasic V4.10 B2
; Auteur : Ollivier
; http://www.purebasic.fr/english/viewtopic.php?t=32642
;_______________________________________________________________________________________
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯

Macro Init(a, b = Init, c = ")

      If b#a() = 0
     
            MessageRequester("Message", "DirectX error !" + Chr(10) + c#a can't be initialized !")
            End
     
      EndIf

EndMacro

#PtrLength = 4

;{ Head }

  ;{ World }

Structure V3
  X.F
  Y.F
  Z.F
EndStructure

Structure WORLD
  EntiQtt.L
  CamQtt.L
  *EntiPtr
  *CamPtr
  Flag.L ; Bit 0 : Réinitialise la caméra quand on change de mode de déplacement
         ; Bit 1 : Indique que l'on démarre la session
EndStructure

Structure CAM
  Ang.V3
  Pos.V3
EndStructure

Structure ENTI
  N.L
  Texture.L
  Material.L
  Mesh.L
  MeshData.L
EndStructure

Procedure RotateCam(*World.WORLD, n.L, x.F, y.F, z.F)

  Protected *Cam.CAM
 
  RotateCamera(0, x, y, z)
  *Cam = *World\CamPtr + n * SizeOf(CAM)
  *Cam\Ang\X + x
  *Cam\Ang\Y + y
  *Cam\Ang\Z + z

EndProcedure

Procedure ResetCam(*World.WORLD, n.L)
  Protected *Cam.CAM
  *Cam = *World\CamPtr + n * SizeOf(CAM)
  With *Cam\Ang
    RotateCamera(0, 360.0 - \x, 360.0 - \y, 360.0 - \z)
  EndWith
EndProcedure
 
Procedure CamLocate(*World.WORLD, n.L, x.F, y.F, z.F)

  Protected *Cam.CAM
 
  CameraLocate(0, x, y, z)
  *Cam = *World\CamPtr + n * SizeOf(CAM)
  *Cam\Pos\X = x
  *Cam\Pos\Y = y
  *Cam\Pos\Z = z

EndProcedure
 
Procedure MoveCam(*World.WORLD, n.L, x.F, y.F, z.F)

  Protected *Cam.CAM
 
  MoveCamera(0, x, y, z)
  *Cam = *World\CamPtr + n * SizeOf(CAM)
  *Cam\Pos\X = CameraX(n)
  *Cam\Pos\Y = CameraY(n)
  *Cam\Pos\Z = CameraZ(n)

EndProcedure
 
Procedure.L InitWorld(MaxEntity.L)
;_______________________________________________________________________________________
; Cette procédure doit être appelée avant toute exploitation 3D
; Elle amorce DirectX, prépare un écran graphique et une vision 3D plein écran
;
; MaxEntity.L : Quantité maximum d'entités à traiter
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  Protected *Result.WORLD
  *Result = AllocateMemory(SizeOf(WORLD) )
  Init(Engine3D)
  Init(Sprite)
  Init(Keyboard)
  Init(Mouse)
  ExamineDesktops()
  OpenWindow(0, 0, 0, DesktopWidth(0), DesktopHeight(0), "Ogre3D", $80000000)
  OpenWindowedScreen(WindowID(0), 0, 0, 1, 1, 1, 0, 0)
  CreateCamera(0, 0, 0, 100, 100)
  CameraRange(0, 0.1, 10000)
  *Result = AllocateMemory(SizeOf(WORLD) )
  *Result\EntiPtr = AllocateMemory(MaxEntity * #PtrLength)
  *Result\CamQtt = 1
  *Result\CamPtr = AllocateMemory(SizeOf(CAM) )
  LoadFont(0, "Verdana", 48)
  CreateLight(0,$FFFFFF)
  LightLocate(0,100,5,100)
  *Result\Flag | 2
  ProcedureReturn *Result
 
EndProcedure
Procedure CamTransit(*World.WORLD)
EndProcedure
Procedure WalkWorld(*World.WORLD)
;_______________________________________________________________________________________
; Explore le monde comme un piéton
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  Protected ExitCode.L
  Protected Event0.L
  Protected Event1.L
  Protected CamX.F
  Protected CamZ.F
 
  If *World\Flag & 1
    CamX = CameraX(0)
    CamZ = CameraZ(0)
    CameraLocate(0, CamX, 0.0, CamZ)
    CameraLookAt(0, CamX + 1.0, 0.0, CamZ + 1.0)
    *World\Flag & $FFFFFFFE
  EndIf
  Repeat
      Delay(24)
      FlipBuffers()
      ExamineKeyboard()     
      ExamineMouse()
      If KeyboardPushed(#PB_Key_Right): MoveCam(*World, 0, 1.0, 0,  0):EndIf
      If KeyboardPushed(#PB_Key_Left):  MoveCam(*World, 0, -1.0, 0,  0):EndIf
      If KeyboardPushed(#PB_Key_PageUp):    MoveCam(*World, 0,  0, 1, 0):EndIf
      If KeyboardPushed(#PB_Key_PageDown):  MoveCam(*World, 0,  0, -1, 0):EndIf
      If KeyboardPushed(#PB_Key_Up):    MoveCam(*World, 0,  0, 0, -0.8):EndIf
      If KeyboardPushed(#PB_Key_Down):  MoveCam(*World, 0, 0, 0, 0.8):EndIf
      Event0 = WindowEvent()
      If Event0 = 16: ExitCode | 1: EndIf
      If MouseButton(2): ExitCode | 2: EndIf
      If KeyboardPushed(#PB_Key_Escape): ExitCode | 1: EndIf
      RotateCam(*World, 0, -MouseDeltaX(), -MouseDeltaY(), 0)
      CamLocate(*World, 0,  CameraX(0), 1.80, CameraZ(0) )
      RenderWorld()
    Until ExitCode 
   ProcedureReturn ExitCode
EndProcedure
Procedure ExploreWorld(*World.WORLD)
;_______________________________________________________________________________________
; Explore le monde sans règles précises (liberté de positions et d'angles de caméra)
; Utile pour explorer un décor
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  Protected ExitCode.L
  Protected Event0.L
  Protected Event1.L
  Repeat
      Delay(24)
      FlipBuffers()
      ClearScreen(0)
      ExamineKeyboard()
      ExamineMouse()
      If KeyboardPushed(#PB_Key_Right): MoveCam(*World, 0,  1, 0,  0):EndIf
      Delay(2)
      If KeyboardPushed(#PB_Key_Left): MoveCam(*World, 0, -1, 0,  0):EndIf
      Delay(2)
      If KeyboardPushed(#PB_Key_PageUp): MoveCam(*World, 0,  0, 1, 0):EndIf
      Delay(2)
      If KeyboardPushed(#PB_Key_PageDown): MoveCam(*World, 0,  0, -1, 0):EndIf
      Delay(2)
      If KeyboardPushed(#PB_Key_Up): MoveCam(*World, 0,  0, 0, -1):EndIf
      Delay(2)
      If KeyboardPushed(#PB_Key_Down): MoveCam(*World, 0,  0, 0, 1):EndIf
      Delay(2)
      Event0 = WindowEvent()
      If Event0 = 16: ExitCode | 1: EndIf
      If MouseButton(2): ExitCode | 2: EndIf
      If KeyboardPushed(#PB_Key_Escape): ExitCode | 1: EndIf
      RotateCam(*World, 0, -MouseDeltaX(), -MouseDeltaY(), 0)
      RenderWorld()
    Until ExitCode
   
EndProcedure
Procedure MapWorld(*World.WORLD, AltitudeIni.F)

  Protected ExitCode.L
  Protected Event0.L
  Protected Event1.L
  Protected D.F
  Protected CamX.F
  Protected CamZ.F
 
  If *World\Flag & 1
    CamX = CameraX(0)
    CamZ = CameraZ(0)
    CameraLocate(0, CamX, AltitudeIni, CamZ)
    CameraLookAt(0, CamX, AltitudeIni, CamZ + 1.0)
    RotateCamera(0, 0.0, -90.0, 0.0)
   *World\Flag & $FFFFFFFE
  EndIf

  Repeat
    Delay(48)
    FlipBuffers()
    ClearScreen(0)
    ExamineKeyboard()   
    D = CameraY(0) / 40.0
    If KeyboardPushed(#PB_Key_Right): MoveCam(*World, 0,  D, 0, 0): EndIf
    If KeyboardPushed(#PB_Key_Left): MoveCam(*World, 0, -D, 0, 0): EndIf
    If KeyboardPushed(#PB_Key_PageUp): MoveCam(*World, 0, 0, 0, -5): EndIf
    If KeyboardPushed(#PB_Key_PageDown): MoveCam(*World, 0, 0, 0, 5): EndIf
    If KeyboardPushed(#PB_Key_Up): MoveCam(*World, 0, 0, D, 0): EndIf
    If KeyboardPushed(#PB_Key_Down): MoveCam(*World, 0, 0, -D, 0): EndIf
    Event0 = WindowEvent()
    If Event0 = 16: ExitCode | 1: EndIf
    If Event0 = #WM_RBUTTONDOWN: ExitCode | 2: EndIf
    If KeyboardPushed(#PB_Key_Escape): ExitCode | 1: EndIf
    RenderWorld()
  Until ExitCode
   
EndProcedure
Procedure FlyWorld(*World.WORLD, AltitudeIni.F)

  Protected ExitCode.L
  Protected Event0.L
  Protected Event1.L

  Protected CamX.F
  Protected CamY.F
  Protected CamZ.F

  Protected EntityAngleX.F
  Protected EntityAngleY.F
  Protected EntityAngleZ.F
 
  CamLocate(*World, 0, 100.0, 40.0, 100.0)
  RotateCam(*World, 0, 45.0, -45.0, 0.0)
  Repeat
      Delay(48)
      FlipBuffers()
      ClearScreen(0)
      ExamineKeyboard()
      If KeyboardPushed(#PB_Key_PageUp): MoveCam(*World, 0, 0, 0, -1):EndIf
      If KeyboardPushed(#PB_Key_PageDown): MoveCam(*World, 0, 0, 0, 1):EndIf
      CamY = CameraY(0)
      If KeyboardPushed(#PB_Key_Right): MoveCam(*World, 0, 1, 0, 0):EndIf
      If KeyboardPushed(#PB_Key_Left): MoveCam(*World, 0, -1, 0,  0):EndIf
      If KeyboardPushed(#PB_Key_Up): MoveCam(*World, 0, 0, 1, 0):EndIf
      If KeyboardPushed(#PB_Key_Down): MoveCam(*World, 0, 0, -1, 0):EndIf
      CamLocate(*World, 0, CameraX(0), CamY, CameraZ(0) )
      Event0 = WindowEvent()
      If Event0 = 16: ExitCode | 1: EndIf
      If Event0 = #WM_RBUTTONDOWN: ExitCode | 2: EndIf
      If KeyboardPushed(#PB_Key_Escape): ExitCode | 1: EndIf
      RenderWorld()
    Until ExitCode
   
EndProcedure
Procedure WorldMenu(*World.WORLD)
  Protected ExitCode.L
  Protected Choice.L
  Protected Event0.L
  Protected OldChoice.L
  Protected MovingType.L
  Protected ViewMode.L
  Protected Domain.L
  Protected FogOn.L
  Repeat
    *World\Flag | 1
    If Domain = $11
      Repeat
        Event0 = WaitWindowEvent()
      Until (Event0 <> #WM_LBUTTONDOWN) And (Event0 <> #WM_RBUTTONDOWN)
      ShowCursor_(1)
      SetCursorPos_(0, 0)
      Repeat
        Event0 = WaitWindowEvent()
        If Event0 = 512
          FreeMenu(0)
          CreatePopupMenu(0)
          If MovingType <= 1
            MenuItem($1300, "Fog")
            MenuBar()
          EndIf
          MenuItem($1200, "Normal rendering")
          MenuItem($1201, "Wired rendering")
          MenuItem($1202, "Plot rendering")
          MenuBar()
          MenuItem($1100, "Walking")
          MenuItem($1101, "Flying")
          MenuItem($1102, "Map reading")
          MenuBar()
          MenuItem($1F00, "Quit")
          SetMenuItemState(0, $1100 + MovingType, 1)       
          SetMenuItemState(0, $1200 + ViewMode, 1)
          SetMenuItemState(0, $1300, FogOn)
          DisplayPopupMenu(0, WindowID(0), WindowX(0), WindowY(0) )
        EndIf
      Until Event0 = #PB_Event_Menu Or Event0 = #WM_RBUTTONDOWN Or Event0 = #WM_LBUTTONDOWN
      Choice = EventMenu()
      Domain = Choice >> 8
      ShowCursor_(0)
    Else
      If *World\Flag & 2
        *World\Flag & $FFFFFFFD
      Else
        *World\Flag & $FFFFFFFE     
      EndIf
      Domain = $11
      Choice = MovingType
    EndIf
    Select Domain
    Case $11
      If IsMenu(0): SetMenuItemState(0, $1100 + MovingType, 0): EndIf
      MovingType = Choice & 3
      Select MovingType
        Case 0: ExitCode = WalkWorld(*World)
        Case 1: ExitCode = ExploreWorld(*World)
        Case 2: Fog(0, 0, 0, 0): ExitCode = MapWorld(*World, 100.0)
        Case 3: Fog(0, 0, 0, 0): ExitCode = FlyWorld(*World, 100.0)
      EndSelect     
    Case $12
      SetMenuItemState(0, $1200 + ViewMode, 0)
      ViewMode = Choice & 3
      CameraRenderMode(0, ViewMode)
    Case $13
      FogOn ! 1
      SetMenuItemState(0, $1300, FogOn)
      If FogOn & 1
        Fog(RGB(0, 0, 0), 100, 1, 100)
      Else
        Fog(0, 0, 0, 0)
      EndIf     
    Case $1F
      Select Choice
        Case $1F00: Break
      EndSelect
    EndSelect
    OldChoice = Choice
  Until ExitCode & 1
EndProcedure
  ;}
  ;{ Texture }

Procedure TextureMonochrom(*Enti.ENTI, Color.L)
  *Enti\Texture = CreateTexture(-1, 256, 256)
  StartDrawing(TextureOutput(*Enti\Texture) )
    Box(0, 0, 256, 256, Color)
  StopDrawing()
EndProcedure
Procedure TextureGrass(*Enti.ENTI)
  Protected x.L
  Protected y.L
  Protected R.L
  Protected V.L
  Protected B.L
  *Enti\Texture = CreateTexture(-1, 256, 256)
  StartDrawing(TextureOutput(*Enti\Texture) )
    For y = 0 To 255
      For x = 0 To 255
        V = Random(255)
        R = Random(V)
        B = 0
        Box(x, y, 1, 1, RGB(R, V, B) )
      Next
    Next
  StopDrawing()
EndProcedure
Procedure TextureLafarge(*Enti.ENTI)
  Protected x.L
  Protected y.L
  Protected R.L
  Protected V.L
  Protected B.L
  *Enti\Texture = CreateTexture(-1, 256, 256)
  StartDrawing(TextureOutput(*Enti\Texture) )
    For y = 0 To 255
      For x = 0 To 255
        V = Random(255)
        R = V
        B = V
        Box(x, y, 1, 1, RGB(R, V, B) )
      Next
    Next
  StopDrawing()
EndProcedure
Procedure TextureMark(*Enti.ENTI, Mark.S, FrontColor.L, BackColor.L)
  *Enti\Texture = CreateTexture(-1, 256, 256)
  StartDrawing(TextureOutput(*Enti\Texture) )
    Box(0, 0, 256, 256, BackColor)
    DrawingFont(FontID(0) )
    DrawText(0, 0, Mark, FrontColor.L, BackColor.L)
  StopDrawing()
EndProcedure
  ;}
  ;{ Mesh }
Procedure CreateMeshBuffer()
;_______________________________________________________________________________________
; CreateMeshBuffer() crée un buffer vierge qui va contenir la structure fil de fer.
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  Protected *Enti.ENTI
  *Enti = AllocateMemory(SizeOf(ENTI) )
  *Enti\MeshData = AllocateMemory(16)
  PokeL(*Enti\MeshData, AllocateMemory(1 << 17) ) ; Mémoire pour les sommets
  PokeL(*Enti\MeshData + 4, AllocateMemory(1 << 17) ) ; Mémoire pour les faces
  PokeL(*Enti\MeshData + 8, 0) ; Quantité de sommets
  PokeL(*Enti\MeshData + 12, 0) ; Quantité de face
  ProcedureReturn *Enti
 
EndProcedure
Procedure FreeMeshBuffer(*MeshBuffer)
;_______________________________________________________________________________________
; Libère le buffer de structure fil de fer
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯

  FreeMemory(PeekL(*MeshBuffer) )
  FreeMemory(PeekL(*MeshBuffer + 4) )
  FreeMemory(*MeshBuffer)

EndProcedure
Procedure MeshAddTria(*MB, x1.F, y1.F, z1.F, x2.F, y2.F, z2.F, x3.F, y3.F, z3.F)

  Protected Ax.F
  Protected Ay.F
  Protected Az.F
 
  Protected Bx.F
  Protected By.F
  Protected Bz.F
 
  Protected Nx.F
  Protected Ny.F
  Protected Nz.F

  Protected *VertexList
  Protected *FaceList
  Protected VertexQ.L
  Protected FaceQ.L
  Protected *Vertex
  Protected *Face
 
  *VertexList = PeekL(*MB)
  *FaceList = PeekL(*MB + 4)
  VertexQ = PeekL(*MB + 8)
  FaceQ = PeekL(*MB + 12)

  *Vertex = *VertexList + VertexQ * 32
  *Face = *FaceList + FaceQ * 6
   
  Ax = x2 - x1: Ay = y2 - y1: Az = z2 - z1
  Bx = x3 - x1: By = y3 - y1: Bz = z3 - z1   

  Nx = (Ay * Bz) - (By * Az)
  Ny = (Ax * Bz) - (Bx * Az)
  Nz = (Ax * By) - (Bx * Ay)
 
  PokeF(*Vertex, x1)
  PokeF(*Vertex + 4, y1)
  PokeF(*Vertex + 8, z1)
  PokeF(*Vertex + 12, nx)
  PokeF(*Vertex + 16, ny)
  PokeF(*Vertex + 20, nz)
  PokeF(*Vertex + 24, 0.0)
  PokeF(*Vertex + 28, 0.0)
  *Vertex + 32: VertexQ + 1
 
  PokeF(*Vertex, x2)
  PokeF(*Vertex + 4, y2)
  PokeF(*Vertex + 8, z2)
  PokeF(*Vertex + 12, nx)
  PokeF(*Vertex + 16, ny)
  PokeF(*Vertex + 20, nz)
  PokeF(*Vertex + 24, 1.0)
  PokeF(*Vertex + 28, 0.0)
  *Vertex + 32: VertexQ + 1
 
  PokeF(*Vertex, x3)
  PokeF(*Vertex + 4, y3)
  PokeF(*Vertex + 8, z3)
  PokeF(*Vertex + 12, nx)
  PokeF(*Vertex + 16, ny)
  PokeF(*Vertex + 20, nz)
  PokeF(*Vertex + 24, 0.0)
  PokeF(*Vertex + 28, 1.0)
  *Vertex + 32: VertexQ + 1
 
  PokeW(*Face, VertexQ - 4)
  PokeW(*Face + 2, VertexQ - 3)
  PokeW(*Face + 4, VertexQ - 2)
  *Face + 6: FaceQ + 1
 
  PokeW(*Face, VertexQ - 2)
  PokeW(*Face + 2, VertexQ - 3)
  PokeW(*Face + 4, VertexQ - 1)
  *Face + 6: FaceQ + 1
 
  PokeL(*MB + 8, VertexQ)
  PokeL(*MB + 12, FaceQ)

EndProcedure
Procedure MeshAddQuad(*MB, x1.F, y1.F, z1.F, x2.F, y2.F, z2.F, x3.F, y3.F, z3.F, x4.F, y4.F, z4.F)

  Protected Ax.F
  Protected Ay.F
  Protected Az.F
  Protected Bx.F
  Protected By.F
  Protected Bz.F
  Protected Nx.F
  Protected Ny.F
  Protected Nz.F

  Protected *VertexList
  Protected *FaceList
  Protected VertexQ.L
  Protected FaceQ.L
  Protected *Vertex
  Protected *Face
 
  *VertexList = PeekL(*MB)
  *FaceList = PeekL(*MB + 4)
  VertexQ = PeekL(*MB + 8)
  FaceQ = PeekL(*MB + 12)
  *Vertex = *VertexList + VertexQ * 32
  *Face = *FaceList + FaceQ * 6
   
  Ax = x2 - x1: Ay = y2 - y1: Az = z2 - z1
  Bx = x3 - x1: By = y3 - y1: Bz = z3 - z1   

  Nx = (Ay * Bz) - (By * Az)
  Ny = (Ax * Bz) - (Bx * Az)
  Nz = (Ax * By) - (Bx * Ay)
 
  PokeF(*Vertex, x1)
  PokeF(*Vertex + 4, y1)
  PokeF(*Vertex + 8, z1)
  PokeF(*Vertex + 12, nx)
  PokeF(*Vertex + 16, ny)
  PokeF(*Vertex + 20, nz)
  PokeF(*Vertex + 24, 0.0)
  PokeF(*Vertex + 28, 0.0)
  *Vertex + 32: VertexQ + 1
 
  PokeF(*Vertex, x2)
  PokeF(*Vertex + 4, y2)
  PokeF(*Vertex + 8, z2)
  PokeF(*Vertex + 12, nx)
  PokeF(*Vertex + 16, ny)
  PokeF(*Vertex + 20, nz)
  PokeF(*Vertex + 24, 1.0)
  PokeF(*Vertex + 28, 0.0)
  *Vertex + 32: VertexQ + 1
 
  PokeF(*Vertex, x3)
  PokeF(*Vertex + 4, y3)
  PokeF(*Vertex + 8, z3)
  PokeF(*Vertex + 12, nx)
  PokeF(*Vertex + 16, ny)
  PokeF(*Vertex + 20, nz)
  PokeF(*Vertex + 24, 0.0)
  PokeF(*Vertex + 28, 1.0)
  *Vertex + 32: VertexQ + 1
 
  PokeF(*Vertex, x4)
  PokeF(*Vertex + 4, y4)
  PokeF(*Vertex + 8, z4)
  PokeF(*Vertex + 12, nx)
  PokeF(*Vertex + 16, ny)
  PokeF(*Vertex + 20, nz)
  PokeF(*Vertex + 24, 1.0)
  PokeF(*Vertex + 28, 1.0)
  *Vertex + 32: VertexQ + 1

  PokeW(*Face, VertexQ - 4)
  PokeW(*Face + 2, VertexQ - 3)
  PokeW(*Face + 4, VertexQ - 2)
  *Face + 6: FaceQ + 1
 
  PokeW(*Face, VertexQ - 2)
  PokeW(*Face + 2, VertexQ - 3)
  PokeW(*Face + 4, VertexQ - 1)
  *Face + 6: FaceQ + 1
 
  PokeL(*MB + 8, VertexQ)
  PokeL(*MB + 12, FaceQ)

EndProcedure
Procedure MeshAddSquare(*MB, x.F, y.F, z.F, Side.F)

  Protected x1.F
  Protected y1.F
  Protected z1.F
 
  Protected x2.F
  Protected y2.F
  Protected z2.F
 
  Protected x3.F
  Protected y3.F
  Protected z3.F
 
  Protected x4.F
  Protected y4.F
  Protected z4.F

  x * Side
  z * Side

  x1 = x
  y1 = y
  z1 = z
 
  x2 = x
  y2 = y
  z2 = z + Side
 
  x3 = x + Side
  y3 = y
  z3 = z
 
  x4 = x + Side
  y4 = y
  z4 = z + Side
 
  MeshAddQuad(*MB, x1, y1, z1, x2, y2, z2, x3, y3, z3, x4, y4, z4)
 
EndProcedure
Procedure MeshAddBox(*MB, x1.F, y1.F, z1.F, x2.F, y2.F, z2.F)
  MeshAddQuad(*MB, x1, y1, z2, x2, y1, z2, x1, y2, z2, x2, y2, z2)
  MeshAddQuad(*MB, x1, y1, z1, x1, y1, z2, x1, y2, z1, x1, y2, z2)
  MeshAddQuad(*MB, x2, y1, z1, x1, y1, z1, x2, y2, z1, x1, y2, z1)
  MeshAddQuad(*MB, x2, y1, z2, x2, y1, z1, x2, y2, z2, x2, y2, z1)
  MeshAddQuad(*MB, x1, y1, z1, x2, y1, z1, x1, y1, z2, x2, y1, z2)
  MeshAddQuad(*MB, x1, y2, z2, x2, y2, z2, x1, y2, z1, x2, y2, z1)
EndProcedure
Procedure CatchMesh(*Enti.ENTI)
;_______________________________________________________________________________________
; Transfert les données du buffer *MeshBuff dans la nouvelle structure Mesh
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
  *Enti\Mesh = CreateMesh(-1, PeekL(*Enti\MeshData + 8) )
  SetMeshData(*Enti\Mesh, 13, PeekL(*Enti\MeshData), PeekL(*Enti\MeshData + 8) )
  SetMeshData(*Enti\Mesh, 16, PeekL(*Enti\MeshData + 4), PeekL(*Enti\MeshData + 12) )
 
EndProcedure
  ;}
  ;{ Entity }
Procedure CatchEntity(*World.WORLD, *Enti.ENTI, n.L)

  Protected *EntityIndex
   
  CatchMesh(*Enti)
  *Enti\Material = CreateMaterial(-1, TextureID(*Enti\Texture) )
  CreateEntity(n, MeshID(*Enti\Mesh), MaterialID(*Enti\Material) )
  *Enti\N = n
 
  *EntityIndex = *World\EntiPtr + (*World\EntiQtt * 4)
  PokeL(*EntityIndex, *Enti)
  *World\EntiQtt + 1 
 
EndProcedure
Procedure EntiBalise(*World.WORLD, n.L)

  Protected *Enti.ENTI
   
  *Enti = CreateMeshBuffer()
  MeshAddBox(*Enti\MeshData, 0.0, 0.0, 0.0, 10.0, 10.0, 10.0)
  MeshAddBox(*Enti\MeshData, 2.0, -10.0, 2.0, 8.0, 20.0, 8.0)
  TextureMonochrom(*Enti, #Blue)
  CatchEntity(*World, *Enti, n)
 
EndProcedure
Procedure EntiBuilding(*World.WORLD, n.L, x.F, y.F, z.F, Side.F, LevelHeight.F, LastLevel.L)

  Protected *Enti.ENTI
  Protected Height.F
  Protected i.L
   
  Height = LevelHeight * (LastLevel + 1.0)
  *Enti = CreateMeshBuffer()
  For i = 0 To LastLevel
    MeshAddBox(*Enti\MeshData, x, y + (LevelHeight * i), z, x + Side, y + 0.15 + (LevelHeight * i), z + Side)
  Next
 
  MeshAddBox(*Enti\MeshData, x, y, z, x + 0.20, y + Height, z + 0.20)
  MeshAddBox(*Enti\MeshData, x + Side, y, z, x + 0.20 + Side, y + Height, z + 0.20)
  MeshAddBox(*Enti\MeshData, x, y, z + Side, x + 0.20, y + Height, z + 0.20 + Side)
  MeshAddBox(*Enti\MeshData, x + Side, y, z + Side, x + 0.20 + Side, y + Height, z + 0.20 + Side)
  TextureLafarge(*Enti)
  CatchEntity(*World, *Enti, n)
 
EndProcedure
Procedure EntiMapRandom(n.L, w.L, d.L, Altitude.L)

  Protected *MeshBuff
  Protected x.F
  Protected y.F
  Protected z.F

  Protected ix.L
  Protected iz.L

  Protected i1y.F
  Protected i2y.F
  Protected i3y.F
  Protected i4y.F
 
  Protected Dist.F
  Protected dx.F
  Protected dz.F
 
;  *MeshBuff = CreateMeshBuffer()
 
  Global Dim Alt.F(w, d)
  For ix = 0 To w
    For iz = 0 To d
      dx = (ix - w / 2)
      dz = (iz - d / 2)
      Dist = (dx * dx) + (dz * dz)
      Alt(ix, iz) = Sin(Dist / 64.0) * Altitude + Random(10)
    Next
  Next
 
  For ix = 0 To w - 1
    For iz = 0 To d - 1
      x = ix * 10.0
      z = iz * 10.0
      i1y = Alt(ix, iz + 1)
      i2y = Alt(ix + 1, iz + 1)
      i3y = Alt(ix, iz)
      i4y = Alt(ix + 1, iz)
      MeshAddQuad(*MeshBuff, x, i1y, z, x + 10.0, i2y, z, x, i3y, z - 10.0, x + 10.0, i4y, z - 10.0)
    Next
  Next     
;  CatchMesh(0, *MeshBuff)
  TextureGrass(0)
  CreateEntity(n, MeshID(0), MaterialID(0) )
 
EndProcedure
Procedure EntiMapSquarePlain(*World.WORLD, n.L, MapWidth.F, MapDepth.F, Altitude.F, TileSide.F)

  Protected *Enti.ENTI
 
  Protected ixMax.L
  Protected izMax.L
 
  Protected ix.L
  Protected iz.L
   
  *Enti = CreateMeshBuffer()
  TextureGrass(*Enti)
;  TextureMark(*Enti, "SOL", #White, #Black)
 
  ixMax = Int(MapWidth / TileSide) - 1
  izMax = Int(MapDepth / TileSide) - 1
 
  For ix = 0 To ixMax
    For iz = 0 To izMax
   
      MeshAddSquare(*Enti\MeshData, ix, Altitude, iz, TileSide)
     
    Next
  Next
 
  CatchEntity(*World, *Enti, n)
 
EndProcedure
Procedure geometry()

EndProcedure
Procedure Metre()

EndProcedure
Procedure Tank()

EndProcedure
  ;}

;}

;_______________________________________________________________________________________
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯

  ; START
 
  Define *World.WORLD
  Define i.L
 
  *World = InitWorld(16)
 
  EntiMapSquarePlain(*World, 2, 320.0, 320.0, 0.0, 10.0)
  For i = 0 To 19
    EntiBuilding(*World, i + 3, Random(31) * 10.0, 0.0, Random(31) * 10.0, 10.0, 2.5, 1 + Random(9) )
  Next
  WorldMenu(*World)
 
  ; END
;_______________________________________________________________________________________
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯