PureBasic

Code : Tout sélectionner

; Comtois 01/05/06
; Progi1984 & Dri After

;Macros

Macro RGB(Rouge,Vert,Bleu)
  Rouge << 16 | Vert << 8 | Bleu
EndMacro

;Structures

Structure Vertex
   px.f
   py.f
   pz.f
   nx.f
   ny.f
   nz.f
   co.l
   u.f
   v.f
EndStructure

Structure FTriangle
   f1.w
   f2.w
   f3.w
EndStructure

Structure s_Mesh
   No.l
   *VBuffer.Vertex
   *Ibuffer.FTriangle
EndStructure

;Decls Variables
Global Angle.f, Pas.f, CameraMode.l
Global *VBuffer,*IBuffer

Define.s_Mesh CubeMesh

Structure  QTest
  state.l
  texture.l
  entity.l
  size.l
  bgcolor_red.l
  bgcolor_green.l
  bgcolor_blue.l
  fgcolor_red.l
  fgcolor_green.l
  fgcolor_blue.l
  font.s
  font_name.s
  font_size.l
  alpha.f
  delimiter.s
  trigger.l
  Version.s
EndStructure

Structure QTest_Line
  QLine.s
  QType.l
EndStructure

Global NewList TTest.QTest()
Global NewList TTest_Line.QTest_Line()

Global Test
Global Test_3D
Global Test_Angle.f

Declare CreateColorMeshCube(*Mesh.s_Mesh, Color.l)
Declare InputThread(*Quit.Long)
Declare VideoThread(*Quit.Long)

; Initialisation
If InitEngine3D() = 0
   MessageRequester( "Erreur" , "Impossible d'initialiser la 3D , vérifiez la présence de engine3D.dll" , 0 )
   End
ElseIf InitSprite() = 0 Or InitKeyboard() = 0 Or InitSprite3D() = 0
   MessageRequester( "Erreur" , "Impossible d'initialiser DirectX 7 Ou plus" , 0 )
   End
EndIf

OpenWindow(0, 0, 0, 800 , 600 ,"Cube 3D")
OpenWindowedScreen(WindowID(0), 0, 0, 800 , 600, 0, 0, 0)

;{ 2D
Test=CreateSprite(#PB_Any, 256, 256, #PB_Sprite_Texture)

If StartDrawing(SpriteOutput(Test))
  Box(0, 0, 256, 256, $800080)
  DrawText(10, 10, "Gauche/droite pour tourner le cube", #Black, $800080)
  DrawText(10, 26, "Haut/bas pour tourner le Sprite3D",  #Black, $800080)
  StopDrawing()
EndIf

Test_3D = CreateSprite3D(#PB_Any, Test)
;}

;{ 3D
; Mesh
CubeMesh\No = 0
CreateColorMeshCube(@CubeMesh, $008080)

; Texture
CreateTexture(0,128, 128)
If StartDrawing(TextureOutput(0))
  Box(0, 0, 128, 128, $FFFFFF)
  Box(1, 1, 126, 126, $880000)
  StopDrawing()
EndIf

; Material
CreateMaterial(0,TextureID(0))
MaterialAmbientColor(0,-1)

; Entity
CreateEntity(0,MeshID(0),MaterialID(0))
ScaleEntity(0,90,90,90)

; Camera
CreateCamera(0, 0, 0 , 100 , 100)
MoveCamera(0, 0, 0,-400)
CameraLookAt(0,EntityX(0),EntityY(0),EntityZ(0))

; Light
AmbientColor(RGB(255,255,255))
;}

Quit = #False

Input = CreateThread(@InputThread(), @Quit)
Video = CreateThread(@VideoThread(), @Quit)

Repeat
  Event = WaitWindowEvent()
  
Until Event = #PB_Event_CloseWindow

Quit = #True

WaitThread(Input, 1000)
WaitThread(Video, 1000)

End

;------------------------------------------------------------------------------------

Procedure InputThread(*Quit.Long)
  
  Repeat
    If ExamineKeyboard()
      If KeyboardPushed(#PB_Key_Right)
        Angle + 0.8
      EndIf
      
      If KeyboardPushed(#PB_Key_Left)
        Angle - 0.8
      EndIf
      
      If KeyboardPushed(#PB_Key_Up)
        Test_Angle + 0.9
      EndIf
      
      If KeyboardPushed(#PB_Key_Down)
        Test_Angle - 0.9
      EndIf
    EndIf
    
    If KeyboardPushed(#PB_Key_Escape)
      SendMessage_(WindowID(0), #PB_Event_CloseWindow, 0, 0)
    EndIf
    
    Delay(1)
  Until *Quit\l
  
EndProcedure

Procedure VideoThread(*Quit.Long)
  
  Repeat
    ClearScreen($400000)
    
    RotateEntity(0, Angle, Angle/2, -Angle)
    RenderWorld()
   
    DisplayTransparentSprite(Test, 500, 200)
    
    If Start3D()
      RotateSprite3D(Test_3D, Test_Angle, 0)
      DisplaySprite3D(Test_3D, 100, 100,255)
      Stop3D()
    EndIf
    
    FlipBuffers()
    Delay(1)
  Until *Quit\l
  
EndProcedure

Procedure CreateColorMeshCube(*Mesh.s_Mesh, Color.l)
  
  *Mesh\VBuffer=AllocateMemory(SizeOf(Vertex)*24)
  *Mesh\IBuffer=AllocateMemory(SizeOf(FTriangle)*12)
  
  CopyMemory(?Sommets,   *Mesh\VBuffer, SizeOf(Vertex)*24)
  CopyMemory(?Triangles, *Mesh\IBuffer, SizeOf(Vertex)*12)
  
  If CreateMesh(*Mesh\No, 24)
    *Mem.Vertex = *Mesh\VBuffer
    For i = 0 To 23
      *Mem\co=Color
      *Mem + SizeOf(Vertex)
    Next i
    
    Flag = #PB_Mesh_Vertex | #PB_Mesh_Normal | #PB_Mesh_UVCoordinate | #PB_Mesh_Color
    SetMeshData(*Mesh\No, Flag,          *Mesh\VBuffer, 24)
    SetMeshData(*Mesh\No, #PB_Mesh_Face, *Mesh\IBuffer, 12)
  EndIf
  
  ProcedureReturn IsMesh(*Mesh\No)
EndProcedure

DataSection
  Sommets:
  ;Dessus 0 à 3
  Data.f -0.5, 0.5,-0.5, 0, 1, 0, 0, 0, 0
  Data.f  0.5, 0.5,-0.5, 0, 1, 0, 0, 0, 1
  Data.f  0.5, 0.5, 0.5, 0, 1, 0, 0, 1, 1
  Data.f -0.5, 0.5, 0.5, 0, 1, 0, 0, 1, 0
  ;Dessous 4 à 7
  Data.f -0.5,-0.5, 0.5, 0,-1, 0, 0, 0, 0
  Data.f  0.5,-0.5, 0.5, 0,-1, 0, 0, 0, 1
  Data.f  0.5,-0.5,-0.5, 0,-1, 0, 0, 1, 1
  Data.f -0.5,-0.5,-0.5, 0,-1, 0, 0, 1, 0
  ;Devant 8 à 11
  Data.f -0.5, 0.5, 0.5, 0, 0, 1, 0, 0, 0
  Data.f  0.5, 0.5, 0.5, 0, 0, 1, 0, 0, 1
  Data.f  0.5,-0.5, 0.5, 0, 0, 1, 0, 1, 1
  Data.f -0.5,-0.5, 0.5, 0, 0, 1, 0, 1, 0
  ;Derrière 12 à 15
  Data.f  0.5, 0.5,-0.5, 0, 0,-1, 0, 0, 0
  Data.f -0.5, 0.5,-0.5, 0, 0,-1, 0, 0, 1
  Data.f -0.5,-0.5,-0.5, 0, 0,-1, 0, 1, 1
  Data.f  0.5,-0.5,-0.5, 0, 0,-1, 0, 1, 0
  ;Côté gauche 16 à 19
  Data.f -0.5, 0.5,-0.5,-1, 0, 0, 0, 0, 0
  Data.f -0.5, 0.5, 0.5,-1, 0, 0, 0, 0, 1
  Data.f -0.5,-0.5, 0.5,-1, 0, 0, 0, 1, 1
  Data.f -0.5,-0.5,-0.5,-1, 0, 0, 0, 1, 0
  ;Côté droit 20 à 23
  Data.f  0.5, 0.5, 0.5, 1, 0, 0, 0, 0, 0
  Data.f  0.5, 0.5,-0.5, 1, 0, 0, 0, 0, 1
  Data.f  0.5,-0.5,-0.5, 1, 0, 0, 0, 1, 1
  Data.f  0.5,-0.5, 0.5, 1, 0, 0, 0, 1, 0
  
  Triangles:
  ;Dessus 0 à 3
  Data.w 2,1,0
  Data.w 0,3,2
  ;Dessous 4 à 7
  Data.w 6,5,4
  Data.w 4,7,6
  ;Devant 8 à 11
  Data.w 10,9,8
  Data.w 8,11,10
  ;Derrière 12 à 15
  Data.w 14,13,12
  Data.w 12,15,14
  ;Côté gauche 16 à 19
  Data.w 18,17,16
  Data.w 16,19,18
  ;Côté droit 20 à 23
  Data.w 22,21,20
  Data.w 20,23,22
EndDataSection