Achtung, die Engine3D.dll muss sich im Ausführungsverzeichnis befinden.
Grafische Konfiguration mit rechter Maustaste..
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
;_______________________________________________________________________________________
;¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
