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
;
#Deg2Rad = #PI/180
Structure Angle
x.f
y.f
z.f
EndStructure
Structure Vertex
px.f
py.f
pz.f
nx.f
ny.f
nz.f
co.l
u.f
v.f
EndStructure
Structure _Ground
Vertex1.Vertex
Vertex2.Vertex
Vertex3.Vertex
Vertex4.Vertex
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
Procedure.f DSin(angle_in_degree.f)
; returns Sinus of 'angle in degree'
ProcedureReturn Sin(angle_in_degree*#Deg2Rad)
EndProcedure
Procedure.f DCos(angle_in_degree.f)
; returns CoSinus of 'angle in degree'
ProcedureReturn Cos(angle_in_degree*#Deg2Rad)
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._Ground(#Z_COUNT-1,#X_COUNT-1)
Dim Triangles._Triangles(#Z_COUNT-1,#X_COUNT-1)
For x = 0 To #X_COUNT-1
For z = 0 To #Z_COUNT-1
Vertices(z,x)\Vertex1\px = x
Vertices(z,x)\Vertex1\py = 0
Vertices(z,x)\Vertex1\pz = z
Vertices(z,x)\Vertex2\px = x+1
Vertices(z,x)\Vertex2\py = 0
Vertices(z,x)\Vertex2\pz = z
Vertices(z,x)\Vertex3\px = x+1
Vertices(z,x)\Vertex3\py = 0
Vertices(z,x)\Vertex3\pz = z+1
Vertices(z,x)\Vertex4\px = x
Vertices(z,x)\Vertex4\py = 0
Vertices(z,x)\Vertex4\pz = z+1
Vertices(z,x)\Vertex1\nx = 0
Vertices(z,x)\Vertex1\ny = 2
Vertices(z,x)\Vertex1\nz = 0
Vertices(z,x)\Vertex2\nx = 0
Vertices(z,x)\Vertex2\ny = 2
Vertices(z,x)\Vertex2\nz = 0
Vertices(z,x)\Vertex3\nx = 0
Vertices(z,x)\Vertex3\ny = 2
Vertices(z,x)\Vertex3\nz = 0
Vertices(z,x)\Vertex4\nx = 0
Vertices(z,x)\Vertex4\ny = 2
Vertices(z,x)\Vertex4\nz = 0
Vertices(z,x)\Vertex1\co = Random($FFFFFF)
Vertices(z,x)\Vertex2\co = Random($FFFFFF)
Vertices(z,x)\Vertex3\co = Random($FFFFFF)
Vertices(z,x)\Vertex4\co = Random($FFFFFF)
Vertices(z,x)\Vertex1\u = 0.0
Vertices(z,x)\Vertex1\v = 0.0
Vertices(z,x)\Vertex2\u = 1.0
Vertices(z,x)\Vertex2\v = 0.0
Vertices(z,x)\Vertex3\u = 1.0
Vertices(z,x)\Vertex3\v = 1.0
Vertices(z,x)\Vertex4\u = 0.0
Vertices(z,x)\Vertex4\v = 1.0
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
Next
Next
If CreateMesh(0,100)
Flag = #PB_Mesh_Vertex|#PB_Mesh_Normal|#PB_Mesh_Color|#PB_Mesh_UVCoordinate
SetMeshData(0,Flag ,@Vertices() , #Z_COUNT*#X_COUNT*4)
SetMeshData(0,#PB_Mesh_Face,@Triangles(), #Z_COUNT*#X_COUNT*2)
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,$FFFFFF)
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.0/#X_COUNT,1,254.0/#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)
FrontColor(RGB($00,$00,$FF))
DrawText(a+64-TextWidth(Str(z))/2,b+35,Str(z)+".")
Next a
Next b
StopDrawing()
EndIf
; set cube mesh data
If CreateMesh(1,100)
Flag = #PB_Mesh_Vertex|#PB_Mesh_UVCoordinate|#PB_Mesh_Normal
SetMeshData(1,Flag ,?CubeVertices ,6*4)
SetMeshData(1,#PB_Mesh_Face,?CubeFacesIndexes ,6*2)
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,100)=0
ShowError("mesh")
EndIf
Flag = #PB_Mesh_Vertex|#PB_Mesh_UVCoordinate
SetMeshData(6+a,Flag ,?BorderVertices ,4)
SetMeshData(6+a,#PB_Mesh_Face,?BorderFaces ,2)
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.f = 70
CameraFOV(0,FOV*#Deg2Rad)
; 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_()
Define.Angle a1,a2,a3,a4,a5
Define.l
; 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*#Deg2Rad):EndIf
If KeyboardPushed(#PB_Key_F4)
FOV + 1 : If FOV > 120:FOV=120:EndIf
CameraFOV(0,FOV*#Deg2Rad):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
If KeyboardPushed(#PB_Key_F5)
Ground!1 : 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,a1\x,a1\y,a1\z) : a1\x + 2 : a1\y - 4 : a1\z - 1
RotateEntity(2,a2\x,a2\y,a2\z) : a2\x + 4 : a2\y + 2 : a2\z + 8
RotateEntity(3,a3\x,a3\y,a2\z) : a3\x - 4 : a3\y - 2 : a3\z - 8
RotateEntity(4,a4\x,a4\y,a4\z) : a4\x + 1 : a4\y + 1 : a4\z + 1
RotateEntity(5,a5\x,a5\y,a5\z) : a5\x + 3 : a5\y + 4 : a5\z + 5
; info text
If HideText=0
If StartDrawing(ScreenOutput())
DrawingMode(1):FrontColor(RGB($40,$FF,$00)):DrawingFont(SmallFont)
DrawText(15,15,"F1 : HideText")
DrawText(15,30,"F2 : RenderMode")
DrawText(15,45,"F3+F4 : FOV")
DrawText(15,60,"F5 : Ground")
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
If Ground
MaterialAmbientColor(0, #PB_Material_AmbientColors);Use White texture to see all colors
Else
MaterialAmbientColor(0, RGB($90,$90,$00))
EndIf
; show it
FlipBuffers()
ClearScreen(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 0, 0,-1
Data.f 0.00 , 0.00 ; '1' = front
Data.f -1, 1,-1 ; Vertex 1
Data.f 0, 0,-1
Data.f 0.25 , 0.00
Data.f 1,-1,-1 ; Vertex 2
Data.f 0, 0,-1
Data.f 0.00 , 0.25
Data.f -1,-1,-1 ; Vertex 3
Data.f 0, 0,-1
Data.f 0.25 , 0.25
Data.f 1, 1, 1 ; Vertex 4
Data.f 0,-1, 0
Data.f 0.25 , 0.00 ; '2' = top
Data.f -1, 1, 1 ; Vertex 5
Data.f 0,-1, 0
Data.f 0.50 , 0.00
Data.f 1, 1,-1 ; Vertex 6
Data.f 0,-1, 0
Data.f 0.25 , 0.25
Data.f -1, 1,-1 ; Vertex 7
Data.f 0,-1, 0
Data.f 0.50 , 0.25
Data.f 1,-1, 1 ; Vertex 8
Data.f 0, 0, 1
Data.f 0.50 , 0.00 ; '3' = back
Data.f -1,-1, 1 ; Vertex 9
Data.f 0, 0, 1
Data.f 0.75 , 0.00
Data.f 1, 1, 1 ; Vertex 10
Data.f 0, 0, 1
Data.f 0.50 , 0.25
Data.f -1, 1, 1 ; Vertex 11
Data.f 0, 0, 1
Data.f 0.75 , 0.25
Data.f 1,-1,-1 ; Vertex 12
Data.f 0, 1, 0
Data.f 0.75 , 0.00 ; '4' = bottom
Data.f -1,-1,-1 ; Vertex 13
Data.f 0, 1, 0
Data.f 1.00 , 0.00
Data.f 1,-1, 1 ; Vertex 14
Data.f 0, 1, 0
Data.f 0.75 , 0.25
Data.f -1,-1, 1 ; Vertex 15
Data.f 0, 1, 0
Data.f 1.00 , 0.25
Data.f 1, 1, 1 ; Vertex 16
Data.f 1, 0, 0
Data.f 0.00 , 0.25 ; '5' = left
Data.f 1, 1,-1 ; Vertex 17
Data.f 1, 0, 0
Data.f 0.25 , 0.25
Data.f 1,-1, 1 ; Vertex 18
Data.f 1, 0, 0
Data.f 0.00 , 0.50
Data.f 1,-1,-1 ; Vertex 19
Data.f 1, 0, 0
Data.f 0.25 , 0.50
Data.f -1, 1,-1 ; Vertex 20
Data.f -1, 0, 0
Data.f 0.25 , 0.25 ; '6' = right
Data.f -1, 1, 1 ; Vertex 21
Data.f -1, 0, 0
Data.f 0.50 , 0.25
Data.f -1,-1,-1 ; Vertex 22
Data.f -1, 0, 0
Data.f 0.25 , 0.50
Data.f -1,-1, 1 ; Vertex 23
Data.f -1, 0, 0
Data.f 0.50 , 0.50
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
BorderVertices:
Data.f 0,1,0 ; Vertex 0
Data.f 0,0
Data.f -1,1,0 ; Vertex 1
Data.f 7,0
Data.f 0,0,0 ; Vertex 2
Data.f 0,2
Data.f -1,0,0 ; Vertex 3
Data.f 7,2
BorderFaces:
Data.w 0, 2, 1
Data.w 1, 2, 3
EndDataSection