luisgulo/gambas-source-code
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity
gambas-source-code/app/examples/OpenGL/NeHeTutorial/.src/Example10.module
Benoît Minisini c6a9cd69c2 [EXAMPLES] 
* NEW: Add examples again. I hope correctly this time.


git-svn-id: svn://localhost/gambas/trunk@6726 867c0c6c-44f3-4631-809d-bfa615b0a4ec
2014-12-12 19:58:52 +00:00

389 lines
11 KiB
Text
Raw Blame History

' Gambas module file
'tutorial based on tutorial from NeHe Productions site at http://nehe.gamedev.net/
'visit the page for more info on OpenGL
'
'This tutorial shows how to build 3D world using textured block and defining the building in world.txt file
'To get continuous movement we use timer() and keypress() - keyrelease() functions.
'No collision implemented yet.
' Gambas module file
Const world_x_size As Integer = 16
Const world_y_size As Integer = 16
Const piover180 As Float = 0.0174532925
Private screen As New Window(True) As "Screen"
Private xrot As Float 'X Rotation( NEW )
Private yrot As Float 'Y Rotation( NEW )
Private xspeed As Float 'x rotation speed
Private yspeed As Float 'y rotation speed
' [GB2:ARRD] Private texture As Integer[3] 'storage FOR one texture
Private texture As New Integer[3] 'storage FOR one texture
Private LightAmbient As Float[]
Private LightDiffuse As Float[]
Private LightPosition As Float[]
Private filter As Integer = 0
Private light As Integer = 0
Private blend As Integer = 0
Private walkbias As Float = 0.0
Private walkbiasangle As Float = 0.0
Private lookupdown As Float = 0.0
Private heading As Float
Private xpos As Float
Private zpos As Float
Private mypos_x As Float = 0
Private mypos_z As Float = 20
Private camx As Float = 0.0
Private camy As Float = 0.0
Private camz As Float = 0.0
Private therotate As Float
Private z As Float = - world_x_size - 20.0 'depth into the screen.
Private lp As Integer = 0
Private objlists As Integer
' [GB2:ARRD] Private world As Integer[world_x_size, world_y_size] 'world size 8x8 cube places
Private world As New Integer[world_x_size, world_y_size] 'world size 8x8 cube places
Private up_pressed As Boolean
Private down_pressed As Boolean
Private left_pressed As Boolean
Private right_pressed As Boolean
Private hTimer As New Timer As "Timer1"
Private CTime As Float
Public Sub Main()
Dim i, j As Integer
For i = 0 To world_x_size - 1
For j = 0 To world_y_size - 1
world[i, j] = 0
Next
Next
With screen
.Width = 800
.Height = 600
.Title = MMain.Title
.Show()
End With
CTime = Timer()
hTimer.Delay = 100
hTimer.Enabled = True
End
Public Sub Screen_Open()
LightAmbient = [0.5, 0.5, 0.5, 1.0]
LightDiffuse = [1.0, 1.0, 1.0, 1.0]
LightPosition = [0.0, 0.0, 2.0, 1.0]
Gl.ClearDepth(100.0) 'Enables Clearing Of The Depth Buffer
gl.ClearColor(0.0, 0.0, 0.0, 0.0) 'This Will Clear The Background Color To Black
gl.DepthFunc(gl.LESS) 'The Type Of Depth Test To Do
gl.Enable(gl.DEPTH_TEST) 'Enables Depth Testing
gl.ShadeModel(gl.SMOOTH) 'Enables Smooth Color Shading
init()
End
Public Sub Screen_resize()
Gl.Viewport(0, 0, Screen.Width, Screen.Height)
Gl.MatrixMode(Gl.PROJECTION)
Gl.LoadIdentity() 'Reset The Projection Matrix
glu.Perspective(45.0, screen.Width / screen.Height, 0.1, 100.0) 'Calculate The Aspect Ratio Of The Window
Gl.MatrixMode(Gl.MODELVIEW)
End
Public Sub load_world()
Dim world_file As File
Dim brick As String
Dim wall As String
Dim i, j, k As Integer
world_file = Open "world.txt" For Read
For i = 0 To world_x_size - 2
Read #world_file, wall, world_x_size + 1
For j = 1 To world_y_size
brick = Mid$(wall, j, 1)
If brick = "#" Then world[i, j - 1] = 1
Next
Next
Read #world_file, wall, world_x_size
For j = 1 To world_y_size
brick = Mid$(wall, j, 1)
If brick = "#" Then world[world_x_size - 1, j - 1] = 1
Next
world_file.Close
End
Public Sub load_texture()
Dim wall As Image
Dim floor1 As Image
Dim ceiling As Image
Dim egs As Boolean
gl.Enable(gl.TEXTURE_2D) ' Enable Texture Mapping
texture = Gl.GenTextures(3)
wall = Image.Load("wall.jpeg")
Gl.BindTexture(Gl.TEXTURE_2D, texture[0])
Gl.TexImage2D(wall)
Glu.Build2DMipmaps(wall)
floor1 = Image.Load("floor.png")
Gl.BindTexture(Gl.TEXTURE_2D, texture[1])
Gl.TexImage2D(Floor1)
Glu.Build2DMipmaps(Floor1)
ceiling = Image.Load("ceiling.png")
Gl.BindTexture(Gl.TEXTURE_2D, texture[2])
Gl.TexImage2D(ceiling)
Glu.Build2DMipmaps(ceiling)
Gl.TexParameteri(Gl.TEXTURE_2D, Gl.TEXTURE_MIN_FILTER, Gl.LINEAR_MIPMAP_NEAREST)
Gl.TexParameteri(Gl.TEXTURE_2D, Gl.TEXTURE_MAG_FILTER, Gl.LINEAR)
End
Public Sub init()
load_world()
load_texture()
gl.Enable(gl.TEXTURE_2D) ' Enable Texture Mapping( NEW )
gl.ShadeModel(gl.SMOOTH) ' Enable Smooth Shading
gl.ClearColor(0.0, 0.0, 0.0, 0.0) ' Black Background
gl.ClearDepth(2.0) ' Depth Buffer Setup
gl.Enable(gl.DEPTH_TEST) ' Enables Depth Testing
gl.DepthFunc(gl.LESS) ' The Type OF Depth Testing TO DO
gl.MatrixMode(gl.PROJECTION)
gl.LoadIdentity() 'Reset The Projection Matrix
glu.Perspective(45.0, screen.Width / screen.Height, 0.1, 100.0) 'Calculate The Aspect Ratio Of The Window
gl.MatrixMode(gl.MODELVIEW)
gl.Lightfv(gl.LIGHT1, gl.AMBIENT, LightAmbient) ' add lighting.(ambient)
gl.Lightfv(gl.LIGHT1, gl.DIFFUSE, LightDiffuse) ' add lighting.(diffuse).
gl.Lightfv(gl.LIGHT1, gl.POSITION, LightPosition) ' set light position.
gl.Enable(gl.LIGHT1)
objlists = Gl.GenLists(3)
Gl.NewList(objlists, Gl.COMPILE)
gl.BindTexture(gl.TEXTURE_2D, texture[0]) ' SELECT Our Texture
Gl.Begin(Gl.QUADS)
gl.Normal3f(0.0, 0.0, 1.0) 'front face
Gl.TexCoordf(0.0, 1.0)
Gl.Vertexf(-1.0, 0.0, 1.0)
Gl.TexCoordf(1.0, 1.0)
Gl.Vertexf(1.0, 0.0, 1.0)
Gl.TexCoordf(1.0, 0.0)
Gl.Vertexf(1.0, 4.0, 1.0)
Gl.TexCoordf(0.0, 0.0)
Gl.Vertexf(-1.0, 4.0, 1.0)
gl.Normal3f(0.0, 0.0, -1.0) 'back face
Gl.TexCoordf(1.0, 1.0)
Gl.Vertexf(-1.0, 0.0, -1.0)
Gl.TexCoordf(1.0, 0.0)
Gl.Vertexf(-1.0, 4.0, -1.0)
Gl.TexCoordf(0.0, 0.0)
Gl.Vertexf(1.0, 4.0, -1.0)
Gl.TexCoordf(0.0, 1.0)
Gl.Vertexf(1.0, 0.0, -1.0)
gl.Normal3f(0.0, 1.0, 0.0) ' top face - no need for texture
Gl.Vertexf(-1.0, 4.0, -1.0)
Gl.Vertexf(-1.0, 4.0, 1.0)
Gl.Vertexf(1.0, 4.0, 1.0)
Gl.Vertexf(1.0, 4.0, -1.0)
gl.Normal3f(0.0, 0.0, 0.0) 'bottom face - no textutre
Gl.Vertexf(-1.0, 0.0, -1.0)
Gl.Vertexf(1.0, 0.0, -1.0)
Gl.Vertexf(1.0, 0.0, 1.0)
Gl.Vertexf(-1.0, 0.0, 1.0)
gl.Normal3f(1.0, 0.0, 0.0) 'right face
Gl.TexCoordf(1.0, 1.0)
Gl.Vertexf(1.0, 0.0, -1.0)
Gl.TexCoordf(1.0, 0.0)
Gl.Vertexf(1.0, 4.0, -1.0)
Gl.TexCoordf(0.0, 0.0)
Gl.Vertexf(1.0, 4.0, 1.0)
Gl.TexCoordf(0.0, 1.0)
Gl.Vertexf(1.0, 0.0, 1.0)
gl.Normal3f(-1.0, 0.0, 0.0) 'left face
Gl.TexCoordf(0.0, 1.0)
Gl.Vertexf(-1.0, 0.0, -1.0)
Gl.TexCoordf(1.0, 1.0)
Gl.Vertexf(-1.0, 0.0, 1.0)
Gl.TexCoordf(1.0, 0.0)
Gl.Vertexf(-1.0, 4.0, 1.0)
Gl.TexCoordf(0.0, 0.0)
Gl.Vertexf(-1.0, 4.0, -1.0)
Gl.End()
gl.EndList()
Gl.NewList(objlists + 1, Gl.COMPILE)
gl.BindTexture(gl.TEXTURE_2D, texture[1]) ' SELECT Our Texture
gl.Begin(gl.QUADS)
Gl.TexCoordf(0.0, 1.0)
gl.Vertex3f(-1, 0, world_y_size * 2 - 1)
Gl.TexCoordf(1.0, 1.0)
gl.Vertex3f(world_x_size * 2 - 1, 0, world_y_size * 2 - 1)
Gl.TexCoordf(1.0, 0.0)
gl.Vertex3f(world_x_size * 2 - 1, 0, 1)
Gl.TexCoordf(0.0, 0.0)
gl.Vertex3f(-1, 0, 1)
gl.End()
Gl.EndList()
Gl.NewList(objlists + 2, Gl.COMPILE)
gl.BindTexture(gl.TEXTURE_2D, texture[2]) ' SELECT Our Texture
gl.Begin(gl.QUADS)
Gl.TexCoordf(0.0, 0.0)
gl.Vertex3f(-1, 4, 1)
Gl.TexCoordf(0.0, 1.0)
gl.Vertex3f(world_x_size * 2 - 1, 4, 1)
Gl.TexCoordf(1.0, 1.0)
gl.Vertex3f(world_x_size * 2 - 1, 4, world_y_size * 2 - 1)
Gl.TexCoordf(1.0, 0.0)
gl.Vertex3f(-1, 4, world_y_size * 2 - 1)
gl.End()
Gl.EndList()
End
Public Sub Screen_draw()
Dim i, j, k As Integer
Dim x_m, y_m, z_m, u_m, v_m As Float
Dim xtrans, ztrans, ytrans As Float
Dim sceneroty As Float
xtrans = - xpos
ztrans = - zpos
ytrans = - walkbias - 0.25
sceneroty = 360.0 - yrot
gl.LoadIdentity()
gl.Clear(gl.COLOR_BUFFER_BIT Or gl.DEPTH_BUFFER_BIT) ' Clear Screen AND Depth Buffer
For i = 0 To world_x_size - 1
For j = 0 To world_y_size - 1
k = 0
k = world[i, j]
gl.LoadIdentity()
gl.Rotatef(camy, 0, 1, 0)
gl.Rotatef(camz, 1, 0, 0)
gl.Rotatef(lookupdown, 1.0, 0, 0)
gl.Rotatef(sceneroty, 0, 1.0, 0)
gl.Translatef(xtrans, ytrans, z + ztrans)
gl.Translatef(j * 2, -2.5, i * 2)
If k = 1 Then Gl.CallList(objlists)
Next
Next
gl.LoadIdentity()
gl.Rotatef(camy, 0, 1, 0)
gl.Rotatef(camz, 1, 0, 0)
gl.Rotatef(lookupdown, 1.0, 0, 0)
gl.Rotatef(sceneroty, 0, 1.0, 0)
gl.Translatef(xtrans, ytrans - 2.5, z + ztrans)
gl.CallList(objlists + 1)
gl.LoadIdentity()
gl.Rotatef(camy, 0, 1, 0)
gl.Rotatef(camz, 1, 0, 0)
gl.Rotatef(lookupdown, 1.0, 0, 0)
gl.Rotatef(sceneroty, 0, 1.0, 0)
gl.Translatef(xtrans, ytrans - 2.5, z + ztrans)
gl.CallList(objlists + 2)
End
Public Sub screen_KeyRelease()
up_pressed = False
down_pressed = False
left_pressed = False
right_pressed = False
End
Public Sub Screen_keyPress()
If (key.code = key.F1) Then screen.Fullscreen = Not screen.Fullscreen
If (key.Code = key.Esc) Then Screen.Close()
If (key.text = "l" Or key.Text = "L") Then
If lp = 0 Then gl.Enable(gl.LIGHTing)
If lp = 1 Then gl.Disable(gl.LIGHTing)
lp = 1 - lp
Endif
If (key.code = key.PageUp) Then
z -= 0.2
mypos_z = +0.2
lookupdown -= 0.2
Endif
If (key.code = key.Pagedown) Then
z += 0.2
mypos_z -= 0.2
lookupdown += 1.0
Endif
If (key.code = key.UP) Then up_pressed = True
If (key.code = key.DOWN) Then down_pressed = True
If (key.code = key.LEFT) Then left_pressed = True
If (key.code = key.RIGHT) Then right_pressed = True
End
Public Sub Timer1_Timer()
If up_pressed = True Then
'IF (world[Round(mypos_x + 0.2), Round(mypos_z + 0.2)] = 0) THEN
xpos -= Sin(yrot * piover180) '* 0.5
'mypos_x += Sin(yrot * piover180) * 0.5
zpos -= Cos(yrot * piover180) '* 0.5
'mypos_z += Cos(yrot * piover180) * 0.5
If (walkbiasangle >= 359.0) Then
walkbiasangle = 0.0
Else
walkbiasangle += 10
Endif
walkbias = Sin(walkbiasangle * piover180) / 20.0
'ENDIF
Endif
If down_pressed = True Then
'IF (world[Round(mypos_x + 0.2), Round(mypos_z + 0.2)] = 0) THEN
xpos += Sin(yrot * piover180) '* 0.5
' mypos_x -= Sin(yrot * piover180) * 0.5
zpos += Cos(yrot * piover180) '* 0.5
'mypos_z -= Cos(yrot * piover180) * 0.5
If (walkbiasangle <= 1.0) Then
walkbiasangle = 359.0
Else
walkbiasangle -= 10
Endif
walkbias = Sin(walkbiasangle * piover180) / 20.0
'ENDIF
Endif
If left_pressed = True Then yrot += 3.5
If right_pressed = True Then yrot -= 3.5
End
'PUBLIC SUB Screen_MouseMove()
'camy += Mouse.Relativex
'camz += Mouse.RelativeY
' END
Reference in a new issue View git blame Copy permalink