Sources PureBasic
Sources PureBasicConsultez toutes les sources
Nombre d'auteurs : 41, nombre de sources : 88, dernière mise à jour : 13 août 2011
Sommaire→3D
Voici le contenu de l'archive :
Sélectionnez
;********************************************************************
;- OPENGL INCLUDES
;********************************************************************
IncludeFile "glimp.pbi" ; GL imports
IncludeFile "gl.pbi" ; GL constants up to OpenGL 1.1
IncludeFile "glext.pbi" ; GL constants up to OpenGL 4.1
IncludeFile "wglext.pbi" ; GL constants for Windows-only extensionsCréé le 6 mars 2011 par Luis
L'archive contient le code source des 30 premières leçons de NeHe.
Pour vous donner un aperçu des codes, voici la première leçon.
Les commentaires sont en anglais, nous cherchons des volontaires pour proposer une traduction.
Le fichier OpenGL.pbi est inclu dans l'archive, et vous pouvez également le trouver dans votre répertoire PureBasic
/Examples/Sources - Advanced/OpenGL Cube
Sélectionnez
;NeHe's OpenGL Framework (Lesson 1)
;http://nehe.gamedev.net
;Credits: Nico Gruener, Dreglor, traumatic
;Author: hagibaba
;Date: 3 Jan 2007
;Note: up-to-date with PB v4.02 (Windows)
;Section for standard constants, structures, macros and declarations
XIncludeFile "OpenGL.pbi" ;include the gl.h constants
;wingdi.h constants
#DM_BITSPERPEL=$40000
#DM_PELSWIDTH=$80000
#DM_PELSHEIGHT=$100000
;winuser.h constants
#CDS_FULLSCREEN=4
#DISP_CHANGE_SUCCESSFUL=0
#SC_MONITORPOWER=$F170
Procedure.w LoWord(value.l) ;windef.h macro
ProcedureReturn (value & $FFFF)
EndProcedure
Procedure.w HiWord(value.l) ;windef.h macro
ProcedureReturn ((value >> 16) & $FFFF)
EndProcedure
Import "glu32.lib"
gluPerspective(fovy.d,aspect.d,zNear.d,zFar.d) ;sets up a perspective projection matrix
EndImport
Import "opengl32.lib"
glClearDepth(depth.d) ;specifies the clear value for the depth buffer
EndImport
;Start of Lesson 1
Global hDC.l ;Private GDI Device Context
Global hRC.l ;Permanent Rendering Context
Global hWnd.l ;Holds Our Window Handle
Global hInstance.l ;Holds The Instance Of The Application
Global Dim keys.b(256) ;Array Used For The Keyboard Routine
Global active.b=#True ;Window Active Flag Set To TRUE By Default
Global fullscreen.b=#True ;Fullscreen Flag Set To Fullscreen Mode By Default
Declare.l WndProc(hWnd.l,uMsg.l,wParam.l,lParam.l) ;Declaration For WndProc
Procedure ReSizeGLScene(width.l,height.l) ;Resize And Initialize The GL Window
If height=0 : height=1 : EndIf ;Prevent A Divide By Zero Error
glViewport_(0,0,width,height) ;Reset The Current Viewport
glMatrixMode_(#GL_PROJECTION) ;Select The Projection Matrix
glLoadIdentity_() ;Reset The Projection Matrix
gluPerspective(45.0,Abs(width/height),0.1,100.0) ;Calculate The Aspect Ratio Of The Window
glMatrixMode_(#GL_MODELVIEW) ;Select The Modelview Matrix
glLoadIdentity_() ;Reset The Modelview Matrix
EndProcedure
Procedure.l InitGL() ;All Setup For OpenGL Goes Here
glShadeModel_(#GL_SMOOTH) ;Enable Smooth Shading
glClearColor_(0.0,0.0,0.0,0.5) ;Black Background
glClearDepth(1.0) ;Depth Buffer Setup
glEnable_(#GL_DEPTH_TEST) ;Enables Depth Testing
glDepthFunc_(#GL_LEQUAL) ;The Type Of Depth Testing To Do
glHint_(#GL_PERSPECTIVE_CORRECTION_HINT,#GL_NICEST) ;Really Nice Perspective Calculations
ProcedureReturn #True ;Initialization Went OK
EndProcedure
Procedure.l DrawGLScene() ;Here's Where We Do All The Drawing
glClear_(#GL_COLOR_BUFFER_BIT | #GL_DEPTH_BUFFER_BIT) ;Clear Screen And Depth Buffer
glLoadIdentity_() ;Reset The Current Modelview Matrix
ProcedureReturn #True ;Everything Went OK
EndProcedure
Procedure KillGLWindow() ;Properly Kill The Window
If fullscreen ;Are We In Fullscreen Mode?
ChangeDisplaySettings_(#Null,0) ;If So Switch Back To The Desktop
ShowCursor_(#True) ;Show Mouse Pointer
EndIf
If hRC ;Do We Have A Rendering Context?
If wglMakeCurrent_(#Null,#Null)=0 ;Are We Able To Release The DC And RC Contexts?
MessageBox_(#Null,"Release Of DC And RC Failed.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
EndIf
If wglDeleteContext_(hRC)=0 ;Are We Able To Delete The RC?
MessageBox_(#Null,"Release Rendering Context Failed.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
EndIf
hRC=#Null ;Set RC To NULL
EndIf
If hDC And ReleaseDC_(hWnd,hDC)=0 ;Are We Able To Release The DC
MessageBox_(#Null,"Release Device Context Failed.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
hDC=#Null ;Set DC To NULL
EndIf
If hWnd And DestroyWindow_(hWnd)=0 ;Are We Able To Destroy The Window?
MessageBox_(#Null,"Could Not Release hWnd.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
hWnd=#Null ;Set hWnd To NULL
EndIf
If UnregisterClass_("OpenGL",hInstance)=0 ;Are We Able To Unregister Class
MessageBox_(#Null,"Could Not Unregister Class.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
hInstance=#Null ;Set hInstance To NULL
EndIf
EndProcedure
;This Code Creates Our OpenGL Window. Parameters Are:
;title - Title To Appear At The Top Of The Window
;width - Width Of The GL Window Or Fullscreen Mode
;height - Height Of The GL Window Or Fullscreen Mode
;bits - Number Of Bits To Use For Color (8/16/24/32)
;fullscreenflag - Use Fullscreen Mode (TRUE) Or Windowed Mode (FALSE)
Procedure.b CreateGLWindow(title.s,width.l,height.l,bits.l,fullscreenflag.b)
Protected PixelFormat.l ;Holds The Results After Searching For A Match
Protected wc.WNDCLASS ;Windows Class Structure
Protected dwExStyle.l ;Window Extended Style
Protected dwStyle.l ;Window Style
Protected WindowRect.RECT ;Grabs Rectangle Upper Left / Lower Right Values
Protected wpos.POINT ;Window position
WindowRect\left=0 ;Set Left Value To 0
WindowRect\right=width ;Set Right Value To Requested Width
WindowRect\top=0 ;Set Top Value To 0
WindowRect\bottom=height ;Set Bottom Value To Requested Height
fullscreen=fullscreenflag ;Set The Global Fullscreen Flag
hInstance=GetModuleHandle_(#Null) ;Grab An Instance For Our Window
wc\style=#CS_HREDRAW | #CS_VREDRAW | #CS_OWNDC ;Redraw On Size, And Own DC For Window
wc\lpfnWndProc=@WndProc() ;WndProc Handles Messages
wc\cbClsExtra=0 ;No Extra Window Data
wc\cbWndExtra=0 ;No Extra Window Data
wc\hInstance=hInstance ;Set The Instance
wc\hIcon=LoadIcon_(#Null,#IDI_WINLOGO) ;Load The Default Icon
wc\hCursor=LoadCursor_(#Null,#IDC_ARROW) ;Load The Arrow Pointer
wc\hbrBackground=#Null ;No Background Required For GL
wc\lpszMenuName=#Null ;We Don't Want A Menu
wc\lpszClassName=@"OpenGL" ;Set The Class Name
If RegisterClass_(wc)=0 ;Attempt To Register The Window Class
MessageBox_(#Null,"Failed To Register The Window Class.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
If fullscreen ;Attempt Fullscreen Mode?
Protected dmScreenSettings.DEVMODE ;Device Mode
dmScreenSettings\dmSize=SizeOf(DEVMODE) ;Size Of The Devmode Structure
dmScreenSettings\dmFields=#DM_BITSPERPEL | #DM_PELSWIDTH | #DM_PELSHEIGHT ;bit flags to specify the members of DEVMODE that were initialized
dmScreenSettings\dmBitsPerPel=bits ;Selected Bits Per Pixel
dmScreenSettings\dmPelsWidth=width ;Selected Screen Width in pixels
dmScreenSettings\dmPelsHeight=height ;Selected Screen Height in pixels
;Try To Set Selected Mode And Get Results. Note: CDS_FULLSCREEN Gets Rid Of Start Bar
If ChangeDisplaySettings_(dmScreenSettings,#CDS_FULLSCREEN)<>#DISP_CHANGE_SUCCESSFUL
;If The Mode Fails, Offer Two Options. Quit Or Use Windowed Mode
If MessageBox_(#Null,"The Requested Fullscreen Mode Is Not Supported By"+Chr(10)+"Your Video Card. Use Windowed Mode Instead?","NeHe GL",#MB_YESNO | #MB_ICONEXCLAMATION)=#IDYES
fullscreen=#False ;Windowed Mode Selected. Fullscreen = FALSE
Else
;Pop Up A Message Box Letting User Know The Program Is Closing
MessageBox_(#Null,"Program Will Now Close.","ERROR",#MB_OK | #MB_ICONSTOP)
ProcedureReturn #False
EndIf
EndIf
EndIf
If fullscreen ;Are We Still In Fullscreen Mode?
dwExStyle=#WS_EX_APPWINDOW ;Window Extended Style
dwStyle=#WS_POPUP ;Windows Style
ShowCursor_(#False) ;Hide Mouse Pointer
Else
dwExStyle=#WS_EX_APPWINDOW | #WS_EX_WINDOWEDGE ;Window Extended Style
dwStyle=#WS_OVERLAPPEDWINDOW ;Windows Style
EndIf
AdjustWindowRectEx_(WindowRect,dwStyle,#False,dwExStyle) ;Adjust Window To True Requested Size
If fullscreen=0 ;if not fullscreen mode calculate screen centered window
wpos\x=(GetSystemMetrics_(#SM_CXSCREEN)/2)-((WindowRect\right-WindowRect\left)/2)
wpos\y=(GetSystemMetrics_(#SM_CYSCREEN)/2)-((WindowRect\bottom-WindowRect\top)/2)
EndIf
;CreateWindowEx_(Extended Window Style, Class Name, Window Title, Window Style, Window X Position, Window Y Position, Width, Height, No Parent Window, No Menu, Instance, No Creation Data)
hWnd=CreateWindowEx_(dwExStyle,"OpenGL",title,dwStyle | #WS_CLIPSIBLINGS | #WS_CLIPCHILDREN,wpos\x,wpos\y,WindowRect\right-WindowRect\left,WindowRect\bottom-WindowRect\top,#Null,#Null,hInstance,#Null)
If hWnd=0
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Window Creation Error.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
Protected pfd.PIXELFORMATDESCRIPTOR ;pfd Tells Windows How We Want Things To Be
pfd\nSize=SizeOf(PIXELFORMATDESCRIPTOR) ;Size Of This Structure
pfd\nVersion=1 ;Version Number
pfd\dwFlags=#PFD_SUPPORT_OPENGL | #PFD_DOUBLEBUFFER | #PFD_DRAW_TO_WINDOW ;Format Must Support Window, OpenGL, Double Buffering
pfd\iPixelType=#PFD_TYPE_RGBA ;Request An RGBA Format
pfd\cColorBits=bits ;Select Our Color Depth
pfd\cRedBits=0 ;Color Bits Ignored
pfd\cRedShift=0
pfd\cGreenBits=0
pfd\cGreenShift=0
pfd\cBlueBits=0
pfd\cBlueShift=0
pfd\cAlphaBits=0 ;No Alpha Buffer
pfd\cAlphaShift=0 ;Shift Bit Ignored
pfd\cAccumBits=0 ;No Accumulation Buffer
pfd\cAccumRedBits=0 ;Accumulation Bits Ignored
pfd\cAccumGreenBits=0
pfd\cAccumBlueBits=0
pfd\cAccumAlphaBits=0
pfd\cDepthBits=16 ;16Bit Z-Buffer (Depth Buffer)
pfd\cStencilBits=0 ;No Stencil Buffer
pfd\cAuxBuffers=0 ;No Auxiliary Buffer
pfd\iLayerType=#PFD_MAIN_PLANE ;Main Drawing Layer
pfd\bReserved=0 ;Reserved
pfd\dwLayerMask=0 ;Layer Masks Ignored
pfd\dwVisibleMask=0
pfd\dwDamageMask=0
hDC=GetDC_(hWnd)
If hDC=0 ;Did We Get A Device Context?
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Can't Create A GL Device Context.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
PixelFormat=ChoosePixelFormat_(hDC,pfd)
If PixelFormat=0 ;Did Windows Find A Matching Pixel Format?
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Can't Find A Suitable PixelFormat.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
If SetPixelFormat_(hDC,PixelFormat,pfd)=0 ;Are We Able To Set The Pixel Format?
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Can't Set The PixelFormat.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
hRC=wglCreateContext_(hDC)
If hRC=0 ;Are We Able To Get A Rendering Context?
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Can't Create A GL Rendering Context.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
If wglMakeCurrent_(hDC,hRC)=0 ;Try To Activate The Rendering Context
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Can't Activate The GL Rendering Context.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
ShowWindow_(hWnd,#SW_SHOW) ;Show The Window
SetForegroundWindow_(hWnd) ;Slightly Higher Priority
SetFocus_(hWnd) ;Sets Keyboard Focus To The Window
ReSizeGLScene(width,height) ;Set Up Our Perspective GL Screen
If InitGL()=0 ;Initialize Our Newly Created GL Window
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Initialization Failed.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
ProcedureReturn #True ;Success
EndProcedure
Procedure.l WndProc(hWnd.l,uMsg.l,wParam.l,lParam.l)
Select uMsg ;Check For Windows Messages
Case #WM_ACTIVATE ;Watch For Window Activate Message
If HiWord(wParam)=0 ;Check Minimization State
active=#True ;Program Is Active
Else
active=#False ;Program Is No Longer Active
EndIf
ProcedureReturn 0 ;Return To The Message Loop
Case #WM_SYSCOMMAND ;Intercept System Commands
Select wParam ;Check System Calls
Case #SC_SCREENSAVE ;Screensaver Trying To Start?
ProcedureReturn 0 ;Prevent From Happening
Case #SC_MONITORPOWER ;Monitor Trying To Enter Powersave?
ProcedureReturn 0 ;Prevent From Happening
EndSelect
Case #WM_CLOSE ;Did We Receive A Close Message?
PostQuitMessage_(0) ;Send A Quit Message
ProcedureReturn 0 ;Jump Back
Case #WM_KEYDOWN ;Is A Key Being Held Down?
keys(wParam)=#True ;If So, Mark It As TRUE
ProcedureReturn 0 ;Jump Back
Case #WM_KEYUP ;Has A Key Been Released?
keys(wParam)=#False ;If So, Mark It As FALSE
ProcedureReturn 0 ;Jump Back
Case #WM_SIZE ;Resize The OpenGL Window
ReSizeGLScene(LoWord(lParam),HiWord(lParam)) ;LoWord=Width, HiWord=Height
ProcedureReturn 0 ;Jump Back
EndSelect
;Pass All Unhandled Messages To DefWindowProc
ProcedureReturn DefWindowProc_(hWnd,uMsg,wParam,lParam)
EndProcedure
Procedure.l WinMain() ;Main Program
Protected msg.MSG ;Windows Message Structure
Protected done.b ;Bool Variable To Exit Loop
;Ask The User Which Screen Mode They Prefer
If MessageBox_(#Null,"Would You Like To Run In Fullscreen Mode?","Start FullScreen?",#MB_YESNO | #MB_ICONQUESTION)=#IDNO
fullscreen=#False ;Windowed Mode
EndIf
If CreateGLWindow("NeHe's OpenGL Framework",640,480,16,fullscreen)=0 ;Create The Window
ProcedureReturn 0 ;Quit If Window Was Not Created
EndIf
While done=#False ;Loop That Runs While done=FALSE
If PeekMessage_(msg,#Null,0,0,#PM_REMOVE) ;Is There A Message Waiting?
If msg\message=#WM_QUIT ;Have We Received A Quit Message?
done=#True ;If So done=TRUE
Else ;If Not, Deal With Window Messages
TranslateMessage_(msg) ;Translate The Message
DispatchMessage_(msg) ;Dispatch The Message
EndIf
Else ;If There Are No Messages
;Draw The Scene. Watch For ESC Key And Quit Messages From DrawGLScene()
If (active And DrawGLScene()=0) Or keys(#VK_ESCAPE) ;Active? Was There A Quit Received?
done=#True ;ESC or DrawGLScene Signalled A Quit
Else ;Not Time To Quit, Update Screen
SwapBuffers_(hDC) ;Swap Buffers (Double Buffering)
EndIf
If keys(#VK_F1) ;Is F1 Being Pressed?
keys(#VK_F1)=#False ;If So Make Key FALSE
KillGLWindow() ;Kill Our Current Window
fullscreen=~fullscreen & 1 ;Toggle Fullscreen / Windowed Mode
;Recreate Our OpenGL Window
If CreateGLWindow("NeHe's OpenGL Framework",640,480,16,fullscreen)=0
ProcedureReturn 0 ;Quit If Window Was Not Created
EndIf
EndIf
EndIf
Wend
;Shutdown
KillGLWindow() ;Kill The Window
End ;Exit The Program
EndProcedure
WinMain() ;run the main programCréé le 20 février 2008 par hagibaba
Code mis à jour pour la version 4.60.
Sélectionnez
;PB 4.60 le 13/04/11
InitEngine3D()
InitSprite()
InitKeyboard()
;Pour enregistrer au format PNG
UsePNGImageEncoder()
ExamineDesktops()
OpenScreen(DesktopWidth(0), DesktopHeight(0), DesktopDepth(0), "Tutoriel 3D")
;Pour charger une texture, mesh, entity , etc, indiquer le chemin où se trouvent ces médias
Add3DArchive("/", #PB_3DArchive_FileSystem)
Structure s_Mesh
x.f
y.f
z.f
nx.f
ny.f
nz.f
Co.l
EndStructure
Define Triangle.s_Mesh
;Création d'un mesh
#Mesh = 0
CreateMesh(#Mesh, 200)
AddSubMesh()
With Triangle
For i= 0 To 2
Read.f \x : Read.f \y : Read.f \z : Read.l \Co
AddMeshVertex(\x, \y, \z)
MeshVertexColor(\Co)
Next i
Read.w t1 : Read.w t2 : Read.w t3
AddMeshFace(t1, t2, t3)
EndWith
FinishMesh()
;Création d'une texture
#Texture = 0
CreateImage(#Texture, 64, 64)
;Remplissage de la texture en blanc pour visualiser les couleurs des sommets
StartDrawing(ImageOutput(#Texture))
Box(0,0, ImageWidth(#Texture), ImageHeight(#Texture), RGB(255, 255, 255))
StopDrawing()
;Enregistre l'image dans le même répertoire que le code source
Fichier$="TextureDVP.PNG"
SaveImage(#Texture, Fichier$, #PB_ImagePlugin_PNG)
;Maintenant on peut charger notre texture
LoadTexture(#Texture, Fichier$)
;Création matière
#Matiere = 0
CreateMaterial(#Matiere, TextureID(#Texture))
MaterialAmbientColor(#Matiere, #PB_Material_AmbientColors)
;Création entity
#Entity = 0
CreateEntity(#Entity, MeshID(#Mesh), MaterialID(#Matiere))
;Ajoute une caméra , c'est indispensable pour voir quelque chose
#Camera = 0
CreateCamera(#Camera, 25, 25, 50, 50) ; Création d'une caméra
CameraBackColor(#Camera, $FF0000) ; Couleur de fond bleue
CameraLocate(#Camera,0,0,500) ; Position de la caméra
CameraLookAt(#Camera, EntityX(#Entity), EntityY(#Entity), EntityZ(#Entity)) ; Oriente la caméra vers l'entity
Repeat
ExamineKeyboard()
RenderWorld() ; Affiche le monde 3D
FlipBuffers()
Until KeyboardPushed(#PB_Key_All)
DataSection
SommetsTriangles:
Data.f 0.0,100.0,0.0 ; Position sommet 0
Data.l $FF0000 ; Couleur sommet 0
Data.f 200.0,-100.0,0.0 ; Position sommet 1
Data.l $00FF00 ; Couleur sommet 1
Data.f -200.0,-100.0,0.0 ; Position sommet 2
Data.l $0000FF ; Couleur sommet 2
IndexTriangles:
Data.w 2,1,0 ; sommets 2, 1 and 0 forment un triangle
EndDataSectionMis à jour le 13 avril 2011 par Comtois
Sous windows, utilisez le sous-système directx9. Pour cela allez dans les options du compilateur, et dans le champ 'bibliothèque sous-système' saisissez directx9.
Sélectionnez
;PB 4.30 le 10/01/09
InitEngine3D()
InitSprite()
InitKeyboard()
;Pour enregistrer au format PNG
UsePNGImageEncoder()
ExamineDesktops()
OpenScreen(DesktopWidth(0), DesktopHeight(0), DesktopDepth(0), "Tutoriel 3D")
;Pour charger une texture, mesh, entity , etc, indiquer le chemin où se trouvent ces médias
Add3DArchive("/", #PB_3DArchive_FileSystem)
Structure s_Sommet
Position.f[3]
Couleur.l
EndStructure
Structure s_Triangle
Index.w[3]
EndStructure
Dim Sommets.s_Sommet(2)
Dim Triangles.s_Triangle(0)
;Sommet 0 position et couleur
Sommets(0)\Position[0] = 0.0 : Sommets(0)\Position[1] = 100.0 : Sommets(0)\Position[2] = 0.0
Sommets(0)\Couleur = $FF0000
;Sommet 1 position et couleur
Sommets(1)\Position[0] = 200.0 : Sommets(1)\Position[1] = -100.0 : Sommets(1)\Position[2] = 0.0
Sommets(1)\Couleur = $00FF00
;Sommet 2 position et couleur
Sommets(2)\Position[0] = -200.0 : Sommets(2)\Position[1] = -100.0 : Sommets(2)\Position[2] = 0.0
Sommets(2)\Couleur = $0000FF
; Définition du triangle
Triangles(0)\Index[0] = 2 : Triangles(0)\Index[1] = 1 : Triangles(0)\Index[2] = 0
;Création d'un mesh
#Mesh = 0
CreateMesh(#Mesh, 200)
;Définition des sommets
SetMeshData(#Mesh, #PB_Mesh_Vertex | #PB_Mesh_Color , @Sommets(), 3) ; Indiquez ici le nombre de sommets
;Définition des triangles
SetMeshData(#Mesh, #PB_Mesh_Face, @Triangles(), 1) ; indiquez ici le nombre de triangles
;Création d'une texture
#Texture = 0
CreateImage(#Texture, 64, 64)
;Remplissage de la texture en blanc pour visualiser les couleurs des sommets
StartDrawing(ImageOutput(#Texture))
Box(0,0, ImageWidth(#Texture), ImageHeight(#Texture), RGB(255, 255, 255))
StopDrawing()
;Enregistre l'image dans le même répertoire que le code source
Fichier$="TextureDVP.PNG"
SaveImage(#Texture, Fichier$, #PB_ImagePlugin_PNG)
;Maintenant on peut charger notre texture
LoadTexture(#Texture, Fichier$)
;Création d'une matière
#Matiere = 0
CreateMaterial(#Matiere, TextureID(#Texture))
MaterialAmbientColor(#Matiere, #PB_Material_AmbientColors)
;Création entity
#Entity = 0
CreateEntity(#Entity, MeshID(#Mesh), MaterialID(#Matiere))
;Ajoute une caméra , c'est indispensable pour voir quelque chose
#Camera = 0
CreateCamera(#Camera, 25, 25, 50, 50) ; Création d'une caméra
CameraBackColor(#Camera, $FF0000) ; Couleur de fond bleue
CameraLocate(#Camera,0,0,500) ; Positionne la caméra
CameraLookAt(#Camera, EntityX(#Entity), EntityY(#Entity), EntityZ(#Entity)) ; Oriente la caméra vers l'entity
Repeat
ClearScreen(0)
ExamineKeyboard()
RenderWorld() ; Affiche le monde 3D
FlipBuffers()
Until KeyboardPushed(#PB_Key_All)Mis à jour le 10 janvier 2009 par Comtois
Sous windows, utilisez le sous-système directx9. Pour cela allez dans les options du compilateur, et dans le champ 'bibliothèque sous-système' saisissez directx9.
Sélectionnez
;PB 4.30 le 10/01/09
InitEngine3D()
InitSprite()
InitKeyboard()
;Pour enregistrer au format PNG
UsePNGImageEncoder()
ExamineDesktops()
OpenScreen(DesktopWidth(0), DesktopHeight(0), DesktopDepth(0), "Tutoriel 3D")
;Pour charger une texture, mesh, entity , etc, indiquer le chemin où se trouvent ces médias
Add3DArchive("/", #PB_3DArchive_FileSystem)
Macro RGB_INVERSE(Rouge,Vert,Bleu)
Rouge << 16 + Vert << 8 + Bleu
EndMacro
Structure s_Sommet
px.f
py.f
pz.f
nx.f
ny.f
nz.f
co.l
u.f
v.f
EndStructure
Structure s_Triangle
f1.w
f2.w
f3.w
EndStructure
Structure s_Mesh
No.l
*VBuffer.s_Sommet
*Ibuffer.s_Triangle
EndStructure
Global Angle.f,Pas.f, CameraMode.l
Global *VBuffer,*IBuffer
Define.s_Mesh CubeMesh
Procedure CreateMeshCube(*Mesh.s_Mesh)
*Mesh\VBuffer=AllocateMemory(SizeOf(s_Sommet) * 24)
*Mesh\IBuffer=AllocateMemory(SizeOf(s_Triangle) * 12)
CopyMemory(?Sommets, *Mesh\VBuffer, SizeOf(s_Sommet) * 24)
CopyMemory(?Triangles, *Mesh\IBuffer, SizeOf(s_Triangle) * 12)
If CreateMesh(*Mesh\No, 100)
Options = #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color
SetMeshData(*Mesh\No, Options , *Mesh\VBuffer, 24)
SetMeshData(*Mesh\No, #PB_Mesh_Face, *Mesh\IBuffer, 12)
ProcedureReturn 1
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure UpColorCube(*Mesh.s_Mesh, Couleur)
*Mem.s_Sommet = *Mesh\VBuffer
For i = 0 To 3
*Mem\co=Couleur
*Mem + SizeOf(s_Sommet)
Next i
EndProcedure
Procedure DownColorCube(*Mesh.s_Mesh, Couleur)
*Mem.s_Sommet = *Mesh\VBuffer + 4 * SizeOf(s_Sommet)
For i = 0 To 3
*Mem\co=Couleur
*Mem + SizeOf(s_Sommet)
Next i
EndProcedure
Procedure FrontColorCube(*Mesh.s_Mesh, Couleur)
*Mem.s_Sommet = *Mesh\VBuffer + 8 * SizeOf(s_Sommet)
For i = 0 To 3
*Mem\co=Couleur
*Mem + SizeOf(s_Sommet)
Next i
EndProcedure
Procedure BackColorCube(*Mesh.s_Mesh, Couleur)
*Mem.s_Sommet = *Mesh\VBuffer + 12 * SizeOf(s_Sommet)
For i = 0 To 3
*Mem\co=Couleur
*Mem + SizeOf(s_Sommet)
Next i
EndProcedure
Procedure LeftColorCube(*Mesh.s_Mesh, Couleur)
*Mem.s_Sommet = *Mesh\VBuffer + 16 * SizeOf(s_Sommet)
For i = 0 To 3
*Mem\co=Couleur
*Mem + SizeOf(s_Sommet)
Next i
EndProcedure
Procedure RightColorCube(*Mesh.s_Mesh, Couleur)
*Mem.s_Sommet = *Mesh\VBuffer + 20 * SizeOf(s_Sommet)
For i = 0 To 3
*Mem\co=Couleur
*Mem + SizeOf(s_Sommet)
Next i
EndProcedure
Procedure UpDateCube(*Mesh.s_Mesh)
Flag = #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color
SetMeshData(*Mesh\No, Flag , *Mesh\VBuffer, 24)
EndProcedure
;-Mesh
#Mesh = 0
CubeMesh\No = #Mesh
CreateMeshCube(@CubeMesh)
UpColorCube(@CubeMesh, RGB_INVERSE(255,0,0)) ; Change la couleur de la face en haut
DownColorCube(@CubeMesh, RGB_INVERSE(255,255,0)) ; Change la couleur de la face en bas
FrontColorCube(@CubeMesh,RGB_INVERSE(0,255,0)) ; Change la couleur de la face avant
BackColorCube(@CubeMesh, RGB_INVERSE(0,0,255)) ; Change la couleur de la face arrière
LeftColorCube(@CubeMesh, RGB_INVERSE(255,128,0)) ; Change la couleur de la face gauche
RightColorCube(@CubeMesh,RGB_INVERSE(255,255,255)); Change la couleur de la face droite
UpDateCube(@CubeMesh) ; Mise à jour des couleurs, rend le changement effectif
;-Texture
#Texture = 0
CreateImage(#Texture, 128, 128)
;Remplissage de la texture en blanc avec une bordure noire
StartDrawing(ImageOutput(#Texture))
Box(0, 0, 128, 128, 0)
Box(1, 1, 126, 126, $FFFFFF)
StopDrawing()
;Enregistre l'image dans le même répertoire que le code source
Fichier$="TextureDVP.PNG"
SaveImage(#Texture, Fichier$, #PB_ImagePlugin_PNG)
;Maintenant on peut charger notre texture
LoadTexture(#Texture, Fichier$)
;-Matière
#Matiere = 0
CreateMaterial(#Matiere, TextureID(#Texture))
MaterialAmbientColor(#Matiere, #PB_Material_AmbientColors)
;-Entity
#Entity = 0
CreateEntity(#Entity, MeshID(#Mesh), MaterialID(#Matiere))
ScaleEntity(#Entity, 90, 90, 90) ; Agrandi l'entity
;-Camera
#Camera = 0
CreateCamera(#Camera, 0, 0 , 100 , 100)
MoveCamera(#Camera, 0, 0, -400)
CameraLookAt(#Camera, EntityX(#Entity), EntityY(#Entity), EntityZ(#Entity))
;-Light
AmbientColor(RGB(255,255,255))
;Modifier la vitesse de rotation en changeant la valeur de 'pas'
pas = 0.08
Repeat
Angle + Pas
RotateEntity(0,angle,angle/2,-Angle)
If ExamineKeyboard()
If KeyboardReleased(#PB_Key_F1)
CameraMode=1-CameraMode
CameraRenderMode(#Camera, CameraMode)
EndIf
EndIf
RenderWorld()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
DataSection
Sommets:
;Dessus 0 à 3
Data.f -0.5,0.5,-0.5
Data.f 0,1,0
Data.l 0
Data.f 0,0
Data.f 0.5,0.5,-0.5
Data.f 0,1,0
Data.l 0
Data.f 0,1
Data.f 0.5,0.5,0.5
Data.f 0,1,0
Data.l 0
Data.f 1,1
Data.f -0.5,0.5,0.5
Data.f 0,1,0
Data.l 0
Data.f 1,0
;Dessous 4 à 7
Data.f -0.5,-0.5,0.5
Data.f 0,-1,0
Data.l 0
Data.f 0,0
Data.f 0.5,-0.5,0.5
Data.f 0,-1,0
Data.l 0
Data.f 0,1
Data.f 0.5,-0.5,-0.5
Data.f 0,-1,0
Data.l 0
Data.f 1,1
Data.f -0.5,-0.5,-0.5
Data.f 0,-1,0
Data.l 0
Data.f 1,0
;Devant 8 à 11
Data.f -0.5,0.5,0.5
Data.f 0,0,1
Data.l 0
Data.f 0,0
Data.f 0.5,0.5,0.5
Data.f 0,0,1
Data.l 0
Data.f 0,1
Data.f 0.5,-0.5,0.5
Data.f 0,0,1
Data.l 0
Data.f 1,1
Data.f -0.5,-0.5,0.5
Data.f 0,0,1
Data.l 0
Data.f 1,0
;Derrière 12 à 15
Data.f 0.5,0.5,-0.5
Data.f 0,0,-1
Data.l 0
Data.f 0,0
Data.f -0.5,0.5,-0.5
Data.f 0,0,-1
Data.l 0
Data.f 0,1
Data.f -0.5,-0.5,-0.5
Data.f 0,0,-1
Data.l 0
Data.f 1,1
Data.f 0.5,-0.5,-0.5
Data.f 0,0,-1
Data.l 0
Data.f 1,0
;Cote gauche 16 à 19
Data.f -0.5,0.5,-0.5
Data.f -1,0,0
Data.l 0
Data.f 0,0
Data.f -0.5,0.5,0.5
Data.f -1,0,0
Data.l 0
Data.f 0,1
Data.f -0.5,-0.5,0.5
Data.f -1,0,0
Data.l 0
Data.f 1,1
Data.f -0.5,-0.5,-0.5
Data.f -1,0,0
Data.l 0
Data.f 1,0
;Cote droit 20 à 23
Data.f 0.5,0.5,0.5
Data.f 1,0,0
Data.l 0
Data.f 0,0
Data.f 0.5,0.5,-0.5
Data.f 1,0,0
Data.l 0
Data.f 0,1
Data.f 0.5,-0.5,-0.5
Data.f 1,0,0
Data.l 0
Data.f 1,1
Data.f 0.5,-0.5,0.5
Data.f 1,0,0
Data.l 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
EndDataSectionMis à jour le 10 janvier 2009 par Comtois
Sous windows, utilisez le sous-système directx9. Pour cela allez dans les options du compilateur, et dans le champ 'bibliothèque sous-système' saisissez directx9.
Sélectionnez
;PB 4.30 le 10/01/09
InitEngine3D()
InitSprite()
InitKeyboard()
;Pour enregistrer au format PNG
UsePNGImageEncoder()
ExamineDesktops()
OpenScreen(DesktopWidth(0), DesktopHeight(0), DesktopDepth(0), "Tutoriel 3D")
;Pour charger une texture, mesh, entity , etc, indiquer le chemin où se trouvent ces médias
Add3DArchive("/", #PB_3DArchive_FileSystem)
Global Angle.f,Pas.f, CameraMode.l
Define.l Options, i
Define.f Da, Da2
#Tiers = 1.0/3.0
;-Mesh
#Mesh = 0
CreateMesh(#Mesh, 100)
Options = #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color
SetMeshData(#Mesh, Options , ?Sommets, 24)
SetMeshData(#Mesh, #PB_Mesh_Face, ?Triangles, 12)
Macro Cercle(x, y, r)
DrawingMode(#PB_2DDrawing_Outlined)
Circle(x + 1, y + 1, r + 1, 0)
DrawingMode(#PB_2DDrawing_Default)
Circle(x, y, r, 0)
EndMacro
;-Textures
#Texture = 0
CreateImage(#Texture, 256, 256)
;Remplissage de la texture en blanc
StartDrawing(ImageOutput(#Texture))
Box(0, 0, ImageWidth(#Texture), ImageHeight(#Texture), $FFFFFF)
Da = ImageWidth(#Texture)/6.0 ; 1/6 de la texture
Da2 = Da/2.0
; 1
Cercle(3 * Da, Da, 7)
; 2
For i = -1 To 1 Step 2
Cercle(3 * Da + i * Da2, 3 * Da - i * Da2, 7)
Next i
; 3
For i = -1 To 1
Cercle(Da + i * Da2, 3 * Da - i * Da2, 7)
Next i
; 4
For i = -1 To 1 Step 2
Cercle(5 * Da + i * Da2, 3 * Da - Da2, 7)
Cercle(5 * Da + i * Da2, 3 * Da + Da2, 7)
Next i
; 5
For i = -1 To 1 Step 2
Cercle(Da + i * Da2, Da - Da2, 7)
Cercle(Da + i * Da2, Da + Da2, 7)
Next i
Cercle(Da, Da, 7)
; 6
For i = -1 To 1
Cercle((3 * Da + i * Da2), (5 * Da - Da2), 7)
Cercle((3 * Da + i * Da2), (5 * Da + Da2), 7)
Next i
StopDrawing()
;Enregistre l'image dans le même répertoire que le code source
Fichier$="TextureDVP.PNG"
SaveImage(#Texture, Fichier$, #PB_ImagePlugin_PNG)
;Maintenant on peut charger notre texture
LoadTexture(#Texture, Fichier$)
;-Matière
#Matiere = 0
CreateMaterial(#Matiere, TextureID(#Texture))
;-Entity
#Entity = 0
CreateEntity(#Entity, MeshID(#Mesh), MaterialID(#Matiere))
ScaleEntity(#Entity, 90, 90, 90) ; Agrandi l'entity
;-Camera
#Camera = 0
CreateCamera(#Camera, 0, 0 , 100 , 100)
MoveCamera(#Camera, 0, 0, -400)
CameraLookAt(#Camera, EntityX(#Entity), EntityY(#Entity), EntityZ(#Entity))
;-Light
AmbientColor(RGB(55,55,55)) ; Réduit la lumière ambiante pour mieux voir les lumières
#LightRouge = 0 : CreateLight(#LightRouge,RGB(255, 255, 255), 0, 500, 0)
#LightBleue = 1 : CreateLight(#LightBleue,RGB(255, 255, 255), 0, -500, 0)
#LightVerte = 2 : CreateLight(#LightVerte,RGB(255, 255, 255), 500, 0, 0)
;Modifier la vitesse de rotation en changeant la valeur de 'pas'
pas = 0.08
Repeat
Angle + Pas
RotateEntity(0,angle,angle/2,-Angle)
If ExamineKeyboard()
If KeyboardReleased(#PB_Key_F1)
CameraMode=1-CameraMode
CameraRenderMode(#Camera, CameraMode)
EndIf
EndIf
RenderWorld()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
;{ Définition du cube
DataSection
Sommets:
;Dessus 0 à 3
Data.f -0.5,0.5,-0.5
Data.f 0,1,0
Data.l 0
Data.f 0, 0
Data.f 0.5,0.5,-0.5
Data.f 0,1,0
Data.l 0
Data.f #Tiers, 0
Data.f 0.5,0.5,0.5
Data.f 0,1,0
Data.l 0
Data.f #Tiers, #Tiers
Data.f -0.5,0.5,0.5
Data.f 0,1,0
Data.l 0
Data.f 0, #Tiers
;Dessous 4 à 7
Data.f -0.5,-0.5,0.5
Data.f 0,-1,0
Data.l 0
Data.f #Tiers, #Tiers
Data.f 0.5,-0.5,0.5
Data.f 0,-1,0
Data.l 0
Data.f #Tiers*2,#Tiers
Data.f 0.5,-0.5,-0.5
Data.f 0,-1,0
Data.l 0
Data.f #Tiers*2,#Tiers*2
Data.f -0.5,-0.5,-0.5
Data.f 0,-1,0
Data.l 0
Data.f #Tiers,#Tiers*2
;Devant 8 à 11
Data.f -0.5,0.5,0.5
Data.f 0,0,1
Data.l 0
Data.f #Tiers, 0
Data.f 0.5,0.5,0.5
Data.f 0,0,1
Data.l 0
Data.f #Tiers*2,0
Data.f 0.5,-0.5,0.5
Data.f 0,0,1
Data.l 0
Data.f #Tiers*2,#Tiers
Data.f -0.5,-0.5,0.5
Data.f 0,0,1
Data.l 0
Data.f #Tiers,#Tiers
;Derrière 12 à 15
Data.f 0.5,0.5,-0.5
Data.f 0,0,-1
Data.l 0
Data.f #Tiers,#Tiers*2
Data.f -0.5,0.5,-0.5
Data.f 0,0,-1
Data.l 0
Data.f #Tiers*2,#Tiers*2
Data.f -0.5,-0.5,-0.5
Data.f 0,0,-1
Data.l 0
Data.f #Tiers*2,1
Data.f 0.5,-0.5,-0.5
Data.f 0,0,-1
Data.l 0
Data.f #Tiers,1
;Cote gauche 16 à 19
Data.f -0.5,0.5,-0.5
Data.f -1,0,0
Data.l 0
Data.f 0,#Tiers
Data.f -0.5,0.5,0.5
Data.f -1,0,0
Data.l 0
Data.f #Tiers,#Tiers
Data.f -0.5,-0.5,0.5
Data.f -1,0,0
Data.l 0
Data.f #Tiers,#Tiers*2
Data.f -0.5,-0.5,-0.5
Data.f -1,0,0
Data.l 0
Data.f 0,#Tiers*2
;Cote droit 20 à 23
Data.f 0.5,0.5,0.5
Data.f 1,0,0
Data.l 0
Data.f #Tiers*2,#Tiers
Data.f 0.5,0.5,-0.5
Data.f 1,0,0
Data.l 0
Data.f 1,#Tiers
Data.f 0.5,-0.5,-0.5
Data.f 1,0,0
Data.l 0
Data.f 1,#Tiers*2
Data.f 0.5,-0.5,0.5
Data.f 1,0,0
Data.l 0
Data.f #Tiers*2,#Tiers*2
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
EndDataSection
;}Mis à jour le 10 janvier 2009 par Comtois
Sélectionnez
; Date: 19/08/2006
; OS: Windows
; Demo: Yes
; Déplacement d'une entity
;PB4.0
EnableExplicit
InitEngine3D()
InitSprite()
InitKeyboard()
ExamineDesktops()
OpenScreen(DesktopWidth(0), DesktopHeight(0), DesktopDepth(0), "Cube 3D")
;OpenScreen(800, 600, 32, "Cube 3D")
Enumeration
#VueDessus
#VueArriere
#VueCote
#VueAvant
EndEnumeration
Global Angle.f, Vitesse.f
Define.l Options, ModeCamera, i
Vitesse = 1
ModeCamera = #VueArriere
Macro NEW_X(x, Angle, Distance)
((x) + Cos((Angle) * 0.0174533) * (Distance))
EndMacro
Macro NEW_Z(z, Angle, Distance)
((z) - Sin((Angle) * 0.0174533) * (Distance))
EndMacro
Macro AFFICHE_AIDE()
StartDrawing(ScreenOutput())
DrawText(0,0,"Touches [F1] - [F2] - [F3] - [F4] pour changer la vue de la caméra", $FF0000, $00FFFF)
StopDrawing()
EndMacro
;- Declaration des procédures
Declare.f CurveValue(actuelle.f, Cible.f, P.f)
Declare GestionCamera(Mode.l)
;-Mesh
#Mesh = 0
CreateMesh(#Mesh, 100)
Options = #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_Color | #PB_Mesh_UVCoordinate
SetMeshData(#Mesh, Options , ?Sommets, 24)
SetMeshData(#Mesh, #PB_Mesh_Face, ?Triangles, 12)
;-Textures
#Texture = 0
CreateTexture(#Texture, 64, 64)
;Remplissage de la texture en blanc
StartDrawing(TextureOutput(#Texture))
Box(0, 0, TextureWidth(#Texture), TextureHeight(#Texture), $FFFFFF)
DrawingMode(#PB_2DDrawing_Outlined) ; Pour tracer le contour
Box(0, 0, TextureWidth(#Texture), TextureHeight(#Texture), 0)
StopDrawing()
#TextureSol = 1
CreateTexture(#TextureSol, 128, 128)
;Remplissage de la texture en blanc
StartDrawing(TextureOutput(#TextureSol))
Box(0, 0, TextureWidth(#TextureSol), TextureHeight(#TextureSol), $FFFFFF)
For i = 0 To 127 Step 10
Line(i, 0, 0, TextureHeight(#TextureSol), $0000FF)
Line(0, i, TextureWidth(#TextureSol), 0, $0000FF)
Next i
DrawingMode(#PB_2DDrawing_Outlined) ; Pour tracer le contour
Box(0, 0, TextureWidth(#TextureSol), TextureHeight(#TextureSol), $000088)
StopDrawing()
;-Matière
#Matiere = 0
CreateMaterial(#Matiere, TextureID(#Texture))
#MatiereSol = 1
CreateMaterial(#MatiereSol, TextureID(#TextureSol))
;-Entity
#Entity = 0
CreateEntity(#Entity, MeshID(#Mesh), MaterialID(#Matiere))
ScaleEntity(#Entity, 10, 10, 10) ; Agrandi l'entity
EntityLocate(#Entity, 500, 5, 500)
#EntitySol = 1
CreateEntity(#EntitySol, MeshID(#Mesh), MaterialID(#MatiereSol))
ScaleEntity(#EntitySol, 1000, 2, 1000) ; Agrandi l'entity
EntityLocate(#EntitySol, 500, -5, 500)
;-Camera
#Camera = 0
CreateCamera(#Camera, 0, 0, 100, 100)
;-Light
AmbientColor(RGB(55,55,55)) ; Réduit la lumière ambiante pour mieux voir les lumières
#LightRouge = 0 : CreateLight(#LightRouge,RGB(255, 0, 0), 0, 500, 0)
#LightBleue = 1 : CreateLight(#LightBleue,RGB(0, 0, 255), 0, 500, 1000)
#LightVerte = 2 : CreateLight(#LightVerte,RGB(0, 255, 0), 1000, 500, 1000)
Repeat
If ExamineKeyboard()
;Change la vue de la caméra
If KeyboardReleased(#PB_Key_F1)
ModeCamera = #VueDessus
ElseIf KeyboardReleased(#PB_Key_F2)
ModeCamera = #VueArriere
ElseIf KeyboardReleased(#PB_Key_F3)
ModeCamera = #VueCote
ElseIf KeyboardReleased(#PB_Key_F4)
ModeCamera = #VueAvant
EndIf
If KeyboardPushed(#PB_Key_Left)
Angle + 1
RotateEntity(#Entity, Angle, 0, 0)
ElseIf KeyboardPushed(#PB_Key_Right)
Angle - 1
RotateEntity(#Entity, Angle, 0, 0)
EndIf
If KeyboardPushed(#PB_Key_Up)
MoveEntity(#Entity, NEW_X(0, Angle , Vitesse), 0, NEW_Z(0, Angle, Vitesse))
ElseIf KeyboardPushed(#PB_Key_Down)
MoveEntity(#Entity, NEW_X(0, Angle , -Vitesse), 0, NEW_Z(0, Angle, -Vitesse))
EndIf
EndIf
GestionCamera(ModeCamera)
RenderWorld()
AFFICHE_AIDE()
FlipBuffers()
Until KeyboardPushed(#PB_Key_Escape)
Procedure.f CurveValue(actuelle.f, Cible.f, P.f)
;Calcule une valeur progressive allant de la valeur actuelle à la valeur cible
Define.f Delta
Delta = Cible - actuelle
If P > 1000.0 : P = 1000.0 : EndIf
ProcedureReturn (actuelle + ( Delta * P / 1000.0))
EndProcedure
Procedure GestionCamera(Mode.l)
Define.f Px, Py, Pz, Pv
Static AngleCamera.f
Pv = 25
Select Mode
Case #VueDessus
AngleCamera = CurveValue(AngleCamera, Angle + 180, Pv)
Px = CurveValue(CameraX(#Camera), NEW_X(EntityX(#Entity), AngleCamera, 40), Pv)
Py = CurveValue(CameraY(#Camera), EntityY(#Entity) + 140, Pv)
Pz = CurveValue(CameraZ(#Camera), NEW_Z(EntityZ(#Entity), AngleCamera, 40), Pv)
Case #VueArriere
AngleCamera = CurveValue(AngleCamera, Angle + 180, Pv)
Px = CurveValue(CameraX(#Camera), NEW_X(EntityX(#Entity), AngleCamera, 80), Pv)
Py = CurveValue(CameraY(#Camera), EntityY(#Entity) + 40, Pv)
Pz = CurveValue(CameraZ(#Camera), NEW_Z(EntityZ(#Entity), AngleCamera, 80), Pv)
Case #VueCote
AngleCamera = CurveValue(AngleCamera, Angle + 120, Pv)
Px = CurveValue(CameraX(#Camera), NEW_X(EntityX(#Entity), AngleCamera, 80), Pv)
Py = CurveValue(CameraY(#Camera), EntityY(#Entity) + 40, Pv)
Pz = CurveValue(CameraZ(#Camera), NEW_Z(EntityZ(#Entity), AngleCamera, 80), Pv)
Case #VueAvant
AngleCamera = CurveValue(AngleCamera, Angle, Pv)
Px = CurveValue(CameraX(#Camera), NEW_X(EntityX(#Entity), AngleCamera, 80), Pv)
Py = CurveValue(CameraY(#Camera), EntityY(#Entity) + 40, Pv)
Pz = CurveValue(CameraZ(#Camera), NEW_Z(EntityZ(#Entity), AngleCamera, 80), Pv)
EndSelect
CameraLocate(#Camera, Px, Py, Pz)
CameraLookAt(#Camera, EntityX(#Entity), EntityY(#Entity), EntityZ(#Entity))
EndProcedure
;{ Définition du cube
DataSection
Sommets:
;Dessus 0 à 3
Data.f -0.5,0.5,-0.5
Data.f 0,1,0
Data.l 0
Data.f 0,0
Data.f 0.5,0.5,-0.5
Data.f 0,1,0
Data.l 0
Data.f 0,1
Data.f 0.5,0.5,0.5
Data.f 0,1,0
Data.l 0
Data.f 1,1
Data.f -0.5,0.5,0.5
Data.f 0,1,0
Data.l 0
Data.f 1,0
;Dessous 4 à 7
Data.f -0.5,-0.5,0.5
Data.f 0,-1,0
Data.l 0
Data.f 0,0
Data.f 0.5,-0.5,0.5
Data.f 0,-1,0
Data.l 0
Data.f 0,1
Data.f 0.5,-0.5,-0.5
Data.f 0,-1,0
Data.l 0
Data.f 1,1
Data.f -0.5,-0.5,-0.5
Data.f 0,-1,0
Data.l 0
Data.f 1,0
;Devant 8 à 11
Data.f -0.5,0.5,0.5
Data.f 0,0,1
Data.l 0
Data.f 0,0
Data.f 0.5,0.5,0.5
Data.f 0,0,1
Data.l 0
Data.f 0,1
Data.f 0.5,-0.5,0.5
Data.f 0,0,1
Data.l 0
Data.f 1,1
Data.f -0.5,-0.5,0.5
Data.f 0,0,1
Data.l 0
Data.f 1,0
;Derrière 12 à 15
Data.f 0.5,0.5,-0.5
Data.f 0,0,-1
Data.l 0
Data.f 0,0
Data.f -0.5,0.5,-0.5
Data.f 0,0,-1
Data.l 0
Data.f 0,1
Data.f -0.5,-0.5,-0.5
Data.f 0,0,-1
Data.l 0
Data.f 1,1
Data.f 0.5,-0.5,-0.5
Data.f 0,0,-1
Data.l 0
Data.f 1,0
;Cote gauche 16 à 19
Data.f -0.5,0.5,-0.5
Data.f -1,0,0
Data.l 0
Data.f 0,0
Data.f -0.5,0.5,0.5
Data.f -1,0,0
Data.l 0
Data.f 0,1
Data.f -0.5,-0.5,0.5
Data.f -1,0,0
Data.l 0
Data.f 1,1
Data.f -0.5,-0.5,-0.5
Data.f -1,0,0
Data.l 0
Data.f 1,0
;Cote droit 20 à 23
Data.f 0.5,0.5,0.5
Data.f 1,0,0
Data.l 0
Data.f 0,0
Data.f 0.5,0.5,-0.5
Data.f 1,0,0
Data.l 0
Data.f 0,1
Data.f 0.5,-0.5,-0.5
Data.f 1,0,0
Data.l 0
Data.f 1,1
Data.f 0.5,-0.5,0.5
Data.f 1,0,0
Data.l 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
EndDataSection
;}Créé le 20 février 2008 par Comtois