# Sources PureBasicConsultez toutes les sources

Nombre d'auteurs : 41, nombre de sources : 88, dernière mise à jour : 13 août 2011

Sommaire→3D

- Archive openGL contenant l'import des fonctions et les constantes openGL 4.1
- OpenGL : Les tutoriels Nehe
- Construction d'un triangle 3D en utilisant AddSubMesh()
- Construction d'un triangle 3D en utilisant des tableaux
- Construction d'un cube 3D
- Construction d'un dé 3D
- Déplacement d'une entity

Version hors-ligne
Archive openGL contenant l'import des fonctions et les constantes openGL 4.1

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 extensions

Créé le 6 mars 2011 par Luis

Téléchargez le zip

OpenGL : Les tutoriels Nehe

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 program

Créé le 20 février 2008 par hagibaba

Téléchargez le zip

Construction d'un triangle 3D en utilisant AddSubMesh()

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

    EndDataSection

Mis à jour le 13 avril 2011 par Comtois
Construction d'un triangle 3D en utilisant des tableaux

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
Construction d'un cube 3D

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
    EndDataSection

Mis à jour le 10 janvier 2009 par Comtois
Construction d'un dé 3D

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
Déplacement d'une entity
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
Version hors-ligne

Les sources présentés sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre cette page de présentation de ces sources constitue une œuvre intellectuelle protégée par les droits d'auteurs. Copyright ©2008 Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.