PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

PB/OGRE SetMeshData example

https://www.purebasic.fr/english/viewtopic.php?t=9026

Page 1 of 2

PB/OGRE SetMeshData example

Posted: Mon Jan 05, 2004 11:54 am
by Danilo
Finally the SetMeshData bug is found and fixed, get the
fixed DLL for PB 3.81 here: Engine3D.dll

Overwrite your old Engine3D.dll with this fixed version.
(Engine3D.dll is in PureBasic\Compilers\ or in your system directory)

And a small example (needs the fixed DLL):

Code: Select all

; 
; by Danilo, 04.07.03 
; 
;   fixed, 04.01.2004 
;     - DIM array(10,10) creates array(11,11) in PB - arfff! 
;     - SetMeshData() bug found 
; 
;   added, 05.01.2004 
;     - rotating cubes 
;     - borders 
; 
Structure _Vertex 
  x1.f ; Vertex 1 
  y1.f 
  z1.f 
  x2.f ; Vertex 2 
  y2.f 
  z2.f 
  x3.f ; Vertex 3 
  y3.f 
  z3.f 
  x4.f ; Vertex 4 
  y4.f 
  z4.f 
EndStructure 

Structure _Triangles 
  Triangle_1_a.w ; Triangle 1 
  Triangle_1_b.w 
  Triangle_1_c.w 
  Triangle_2_a.w ; Triangle 2 
  Triangle_2_b.w 
  Triangle_2_c.w 
EndStructure 

Structure _TextureCoordinates 
  Vertex1_a.f ; Vertex 1 
  Vertex1_b.f 
  Vertex2_a.f ; Vertex 2 
  Vertex2_b.f 
  Vertex3_a.f ; Vertex 3 
  Vertex3_b.f 
  Vertex4_a.f ; Vertex 4 
  Vertex4_b.f 
EndStructure 

Procedure.f DSin(angle_in_degree.f) 
  ; returns Sinus of 'angle in degree' 
  ProcedureReturn Sin(angle_in_degree*(2*3.14159265/360)) 
EndProcedure 

Procedure.f DCos(angle_in_degree.f) 
  ; returns CoSinus of 'angle in degree' 
  ProcedureReturn Cos(angle_in_degree*(2*3.14159265/360)) 
EndProcedure 

Procedure ShowError(error$) 
  #ERR_1 = "Cant create " 
  #ERR_2 = " !"+Chr(13)+"(out of memory?)" 
  MessageRequester("ERROR",#ERR_1+error$+#ERR_2,#MB_ICONERROR) 
  End 
EndProcedure 


; 65.000 vertices = MAX ALLOWED! 
; 
; 127 x 127 = 16.129 
;             16.129 * 4 corners = 64.516 vertices, thats OK ;) 
; 
#X_COUNT = 127 
#Z_COUNT = 127 

; 3 arrays for the ground generation 
Dim Vertices._Vertex(#Z_COUNT,#X_COUNT-1) 
Dim Triangles._Triangles(#Z_COUNT,#X_COUNT-1) 
Dim TextureCoordinates._TextureCoordinates(#Z_COUNT,#X_COUNT-1) 

If InitEngine3D() And InitSprite() And InitKeyboard() And InitMouse() 

  #WIN_WIDTH  = 800 
  #WIN_HEIGHT = 600 
  #WIN_FLAGS  = #PB_Window_SystemMenu|#PB_Window_ScreenCentered 

  OpenWindow(0,0,0,#WIN_WIDTH,#WIN_HEIGHT,#WIN_FLAGS,"3D Mesh Test") 
  If OpenWindowedScreen(WindowID(),0,0,#WIN_WIDTH,#WIN_HEIGHT,0,0,0)=0 
    MessageRequester("ERROR","Cant open DirectX screen !",#MB_ICONERROR):End 
  EndIf 

  ; font for cube texture 
  BigFont   = LoadFont(1,"Arial",36) 
  ; font for border texture 
  SmallFont = LoadFont(2,"MS Sans Serif",12,#PB_Font_Bold) 

  ; generate ground 
  For x = 0 To #X_COUNT-1 
    For z = 0 To #Z_COUNT-1 
      Vertices(z,x)\x1 = x 
      Vertices(z,x)\y1 = 0 
      Vertices(z,x)\z1 = z 

      Vertices(z,x)\x2 = x+1 
      Vertices(z,x)\y2 = 0 
      Vertices(z,x)\z2 = z 

      Vertices(z,x)\x3 = x+1 
      Vertices(z,x)\y3 = 0 
      Vertices(z,x)\z3 = z+1 

      Vertices(z,x)\x4 = x 
      Vertices(z,x)\y4 = 0 
      Vertices(z,x)\z4 = z+1 
      
      Triangles(z,x)\Triangle_1_a = Triangle_Counter+2 
      Triangles(z,x)\Triangle_1_b = Triangle_Counter+1 
      Triangles(z,x)\Triangle_1_c = Triangle_Counter 
      Triangles(z,x)\Triangle_2_a = Triangle_Counter 
      Triangles(z,x)\Triangle_2_b = Triangle_Counter+3 
      Triangles(z,x)\Triangle_2_c = Triangle_Counter+2 
      Triangle_Counter + 4 

      TextureCoordinates(z,x)\Vertex1_a = 0.0 
      TextureCoordinates(z,x)\Vertex1_b = 0.0 

      TextureCoordinates(z,x)\Vertex2_a = 1.0 
      TextureCoordinates(z,x)\Vertex2_b = 0.0 

      TextureCoordinates(z,x)\Vertex3_a = 1.0 
      TextureCoordinates(z,x)\Vertex3_b = 1.0 

      TextureCoordinates(z,x)\Vertex4_a = 0.0 
      TextureCoordinates(z,x)\Vertex4_b = 1.0 

    Next 
  Next 


    If CreateMesh(0) 
      SetMeshData(0,#PB_Mesh_Vertices     ,Vertices()          , #X_COUNT*#Z_COUNT*4) 
      SetMeshData(0,#PB_Mesh_Triangles    ,Triangles()         , #X_COUNT*#Z_COUNT*2) 
      SetMeshData(0,#PB_Mesh_UVCoordinates,TextureCoordinates(), #X_COUNT*#Z_COUNT*4) 
      ;SetMeshData(0,#PB_Mesh_Normals      , ?Normalz           , 4) ; DOESNT WORK in PB 3.81 
      ;SetMeshData(0,#PB_Mesh_Colors       , ?Colorz            , 4) ; DOESNT WORK in PB 3.81 
    Else 
      ShowError("mesh") 
    EndIf 

    ; make ground texture 
    If CreateTexture(0,128,128) 
      StartDrawing(TextureOutput(0)) 
        Box(0,0,128,128,$FF9090) 
        DrawingMode(4) 
        Box(0,0,128,128,$00FF00) 
        Box(1,1,126,126,$00FF00) 
        Box(2,2,124,124,$00FF00) 
      StopDrawing() 
    Else 
      ShowError("texture") 
    EndIf 

    ; create ground entity 
    If CreateEntity(0,MeshID(0),CreateMaterial(0,TextureID(0))) 
      ScaleEntity( 0,2,2,2) 
    Else 
      ShowError("entity") 
    EndIf 

    ; create cube texture 
    z=0 
    If CreateTexture(1,512,512)=0 
      ShowError("texture") 
    EndIf 
    StartDrawing(TextureOutput(1)) 
      Box(0,0,512,512,$8000FFFF) 
      DrawingMode(1) 
      DrawingFont(BigFont) 
      For b = 0 To 500 Step 128 
        For a = 0 To 500 Step 128 
          z+1 
          Line(a,b,128,128,$000000) 
          Line(a+128,b,-128,128,$000000) 
          Locate(a+64-TextLength(Str(z))/2,b+35) 
          FrontColor($00,$00,$FF) 
          DrawText(Str(z)+".") 
        Next a 
      Next b 
    StopDrawing() 

    ; set cube mesh data 
    If CreateMesh(1) 
      SetMeshData(1,#PB_Mesh_Vertices     ,?CubeVertices          ,6*4) 
      SetMeshData(1,#PB_Mesh_Triangles    ,?CubeFacesIndexes      ,6*2) 
      SetMeshData(1,#PB_Mesh_UVCoordinates,?CubeTextureCoordinates,6*4) 
    Else 
      ShowError("mesh") 
    EndIf 

    ; create big cube entity 
    If CreateEntity(1,MeshID(1),CreateMaterial(1,TextureID(1))) 
      ScaleEntity(1, 10, 10, 10) 
      EntityLocate(1,127,20,127) 
      RotateEntity(1,180,0,0) 
    Else 
      ShowError("entity") 
    EndIf 

    ; create 4 small cubes 
    For a = 0 To 3 
      If CreateEntity(2+a,MeshID(1),MaterialID(1)) 
        ScaleEntity(2+a,2,2,2) 
      Else 
        ShowError("entity") 
      EndIf 
    Next a 
    ScaleEntity(5,3,3,3) 


    ; create 4 borders 
    Restore BorderColors 
    For a = 0 To 3 
      If CreateMesh(6+a)=0 
        ShowError("mesh") 
      EndIf 

      SetMeshData(6+a,#PB_Mesh_Vertices     ,?BorderVertices          ,4) 
      SetMeshData(6+a,#PB_Mesh_Triangles    ,?BorderFaces             ,2) 
      SetMeshData(6+a,#PB_Mesh_UVCoordinates,?BorderTextureCoordinates,4) 

      If CreateTexture(6+a,256,256)=0 
        ShowError("texture") 
      EndIf 
      StartDrawing(TextureOutput(6+a)) 
        Read color 
        Box(0,0,256,256,color) 
        DrawingMode(1) 
        FrontColor($FF-Red(color),$FF-Green(color),$FF-Blue(color)) 
        DrawingFont(SmallFont) 
        Locate(10,20):DrawText("SetMeshData()") 
        DrawingFont(BigFont) 
        Locate(5,130):DrawText("PureBasic") 
      StopDrawing() 
      If CreateMaterial(6+a,TextureID(6+a))=0 
        ShowError("material") 
      EndIf 
      For b = 10 To 32 
        If CreateEntity(b+a*35,MeshID(6+a),MaterialID(6+a)) 
          ScaleEntity(b+a*35,24,25,0) 
        Else 
          ShowError("entity") 
        EndIf 
      Next b 
    Next a 

    ; border 1 
    For b = 0 To 10 
      RotateEntity(10+b,180,0,0) 
      RotateEntity(22+b,180,0,0) 
      EntityLocate(10+b,b*23,-1,0) 
      EntityLocate(22+b,b*23,24,0) 
    Next b 

    ; border 2 
    For b = 0 To 10 
      RotateEntity(45+b,180,180,180) 
      RotateEntity(57+b,180,180,180) 
      EntityLocate(45+b,254-b*23,-1,254) 
      EntityLocate(57+b,254-b*23,24,254) 
    Next b 

    ; border 3 
    For b = 0 To 10 
      RotateEntity(80+b,-90,0,0) 
      RotateEntity(92+b,-90,0,0) 
      EntityLocate(80+b,0,-1,254-b*23) 
      EntityLocate(92+b,0,24,254-b*23) 
    Next b 
    
    ; border 4 
    For b = 0 To 10 
      RotateEntity(115+b,90,0,00) 
      RotateEntity(127+b,90,0,00) 
      EntityLocate(115+b,254,-1,0+b*23) 
      EntityLocate(127+b,254,24,0+b*23) 
    Next b 


    ; create and initialize camera 
    CreateCamera(0, 0,  0, 100, 100) 
    CameraLocate(0, 150, 4, 220) 
    RotateCamera(0, 0, -10, 0) 

    ; GO! 
    Repeat 
      ExamineKeyboard() 
      Select WindowEvent() 
        Case #PB_Event_CloseWindow 
          Quit = #TRUE 
      EndSelect 

      ; movement with keys 
      If     KeyboardPushed(#PB_KEY_RIGHT) 
        MoveCamera(0, 1,0,0) 
      ElseIf KeyboardPushed(#PB_KEY_LEFT) 
        MoveCamera(0,-1,0,0) 
      ElseIf KeyboardPushed(#PB_KEY_UP) 
        MoveCamera(0,0,0,-3) 
      ElseIf KeyboardPushed(#PB_KEY_DOWN) 
        MoveCamera(0,0,0, 3) 
      EndIf 

      ; mouse freelook 
      If ExamineMouse() 
        RotateCamera(0,-MouseDeltaX(),-MouseDeltaY(),0) 
      EndIf 

      ; collision detection for the room borders 
      If CameraY(0) <   4: CameraLocate(0,CameraX(0),  4,CameraZ(0)) : EndIf 
      If CameraY(0) >  40: CameraLocate(0,CameraX(0), 40,CameraZ(0)) : EndIf 
      If CameraX(0) <   4: CameraLocate(0,  4,CameraY(0),CameraZ(0)) : EndIf 
      If CameraX(0) > 250: CameraLocate(0,250,CameraY(0),CameraZ(0)) : EndIf 
      If CameraZ(0) <   4: CameraLocate(0,CameraX(0),CameraY(0),  4) : EndIf 
      If CameraZ(0) > 250: CameraLocate(0,CameraX(0),CameraY(0),250) : EndIf 

      ; animate ground texture 
      If StartDrawing(TextureOutput(0)) 
        Box(3,3,122,122,RGB(textcol1,textcol1,textcol1*2)) 
        StopDrawing() 
      EndIf 
      If textcol1_flag 
        textcol1-2 
        If textcol1=<  0 : textcol1_flag = #FALSE : textcol1 =   0 : EndIf 
      Else 
        textcol1+2 
        If textcol1=>100 : textcol1_flag = #TRUE  : textcol1 = 100 : EndIf 
      EndIf 
      
      ; animate small cubes 
      Angle1.f+2 
      If Angle1>360 : Angle1 - 360 : EndIf 
      EntityLocate(2,127+DSin(Angle1)*25,27,127+DCos(Angle1)*25) 
      EntityLocate(3,127+DSin(360-Angle1)*25,18,127+DCos(360-Angle1)*25) 
      EntityLocate(4,127+DSin(360-Angle1)*124,25+DCos(Angle1*2)*22,127) 

      Angle2.f-0.3 
      If Angle2>360 : Angle2 - 360 : EndIf 
      EntityLocate(5,127+DSin(Angle2)*120,90,127+DCos(Angle2)*120) 

      ; rotate da cubez 
      RotateEntity(1,2,-4,-1) 
      RotateEntity(2, 4, 2, 8) 
      RotateEntity(3,-4,-2,-8) 
      RotateEntity(4,1,1,1) 
      RotateEntity(5,3,4,5) 


      ; show it 
      ;ClearScreen(0,0,0) 
      RenderWorld() 
      FlipBuffers() 
    Until KeyboardPushed(#PB_Key_Escape) Or Quit 
Else 
  MessageRequester("Error", "Cant init DirectX 3D Engine",0) 
EndIf 
  
End 

DataSection 

  CubeVertices: 
    Data.f  1, 1,-1 ; Vertex 0 
    Data.f -1, 1,-1 ; Vertex 1 
    Data.f  1,-1,-1 ; Vertex 2 
    Data.f -1,-1,-1 ; Vertex 3 

    Data.f  1, 1, 1 ; Vertex 4 
    Data.f -1, 1, 1 ; Vertex 5 
    Data.f  1, 1,-1 ; Vertex 6 
    Data.f -1, 1,-1 ; Vertex 7 

    Data.f  1,-1, 1 ; Vertex 8 
    Data.f -1,-1, 1 ; Vertex 9 
    Data.f  1, 1, 1 ; Vertex 10 
    Data.f -1, 1, 1 ; Vertex 11 

    Data.f  1,-1,-1 ; Vertex 12 
    Data.f -1,-1,-1 ; Vertex 13 
    Data.f  1,-1, 1 ; Vertex 14 
    Data.f -1,-1, 1 ; Vertex 15 

    Data.f  1, 1, 1 ; Vertex 16 
    Data.f  1, 1,-1 ; Vertex 17 
    Data.f  1,-1, 1 ; Vertex 18 
    Data.f  1,-1,-1 ; Vertex 19 

    Data.f -1, 1,-1 ; Vertex 20 
    Data.f -1, 1, 1 ; Vertex 21 
    Data.f -1,-1,-1 ; Vertex 22 
    Data.f -1,-1, 1 ; Vertex 23 


  CubeFacesIndexes: 
    Data.w  0, 2, 1 ; front 
    Data.w  1, 2, 3 

    Data.w  4, 6, 5 ; top 
    Data.w  5, 6, 7 

    Data.w  8,10, 9 ; back 
    Data.w  9,10,11 

    Data.w 12,14,13 ; bottom 
    Data.w 13,14,15 

    Data.w 16,18,17 ; left 
    Data.w 17,18,19 

    Data.w 20,22,21 ; right 
    Data.w 21,22,23 

  CubeTextureCoordinates: 
    Data.f 0.00 , 0.00 ; '1' = front 
    Data.f 0.25 , 0.00 
    Data.f 0.00 , 0.25 
    Data.f 0.25 , 0.25 

    Data.f 0.25 , 0.00 ; '2' = top 
    Data.f 0.50 , 0.00 
    Data.f 0.25 , 0.25 
    Data.f 0.50 , 0.25 

    Data.f 0.50 , 0.00 ; '3' = back 
    Data.f 0.75 , 0.00 
    Data.f 0.50 , 0.25 
    Data.f 0.75 , 0.25 

    Data.f 0.75 , 0.00 ; '4' = bottom 
    Data.f 1.00 , 0.00 
    Data.f 0.75 , 0.25 
    Data.f 1.00 , 0.25 

    Data.f 0.00 , 0.25 ; '5' = left 
    Data.f 0.25 , 0.25 
    Data.f 0.00 , 0.50 
    Data.f 0.25 , 0.50 

    Data.f 0.25 , 0.25 ; '6' = right 
    Data.f 0.50 , 0.25 
    Data.f 0.25 , 0.50 
    Data.f 0.50 , 0.50 

  BorderVertices: 
    Data.f  0,1,0 ; Vertex 0 
    Data.f -1,1,0 ; Vertex 1 
    Data.f  0,0,0 ; Vertex 2 
    Data.f -1,0,0 ; Vertex 3 
  BorderFaces: 
    Data.w  0, 2, 1 
    Data.w  1, 2, 3 
  BorderTextureCoordinates: 
    Data.f 0,0 
    Data.f 1,0 
    Data.f 0,1 
    Data.f 1,1 
  BorderColors: 
    Data.l $FF0000 
    Data.l $00FF00 
    Data.l $FF00FF 
    Data.l $FFFF00 

;   Colorz: 
;     Data.f 0.0, 1.0 
;     Data.f 1.0, 0.2 
;     Data.f 0.0, 1.0 
;     Data.f 0.5, 1.0 
;   Normalz: 
;     Data.f -1.0, -1.0 
;     Data.f  1.0,  0.0 
;     Data.f -1.0,  0.0 
;     Data.f  1.0,  0.0 
EndDataSection

Posted: Mon Jan 05, 2004 12:09 pm
by boop64
Wow, Nice example! Keep up the good work. This looks like it will be very helpfull when I start my next project.

Thanks,
Boop64

Posted: Mon Jan 05, 2004 12:17 pm
by Dare2
Downloaded DLL
.Closed and restarted PB editor.
Ran the above code.

Got a visualC++ runtime error under Win2k

:(

Is something else needed? Reboot? Unix? More beer?

Posted: Mon Jan 05, 2004 12:23 pm
by boop64
Dare2 wrote:Got a visualC++ runtime error under Win2k
Thats odd, I downloaded the dll and compiled the source and it works fine for me. Make sure you have the dll in the correct location.

Boop64

Posted: Mon Jan 05, 2004 12:26 pm
by Danilo
Dare2 wrote:Is something else needed? Reboot? Unix? More beer?
A good graphics card.

Looks like OGRE just crashes on some older graphics cards sometimes.
Maybe its when graphics card memory is full.. dont know.

Posted: Mon Jan 05, 2004 12:28 pm
by Dare2
I renamed the old dll to oldEngine3d.dll (original, eh?) and dropped the new one into the same folder - C:\Program Files\PureBasic\Compilers

?

EDIT:

Yeah, I have a really lousy graphics card, so I'll buy that.

:)

Posted: Mon Jan 05, 2004 2:48 pm
by Berikco
works fine here

Posted: Mon Jan 05, 2004 4:41 pm
by Denis
Works fine under Win98 SE + NVIDIA GeForce4 MX 440.

Really a nice example Danillo.
Tks

Denis

Posted: Tue Jan 06, 2004 5:55 pm
by coma
with this new engine3d.dll, it's not possible to draw 3d objects in front of 2d drawings: it seems that RenderWorld() make an automatic clearscreen.

(another little thing: it also make an "ogre.log" in the current directory)

Posted: Tue Jan 06, 2004 6:36 pm
by Comtois
I gote this error when i quit a program
PUREBASIC3111683 a causé une défaillance de page dans
le module KERNEL32.DLL à 0167:bff7b997.
Registres :
EAX=00000000 CS=0167 EIP=bff7b997 EFLGS=00000246
EBX=10000000 SS=016f ESP=0069fb38 EBP=0069fb74
ECX=7803bb90 DS=016f ESI=10119160 FS=3a47
EDX=1011efc8 ES=016f EDI=008c0990 GS=0000
Octets à CS : EIP :
ff 76 04 e8 26 89 ff ff 5e c2 04 00 56 8b 74 24
État de la pile :
00000000 780114ac 10119160 78011542 10119140 008c0990 008c0990 10000000 100e6f60 101a55d0 0069f7e8 0069fd78 7800f56a 78034a78 ffffffff 0069fbc0
PIII 450 MHz , 128 Mo Ram , GEforce GTS2 , PureBasic 3.81

Window 98

-------------------------------
Work fine with
PIV 2,6 , 512 Mo Ram, 128DDR ATI Radeon 9800
XP home

Posted: Wed Jan 07, 2004 4:18 am
by Danilo
UPDATE (again :D)

New version of the DLL: Engine3D.dll (06-Jan-2004 21:21)

Normals and Colors were missing in SetMeshData, so it just
ignored it and you couldnt see colors and lights on the
created meshes.

New improved example for the new DLL:

Code: Select all

;
; by Danilo, 04.07.03
;
;   fixed, 04.01.2004
;     - DIM array(10,10) creates array(11,11) in PB - arfff!
;     - SetMeshData() bug found
;
;   added, 05.01.2004
;     - rotating cubes, borders
;
;   added, 07.01.2004
;     - normals for ground and cubes, SMD ground colors
;
Structure _Vertices
  x1.f ; Vertex 1 
  y1.f 
  z1.f 
  x2.f ; Vertex 2 
  y2.f 
  z2.f 
  x3.f ; Vertex 3 
  y3.f 
  z3.f 
  x4.f ; Vertex 4 
  y4.f 
  z4.f 
EndStructure 

Structure _Triangles 
  Triangle_1_a.w ; Triangle 1 
  Triangle_1_b.w 
  Triangle_1_c.w 
  Triangle_2_a.w ; Triangle 2 
  Triangle_2_b.w 
  Triangle_2_c.w 
EndStructure 

Structure _TextureCoordinates 
  Vertex1_a.f ; Vertex 1 
  Vertex1_b.f 
  Vertex2_a.f ; Vertex 2 
  Vertex2_b.f 
  Vertex3_a.f ; Vertex 3 
  Vertex3_b.f 
  Vertex4_a.f ; Vertex 4 
  Vertex4_b.f 
EndStructure 

Structure _Normals
  x1.f ; Normals Vertex 1 
  y1.f 
  z1.f
  x2.f ; Normals Vertex 2 
  y2.f 
  z2.f
  x3.f ; Normals Vertex 3 
  y3.f 
  z3.f
  x4.f ; Normals Vertex 4 
  y4.f 
  z4.f
EndStructure 

Structure _Colors
  col1.l
  col2.l
  col3.l
  col4.l
EndStructure

Procedure.f DSin(angle_in_degree.f)
  ; returns Sinus of 'angle in degree'
  ProcedureReturn Sin(angle_in_degree*(2*3.14159265/360))
EndProcedure 

Procedure.f DCos(angle_in_degree.f) 
  ; returns CoSinus of 'angle in degree'
  ProcedureReturn Cos(angle_in_degree*(2*3.14159265/360))
EndProcedure

Procedure InitGameTimer()
  ; initialize highres timing function TimeGetTime_()
  Shared _GT_DevCaps.TIMECAPS
  timeGetDevCaps_(_GT_DevCaps,SizeOf(TIMECAPS))
  timeBeginPeriod_(_GT_DevCaps\wPeriodMin)
EndProcedure 

Procedure StopGameTimer()
  ; de-initialize highres timing function TimeGetTime_()
  Shared _GT_DevCaps.TIMECAPS
  timeEndPeriod_(_GT_DevCaps\wPeriodMin)
EndProcedure


Procedure ShowError(error$)
  #ERR_1 = "Cant create "
  #ERR_2 = " !"+Chr(13)+"(out of memory?)"
  MessageRequester("ERROR",#ERR_1+error$+#ERR_2,#MB_ICONERROR)
  End
EndProcedure

If InitEngine3D() And InitSprite() And InitKeyboard() And InitMouse()

  #LOOPTIME   = 1000/40  ; 40 Frames in 1000ms (1second)
  #WIN_WIDTH  = 800
  #WIN_HEIGHT = 600
  #WIN_FLAGS  = #PB_Window_SystemMenu|#PB_Window_ScreenCentered

  ; font for cube texture
  BigFont   = LoadFont(1,"Arial",36) 
  ; font for border texture
  SmallFont = LoadFont(2,"Lucida Console",10,#PB_Font_Bold)

  A$ = Chr(13)+"( "+Str(#WIN_WIDTH)+"x"+Str(#WIN_HEIGHT)+" )"
  If MessageRequester("QUESTION","Run fullscreen?"+A$,#MB_ICONQUESTION|#MB_YESNO)=#IDNO
    OpenWindow(0,0,0,#WIN_WIDTH,#WIN_HEIGHT,#WIN_FLAGS,"3D Mesh Test") 
    If OpenWindowedScreen(WindowID(),0,0,#WIN_WIDTH,#WIN_HEIGHT,0,0,0)=0
      MessageRequester("ERROR","Cant open DirectX screen !",#MB_ICONERROR):End
    EndIf
    While WindowEvent():Wend
  Else
    fullscreen=#TRUE
    If OpenScreen(#WIN_WIDTH,#WIN_HEIGHT,32,"3D Mesh Test")=0
      If OpenScreen(#WIN_WIDTH,#WIN_HEIGHT,24,"3D Mesh Test")=0
        If OpenScreen(#WIN_WIDTH,#WIN_HEIGHT,16,"3D Mesh Test")=0
          MessageRequester("ERROR","Cant open DirectX screen !",#MB_ICONERROR):End
    EndIf:EndIf:EndIf
  EndIf

  #Z_COUNT = 32
  #X_COUNT = 32

  ; generate ground
  Dim Vertices._Vertices(#Z_COUNT-1,#X_COUNT-1)
  Dim Triangles._Triangles(#Z_COUNT-1,#X_COUNT-1)
  Dim TextureCoordinates._TextureCoordinates(#Z_COUNT-1,#X_COUNT-1)
  Dim Normals._Normals(#Z_COUNT-1,#X_COUNT-1)
  Dim Colors._Colors(#Z_COUNT-1,#X_COUNT-1)

  For x = 0 To #X_COUNT-1
    For z = 0 To #Z_COUNT-1
      Vertices(z,x)\x1 = x 
      Vertices(z,x)\y1 = 0
      Vertices(z,x)\z1 = z

      Vertices(z,x)\x2 = x+1 
      Vertices(z,x)\y2 = 0
      Vertices(z,x)\z2 = z 

      Vertices(z,x)\x3 = x+1 
      Vertices(z,x)\y3 = 0 
      Vertices(z,x)\z3 = z+1 

      Vertices(z,x)\x4 = x 
      Vertices(z,x)\y4 = 0 
      Vertices(z,x)\z4 = z+1 
      
      Triangles(z,x)\Triangle_1_a = Triangle_Counter+2 
      Triangles(z,x)\Triangle_1_b = Triangle_Counter+1 
      Triangles(z,x)\Triangle_1_c = Triangle_Counter 
      Triangles(z,x)\Triangle_2_a = Triangle_Counter 
      Triangles(z,x)\Triangle_2_b = Triangle_Counter+3 
      Triangles(z,x)\Triangle_2_c = Triangle_Counter+2 
      Triangle_Counter + 4 

      TextureCoordinates(z,x)\Vertex1_a = 0.0 
      TextureCoordinates(z,x)\Vertex1_b = 0.0 

      TextureCoordinates(z,x)\Vertex2_a = 1.0 
      TextureCoordinates(z,x)\Vertex2_b = 0.0 

      TextureCoordinates(z,x)\Vertex3_a = 1.0 
      TextureCoordinates(z,x)\Vertex3_b = 1.0 

      TextureCoordinates(z,x)\Vertex4_a = 0.0 
      TextureCoordinates(z,x)\Vertex4_b = 1.0 

      Normals(z,x)\x1 =  0
      Normals(z,x)\y1 =  2
      Normals(z,x)\z1 =  0
      Normals(z,x)\x2 =  0
      Normals(z,x)\y2 =  2
      Normals(z,x)\z2 =  0
      Normals(z,x)\x3 =  0
      Normals(z,x)\y3 =  2
      Normals(z,x)\z3 =  0
      Normals(z,x)\x4 =  0
      Normals(z,x)\y4 =  2
      Normals(z,x)\z4 =  0

      Colors(z,x)\col1 = Random($FFFFFF)
      Colors(z,x)\col2 = Random($FFFFFF)
      Colors(z,x)\col3 = Random($FFFFFF)
      Colors(z,x)\col4 = Random($FFFFFF)
    Next 
  Next 

  If CreateMesh(0)
    SetMeshData(0,#PB_Mesh_Vertices     ,@Vertices()          ,#Z_COUNT*#X_COUNT*4)
    SetMeshData(0,#PB_Mesh_Triangles    ,@Triangles()         ,#Z_COUNT*#X_COUNT*2)
    SetMeshData(0,#PB_Mesh_UVCoordinates,@TextureCoordinates(),#Z_COUNT*#X_COUNT*4)
    SetMeshData(0,#PB_Mesh_Normals      ,@Normals()           ,#Z_COUNT*#X_COUNT*4)
    SetMeshData(0,#PB_Mesh_Colors       ,@Colors()            ,#Z_COUNT*#X_COUNT*4) ; DOESNT WORK in PB 3.81
  Else
    ShowError("mesh")
  EndIf

  ; free arrays, no longer needed
  ;Dim Vertices._Vertex(0,0)
  ;Dim Triangles._Triangles(0,0)
  ;Dim TextureCoordinates._TextureCoordinates(0,0)
  ;Dim Normals._Normals(0,0)
  ;Dim Colors._Colors(0,0)


  ; make ground texture
  If CreateTexture(0,128,128)
    If StartDrawing(TextureOutput(0)) 
      Box(0,0,128,128,$FF6060)
      Box(12,12,14,14,$FF9090)
      StopDrawing()
    EndIf
  Else
    ShowError("texture")
  EndIf

  ; create ground entity
  If CreateMaterial(0,TextureID(0))=0
    ShowError("material")
  EndIf
  If CreateEntity(0,MeshID(0),MaterialID(0)) 
    ScaleEntity( 0,254/#X_COUNT,1,254/#Z_COUNT)
    ;MaterialShadingMode(0,#PB_Material_Phong)
    MaterialDiffuseColor(0, RGB($FF,$FF,$00))
    MaterialAmbientColor(0, RGB($90,$90,$00))
    MaterialSpecularColor(0,RGB($FF,$FF,$80)) 
  Else
    ShowError("entity")
  EndIf

  ; create cube texture
  z=0
  If CreateTexture(1,512,512)=0
    ShowError("texture")
  EndIf
  If StartDrawing(TextureOutput(1)) 
    Box(0,0,512,512,$8000FFFF)
    DrawingMode(1)
    DrawingFont(BigFont)
    For b = 0 To 500 Step 128
      For a = 0 To 500 Step 128
        z+1
        Line(a,b,128,128,$000000)
        Line(a+128,b,-128,128,$000000)
        Locate(a+64-TextLength(Str(z))/2,b+35)
        FrontColor($00,$00,$FF)
        DrawText(Str(z)+".")
      Next a
    Next b
    StopDrawing()
  EndIf

  ; set cube mesh data
  If CreateMesh(1)
    SetMeshData(1,#PB_Mesh_Vertices     ,?CubeVertices          ,6*4)
    SetMeshData(1,#PB_Mesh_Triangles    ,?CubeFacesIndexes      ,6*2)
    SetMeshData(1,#PB_Mesh_UVCoordinates,?CubeTextureCoordinates,6*4)
    SetMeshData(1,#PB_Mesh_Normals      ,?CubeNormals           ,6*4)
  Else
    ShowError("mesh")
  EndIf

  ; create big cube entity
  If CreateMaterial(1,TextureID(1))=0
    ShowError("material")
  EndIf
  If CreateEntity(1,MeshID(1),MaterialID(1))
    MaterialBlendingMode(1,#PB_Material_Color)
    MaterialDiffuseColor(1, RGB($FF,$FF,$FF))
    MaterialAmbientColor(1, RGB($FF,$00,$FF))
    MaterialSpecularColor(1,RGB($00,$00,$FF)) 
    ScaleEntity(1, 10, 10, 10)
    EntityLocate(1,127,20,127)
    RotateEntity(1,180,0,0)
  Else
    ShowError("entity")
  EndIf

  ; create 4 small cubes
  If CreateMaterial(2,TextureID(1))=0
    ShowError("material")
  EndIf
  For a = 0 To 3
    If CreateEntity(2+a,MeshID(1),MaterialID(2))
      ScaleEntity(2+a,2,2,2)
    Else
      ShowError("entity")
    EndIf
  Next a
  ScaleEntity(5,3,3,3)


  ;create 4 borders
  For a = 0 To 3
    If CreateMesh(6+a)=0
      ShowError("mesh")
    EndIf

    SetMeshData(6+a,#PB_Mesh_Vertices     ,?BorderVertices          ,4)
    SetMeshData(6+a,#PB_Mesh_Triangles    ,?BorderFaces             ,2)
    SetMeshData(6+a,#PB_Mesh_UVCoordinates,?BorderTextureCoordinates,4)
    If a = 0
      ;SetMeshData(6+a,#PB_Mesh_Normals    ,?Normals_1               ,4)
    EndIf

    If CreateTexture(6+a,256,256)=0
      ShowError("texture")
    EndIf
    If StartDrawing(TextureOutput(6+a))
      For b = 0 To 10000
        Box(Random(255),Random(255),2,2,Random($FFFFFF))
      Next b
      DrawingMode(4)
      For b = 0 To 10
        Box(0+b,0+b,256-b*2,256-b*2,RGB(0,b*20,0))
      Next b
      StopDrawing()
    EndIf
    If CreateMaterial(6+a,TextureID(6+a))=0
      ShowError("material")
    EndIf
    If CreateEntity(6+a,MeshID(6+a),MaterialID(6+a))
      ScaleEntity(6+a,254,50,0)
    Else
      ShowError("entity")
    EndIf
  Next a

  ; border 1
  RotateEntity(6,180,0,0)
  EntityLocate(6,0,-1,0)

  ; border 2
  RotateEntity(7,180,180,180)
  EntityLocate(7,254,-1,254)

  ; border 3
  RotateEntity(8,-90,0,0)
  EntityLocate(8,0,-1,254)
  
  ; border 4
  RotateEntity(9,90,0,00)
  EntityLocate(9,254,-1,0)

  ; create and initialize camera
  If CreateCamera(0, 0,  0, 100, 100)=0
    ShowError("camera")
  EndIf

  CameraLocate(0, 240, 40, 220)
  ;CameraLocate(0, 140, 40, 220)
  RotateCamera(0, 45, -10, 0)
  CameraRange(0, 0.5, 400)
  FOV = 70
  CameraFOV(0,FOV)

  ; add some lights
  If CreateLight(1,RGB($FF,$FF,$FF))=0:ShowError("light"):EndIf
  LightLocate(1,160,5,160)
  If CreateLight(2,RGB($FF,$FF,$00))=0:ShowError("light"):EndIf
  LightLocate(2,160,5,160)
  If CreateLight(3,RGB($FF,$00,$00))=0:ShowError("light"):EndIf
  LightLocate(3,160,5,160)

  ; start game timer
  InitGameTimer()
  LoopTimer = TimeGetTime_()


  ; GO!
  Repeat 
    If fullscreen
      While ( TimeGetTime_()-LoopTimer )<#LOOPTIME : Delay(1) : Wend
      LoopTimer = TimeGetTime_()
    Else
      Repeat
        Event=WindowEvent()
        If Event=#PB_Event_CloseWindow
          Quit = #TRUE
        ElseIf Event=0
          While ( TimeGetTime_()-LoopTimer )<#LOOPTIME : Delay(1) : Wend
          LoopTimer = TimeGetTime_()
        EndIf
      Until Event=0
    EndIf

    ; check keys
    If ExamineKeyboard()
      If KeyboardPushed(#PB_KEY_RIGHT)
        MoveCamera(0, 5,0,0):EndIf
      If KeyboardPushed(#PB_KEY_LEFT)
        MoveCamera(0,-5,0,0):EndIf
      If KeyboardPushed(#PB_KEY_UP)
        MoveCamera(0,0,0,-5):EndIf
      If KeyboardPushed(#PB_KEY_DOWN)
        MoveCamera(0,0,0, 5):EndIf
      If KeyboardPushed(#PB_KEY_F3)
        FOV - 1 : If FOV < 40:FOV=40:EndIf
        CameraFOV(0,FOV):EndIf
      If KeyboardPushed(#PB_KEY_F4)
        FOV + 1 : If FOV > 120:FOV=120:EndIf
        CameraFOV(0,FOV):EndIf
      If keypressed=0
        If KeyboardPushed(#PB_KEY_F1)
          HideText!1 : keypressed=20 : EndIf
        If KeyboardPushed(#PB_KEY_F2)
          RenderMode+1 : If RenderMode=3:RenderMode=0:EndIf
          CameraRenderMode(0,RenderMode):keypressed=20:EndIf
      Else
        keypressed-1
      EndIf
    EndIf

    ; mouse freelook
    If ExamineMouse()
      RotateCamera(0,-MouseDeltaX(),-MouseDeltaY(),0)
    EndIf

    ; collision detection for the room borders
    If CameraY(0) <   4: CameraLocate(0,CameraX(0),  4,CameraZ(0)) : EndIf
    If CameraY(0) >  40: CameraLocate(0,CameraX(0), 40,CameraZ(0)) : EndIf
    If CameraX(0) <   4: CameraLocate(0,  4,CameraY(0),CameraZ(0)) : EndIf
    If CameraX(0) > 250: CameraLocate(0,250,CameraY(0),CameraZ(0)) : EndIf
    If CameraZ(0) <   4: CameraLocate(0,CameraX(0),CameraY(0),  4) : EndIf
    If CameraZ(0) > 250: CameraLocate(0,CameraX(0),CameraY(0),250) : EndIf

    ; animate ground texture
;       If StartDrawing(TextureOutput(0))
;         Box(3,3,122,122,RGB(textcol1,textcol1,textcol1*2))
;         StopDrawing()
;       EndIf
;       If textcol1_flag
;         textcol1-2
;         If textcol1=<  0 : textcol1_flag = #FALSE : textcol1 =   0 : EndIf
;       Else
;         textcol1+2
;         If textcol1=>100 : textcol1_flag = #TRUE  : textcol1 = 100 : EndIf
;       EndIf
    
    ; animate small cubes
    Angle1.f+2
    If Angle1>360 : Angle1 - 360 : EndIf
    EntityLocate(2,127+DSin(Angle1)*25,27,127+DCos(Angle1)*25)
    EntityLocate(3,127+DSin(360-Angle1)*25,18,127+DCos(360-Angle1)*25)
    EntityLocate(4,127+DSin(360-Angle1)*124,25+DCos(Angle1*2)*22,127)

    Angle2.f-0.3
    If Angle2>360 : Angle2 - 360 : EndIf
    EntityLocate(5,127+DSin(Angle2)*120,90,127+DCos(Angle2)*120)

    LightLocate(1,127+DSin(Angle1)*100,5,127+DCos(Angle1*2)*100)
    LightLocate(2,127+DSin(Angle1)*100,5,127-DCos(Angle1*2)*100)
    LightLocate(3,127+DSin(Angle1)*100,5,127+DCos(Angle1)*100)

    ; rotate da cubez
    RotateEntity(1,2,-4,-1)
    RotateEntity(2, 4, 2, 8)
    RotateEntity(3,-4,-2,-8)
    RotateEntity(4,1,1,1)
    RotateEntity(5,3,4,5)

    ; info text
    If HideText=0
      If StartDrawing(ScreenOutput())
        DrawingMode(1):FrontColor($40,$FF,$00):DrawingFont(SmallFont)
        Locate( 15,15):DrawText("F1     : HideText")
        Locate( 15,30):DrawText("F2     : RenderMode")
        Locate( 15,45):DrawText("F3+F4  : FOV")
        Locate(250,15):DrawText("CameraX: "+RSet(StrF(CameraX(0),2),6,"0"))
        Locate(250,30):DrawText("CameraY: "+RSet(StrF(CameraY(0),2),6,"0"))
        Locate(250,45):DrawText("CameraZ: "+RSet(StrF(CameraZ(0),2),6,"0"))
        StopDrawing()
      EndIf
    EndIf

    ; show it
    FlipBuffers()
    ClearScreen(0,0,0)
    RenderWorld()
  Until KeyboardPushed(#PB_Key_Escape) Or Quit
  ; OK, done
  StopGameTimer()
Else
  MessageRequester("Error", "Cant init DirectX 3D Engine",0) 
EndIf 
  
End 

DataSection

  CubeVertices:
    Data.f  1, 1,-1 ; Vertex 0
    Data.f -1, 1,-1 ; Vertex 1
    Data.f  1,-1,-1 ; Vertex 2
    Data.f -1,-1,-1 ; Vertex 3

    Data.f  1, 1, 1 ; Vertex 4
    Data.f -1, 1, 1 ; Vertex 5
    Data.f  1, 1,-1 ; Vertex 6
    Data.f -1, 1,-1 ; Vertex 7

    Data.f  1,-1, 1 ; Vertex 8
    Data.f -1,-1, 1 ; Vertex 9
    Data.f  1, 1, 1 ; Vertex 10
    Data.f -1, 1, 1 ; Vertex 11

    Data.f  1,-1,-1 ; Vertex 12
    Data.f -1,-1,-1 ; Vertex 13
    Data.f  1,-1, 1 ; Vertex 14
    Data.f -1,-1, 1 ; Vertex 15

    Data.f  1, 1, 1 ; Vertex 16
    Data.f  1, 1,-1 ; Vertex 17
    Data.f  1,-1, 1 ; Vertex 18
    Data.f  1,-1,-1 ; Vertex 19

    Data.f -1, 1,-1 ; Vertex 20
    Data.f -1, 1, 1 ; Vertex 21
    Data.f -1,-1,-1 ; Vertex 22
    Data.f -1,-1, 1 ; Vertex 23


  CubeFacesIndexes:
    Data.w  0, 2, 1 ; front
    Data.w  1, 2, 3

    Data.w  4, 6, 5 ; top
    Data.w  5, 6, 7

    Data.w  8,10, 9 ; back
    Data.w  9,10,11

    Data.w 12,14,13 ; bottom
    Data.w 13,14,15

    Data.w 16,18,17 ; left
    Data.w 17,18,19

    Data.w 20,22,21 ; right
    Data.w 21,22,23

  CubeTextureCoordinates:
    Data.f 0.00 , 0.00 ; '1' = front
    Data.f 0.25 , 0.00
    Data.f 0.00 , 0.25
    Data.f 0.25 , 0.25

    Data.f 0.25 , 0.00 ; '2' = top
    Data.f 0.50 , 0.00
    Data.f 0.25 , 0.25
    Data.f 0.50 , 0.25

    Data.f 0.50 , 0.00 ; '3' = back
    Data.f 0.75 , 0.00
    Data.f 0.50 , 0.25
    Data.f 0.75 , 0.25

    Data.f 0.75 , 0.00 ; '4' = bottom
    Data.f 1.00 , 0.00
    Data.f 0.75 , 0.25
    Data.f 1.00 , 0.25

    Data.f 0.00 , 0.25 ; '5' = left
    Data.f 0.25 , 0.25
    Data.f 0.00 , 0.50
    Data.f 0.25 , 0.50

    Data.f 0.25 , 0.25 ; '6' = right
    Data.f 0.50 , 0.25
    Data.f 0.25 , 0.50
    Data.f 0.50 , 0.50

  CubeNormals:
    Data.f   0, 0,-1
    Data.f   0, 0,-1
    Data.f   0, 0,-1
    Data.f   0, 0,-1

    Data.f   0,-1, 0
    Data.f   0,-1, 0
    Data.f   0,-1, 0
    Data.f   0,-1, 0

    Data.f   0, 0, 1
    Data.f   0, 0, 1
    Data.f   0, 0, 1
    Data.f   0, 0, 1

    Data.f   0, 1, 0
    Data.f   0, 1, 0
    Data.f   0, 1, 0
    Data.f   0, 1, 0

    Data.f   1, 0, 0
    Data.f   1, 0, 0
    Data.f   1, 0, 0
    Data.f   1, 0, 0

    Data.f  -1, 0, 0
    Data.f  -1, 0, 0
    Data.f  -1, 0, 0
    Data.f  -1, 0, 0


  BorderVertices:
    Data.f  0,1,0 ; Vertex 0
    Data.f -1,1,0 ; Vertex 1
    Data.f  0,0,0 ; Vertex 2
    Data.f -1,0,0 ; Vertex 3
  BorderFaces:
    Data.w  0, 2, 1
    Data.w  1, 2, 3
  BorderTextureCoordinates:
    Data.f 0,0
    Data.f 7,0
    Data.f 0,2
    Data.f 7,2

EndDataSection
Now, where are all this nice importers for .3DS, .MD2, own formats... ?? :D

Posted: Wed Jan 07, 2004 11:07 am
by Psychophanta
I get VB runtime error when choose no fullscreen (with last example and last .dll on Win2000)

Posted: Wed Jan 07, 2004 11:27 am
by Danilo
Somebody in german forum said that it only works in windowed
mode if the resolution is *smaller* than your desktop width/height.

I just tested it and it seems to be true (windowed mode only):
- i can run with 800x600
- i can run with 1024x768
- it CRASHES when i try to run in 1280x1024, which is my desktop resolution.

No problem in fullscreen mode with 1600x1200, always works
in fullscreen.

So if your desktop resolution is 1024x768, try to run it in
800x600 windowed please.

I edited the above code, so its 800x600 by default.


Rings reported that it doesnt crash when he out-comments the
FlipBuffers() command.
Maybe some people can test this too. You dont see the screen
after removing FlipBuffers(), its only for a test to see if its really
FlipBuffers() that crashes here.

Would be nice if we can find and eliminate that thing, so PB3D
works for everybody.

Thanks for your help.

Posted: Wed Jan 07, 2004 11:50 am
by Psychophanta
Tested in 800x600 Desktop resolution and windowed mode: same result. :(

Why VB messages in PB? Puaj! I detest it, cause i come from Amiga BlitzBasic2..... :wink:

Posted: Wed Jan 07, 2004 12:16 pm
by benny
@Danilo:
Yup ... when I comment the FlipBuffer() out , your code doesnt crash.
All times are UTC+01:00
Page 1 of 2

Powered by phpBB® Forum Software © phpBB Limited