PureBoard

Code: Alles auswählen

;
; 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,"3D Mesh Test",WIN_FLAGS)
    If OpenWindowedScreen(WindowID(0),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,20)
    SetMeshData(0,#PB_Mesh_Vertex            ,@Vertices()          ,#Z_COUNT*#X_COUNT*4)
    SetMeshData(0,#PB_Mesh_Face             ,@Triangles()         ,#Z_COUNT*#X_COUNT*2)
    SetMeshData(0,#PB_Mesh_UVCoordinate,@TextureCoordinates(),#Z_COUNT*#X_COUNT*4)
    SetMeshData(0,#PB_Mesh_Normal      ,@Normals()           ,#Z_COUNT*#X_COUNT*4)
    SetMeshData(0,#PB_Mesh_Color       ,@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(a+64-TextWidth(Str(z))/2,b+35,Str(z)+".",$0000FF)
      Next a
    Next b
    StopDrawing()
  EndIf

  ; set cube mesh data
  If CreateMesh(1,20)
    SetMeshData(1,#PB_Mesh_Vertex     ,?CubeVertices          ,6*4)
    SetMeshData(1,#PB_Mesh_Face    ,?CubeFacesIndexes      ,6*2)
    SetMeshData(1,#PB_Mesh_UVCoordinate,?CubeTextureCoordinates,6*4)
    SetMeshData(1,#PB_Mesh_Normal      ,?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,20)=0
      ShowError("mesh")
    EndIf

    SetMeshData(6+a,#PB_Mesh_Vertex     ,?BorderVertices          ,4)
    SetMeshData(6+a,#PB_Mesh_Face    ,?BorderFaces             ,2)
    SetMeshData(6+a,#PB_Mesh_UVCoordinate,?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($40FF00):DrawingFont(SmallFont)
        DrawText(15,15,"F1     : HideText")
        DrawText(15,30,"F2     : RenderMode")
        DrawText(15,45,"F3+F4  : FOV")
        DrawText(250,15,"CameraX: "+RSet(StrF(CameraX(0),2),6,"0"))
        DrawText(250,30,"CameraY: "+RSet(StrF(CameraY(0),2),6,"0"))
        DrawText(250,45,"CameraZ: "+RSet(StrF(CameraZ(0),2),6,"0"))
        StopDrawing()
      EndIf
    EndIf

    ; show it
    FlipBuffers()
    ClearScreen($000000)
    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