Sources PureBasicConsultez toutes les sources

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

 
OuvrirSommaire3D

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

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

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  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

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  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  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

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  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
  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2008 Developpez Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni 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.