I’m having some difficulty with my lighting (in vb). I’m working on a heightmap engine (very primitive at the time), and when the scene is not rotated at all, the lighting works fine. But when I rotate the scene, the lighting dims, and when it’s rotated 180 degrees (facing the “back” of the map), it is incredibly dark. Any help?
Here’s my code:
Option Explicit
‘## TYPE LIBRARY CORRECTIONS ##’
Private Declare Function EnumDisplaySettings Lib “user32” Alias “EnumDisplaySettingsA” (ByVal lpszDeviceName As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib “user32” Alias “ChangeDisplaySettingsA” (lpDevMode As Any, ByVal dwflags As Long) As Long
Private Declare Function CreateIC Lib “gdi32” Alias “CreateICA” (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Long) As Long
Private Const CCDEVICENAME = 32
Private Const CCFORMNAME = 32
Private Const DM_BITSPERPEL = &H40000
Private Const DM_PELSWIDTH = &H80000
Private Const DM_PELSHEIGHT = &H100000
Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Private mPointerCount As Integer
Public Texture() As GLuint
Public mfogMode(2) As GLuint
Public fogfilter As GLuint
Public mfogColor(3) As GLfloat
‘## BITMAP INFO ##’
Private Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Long
bmBitsPixel As Long
bmBits As Long
End Type
Public Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Public Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Public Const GL_BITMAP As Integer = &H1A00
‘## FPS ##’
Private Declare Function GetTickCount Lib “kernel32” () As Long
Dim LastTimeCheckFPS As Long
Dim FramesDrawn As Long
Dim FrameRate As Long
‘## GAME ##’
Private Type TileType
VertexHeight(3) As Single
AverageHeight As Single
End Type
Dim Tile(62, 62) As TileType
Dim Vertex(63, 63) As Single
Dim WaterDisplacement As Single
‘## CAMERA ##’
Public CamZoom As GLfloat
Public CamAngle As GLfloat
Dim CamX As GLfloat
Dim CamZ As GLfloat
‘## KEY BOOLEANS ##’
Public Keys(255) As Boolean
‘## WINDOW ##’
Private hrc As Long
Private FullScreen As Boolean
Private Zoom As Single
‘## ABOUT THE OLD WINDOW ##’
Private OldWidth As Long
Private OldHeight As Long
Private OldBits As Long
Private OldVertRefresh As Long
Private Sub SetupFogArrays()
mfogMode(0) = GL_EXP
mfogMode(1) = GL_EXP2
mfogMode(2) = GL_LINEAR
mfogColor(0) = 1
mfogColor(1) = 1
mfogColor(2) = 1
mfogColor(3) = 1#
End Sub
Public Function LoadGLTextures() As Boolean
Dim sFile As String
Dim bmFile As BITMAPFILEHEADER
Dim bmInfo As BITMAPINFOHEADER
Dim bmRGB() As RGBQUAD
Dim iFile As Integer
Dim lImageSize As Long
Dim iPixelSize As Integer
Dim baImageData() As Byte
Dim a As Integer
ReDim Texture(2)
glGenTextures 2, Texture(0)
For a = 0 To 2
On Error GoTo ERR_H
sFile = App.Path & “\Files\Textures” & a & “.bmp”
iFile = FreeFile
Open sFile For Binary As iFile
Get #iFile, , bmFile
Get #iFile, , bmInfo
If (bmInfo.biBitCount < 24) Then
ReDim bmRGB(bmInfo.biClrUsed)
Get #iFile, , bmRGB
End If
iPixelSize = bmInfo.biBitCount / 8
lImageSize = bmInfo.biWidth * bmInfo.biHeight * iPixelSize
ReDim baImageData(lImageSize)
Get #iFile, , baImageData
Close #iFile
glBindTexture glTexture2D, Texture(a)
glTexParameteri glTexture2D, tpnTextureMagFilter, GL_LINEAR
glTexParameteri glTexture2D, tpnTextureMinFilter, GL_LINEAR_MIPMAP_NEAREST
gluBuild2DMipmaps glTexture2D, 3, bmInfo.biWidth, bmInfo.biHeight, tiBGRExt, _
GL_UNSIGNED_BYTE, ByVal VarPtr(baImageData(0))
Next a
LoadGLTextures = True
EXIT_H:
Erase baImageData
Exit Function
ERR_H:
MsgBox Err.Description
LoadGLTextures = False
Resume EXIT_H
End Function
Private Sub HidePointer()
mPointerCount = ShowCursor(False) + 1
Do While ShowCursor(False) >= -1
Loop
Do While ShowCursor(True) <= -1
Loop
ShowCursor False
End Sub
Private Sub ShowPointer()
Do While ShowCursor(False) >= mPointerCount
Loop
Do While ShowCursor(True) <= mPointerCount
Loop
End Sub
Public Sub ReSizeGLScene(ByVal Width As GLsizei, ByVal Height As GLsizei)
If Height = 0 Then
Height = 1
End If
glViewport 0, 0, Width, Height
glMatrixMode mmProjection
glLoadIdentity
gluPerspective 45#, Width / Height, 1#, 50#
glMatrixMode mmModelView
glLoadIdentity
End Sub
Public Function InitGL() As Boolean
glEnable glcTexture2D
If Not LoadGLTextures() Then GoTo EndInit
glShadeModel smSmooth
glClearDepth 1#
glEnable glcDepthTest
glDepthFunc cfLEqual
glHint htPerspectiveCorrectionHint, hmNicest
Dim aflLightAmbient(4) As GLfloat
Dim aflLightDiffuse(4) As GLfloat
aflLightAmbient(0) = 1#
aflLightAmbient(1) = 1#
aflLightAmbient(2) = 1#
aflLightAmbient(3) = 1#
aflLightDiffuse(0) = 1#
aflLightDiffuse(1) = 1#
aflLightDiffuse(2) = 1#
aflLightDiffuse(3) = 1#
glLightfv ltLight1, lpmDiffuse, aflLightDiffuse(0)
glLightfv ltLight1, lpmAmbient, aflLightAmbient(0)
Dim aflLightDir(4) As GLfloat
aflLightDir(0) = 0#
aflLightDir(1) = -1#
aflLightDir(2) = 0#
aflLightDir(3) = 1
glLightfv ltLight1, lpmPosition, aflLightDir(0)
glEnable glcLighting
glEnable glcLight1
glClearColor 0, 0, 0, 1
glFogf fogMode, mfogMode(1)
glFogfv fogColor, mfogColor(0)
glFogf fogDensity, 0.045
glHint htFogHint, hmNicest
glEnable glcNormalize
InitGL = True
Exit Function
EndInit:
InitGL = False
End Function
Public Function Render() As Boolean
glClear clrColorBufferBit Or clrDepthBufferBit
‘#############’
‘## DRAWING ##’
glLoadIdentity
If CamX < 0 Then CamX = 0
If CamZ < 0 Then CamZ = 0
If CamX > 62 Then CamX = 62
If CamZ > 62 Then CamZ = 62
gluLookAt CamX, Tile(CamX, CamZ).AverageHeight + CamZoom, CamZ + CamZoom, CamX, Tile(CamX, CamZ).AverageHeight, CamZ, 0, 1, 0
glTranslatef CamX, 0, CamZ
glRotatef CamAngle, 0, 1, 0
glTranslatef -CamX, 0, -CamZ
DrawTiles
DrawWater
‘## DRAWING ##’
‘#############’
Render = True
End Function
Private Sub DrawTiles()
On Error Resume Next
Dim x As Long
Dim z As Long
glBindTexture GL_TEXTURE_2D, Texture(2)
glBegin bmQuads
For x = -5 + CamX - CamZoom To 5 + CamX + CamZoom
For z = -5 + CamZ - CamZoom To 5 + CamZ + CamZoom
glTexCoord2i 0#, 0#: glVertex3f x, Tile(x, z).VertexHeight(0), z
glTexCoord2i 1#, 0#: glVertex3f x + 1, Tile(x, z).VertexHeight(1), z
glTexCoord2i 1#, 1#: glVertex3f x + 1, Tile(x, z).VertexHeight(2), z + 1
glTexCoord2i 0#, 1#: glVertex3f x, Tile(x, z).VertexHeight(3), z + 1
Next z
Next x
glEnd
End Sub
Private Sub DrawWater()
Dim a As Long
Dim x As Long
Dim z As Long
glDisable glcFog
glBlendFunc sfSrcAlpha, dfOne
glEnable glcBlend
For x = -5 + CamX - CamZoom To 5 + CamX + CamZoom
For z = -5 + CamZ - CamZoom To 5 + CamZ + CamZoom
For a = 0 To 1
glBindTexture GL_TEXTURE_2D, Texture(a)
glBegin bmQuads
glTexCoord2f x + (-1 + a * 2) * WaterDisplacement, z + (1 + -a * 2) * WaterDisplacement: glVertex3f x, 0.8 + 0.1 * Cos(WaterDisplacement * 12), z
glTexCoord2f (x + 1) + (-1 + a * 2) * WaterDisplacement, z + (1 + -a * 2) * WaterDisplacement: glVertex3f x + 1, 0.8 + 0.1 * Cos(WaterDisplacement * 12), z
glTexCoord2f (x + 1) + (-1 + a * 2) * WaterDisplacement, (z + 1) + (1 + -a * 2) * WaterDisplacement: glVertex3f x + 1, 0.8 + 0.1 * Cos(WaterDisplacement * 12), z + 1
glTexCoord2f x + (-1 + a * 2) * WaterDisplacement, (z + 1) + (1 + -a * 2) * WaterDisplacement: glVertex3f x, 0.8 + 0.1 * Cos(WaterDisplacement * 12), z + 1
glEnd
Next a
Next z
Next x
If FrameRate <> 0 Then WaterDisplacement = WaterDisplacement + 0.05 / FrameRate
glDisable glcBlend
glEnable glcFog
End Sub
Sub Main()
Dim Done As Boolean
Dim frm As Form
Done = False
FullScreen = MsgBox(“Would You Like To Run In Fullscreen Mode?”, vbYesNo + vbQuestion, “Start FullScreen?”) = vbYes
Set frm = New frmMain
SetupFogArrays
If Not CreateGLWindow(frm, 1600, 1200, 32, FullScreen) Then
Done = True
End If
LoadMap 0
CamZoom = 5
Do While Not Done
Dim Speed As GLfloat
If FrameRate <> 0 Then
Speed = 20.5 / FrameRate
Else
Speed = 0.025 * 3 / 4
End If
CamX = CamX + Keys(37) * Speed - Keys(39) * Speed
CamZ = CamZ + Keys(38) * Speed - Keys(40) * Speed
If (Not Render Or Keys(vbKeyEscape)) Then
Unload frm
Else
SwapBuffers (frm.hDC)
DoEvents
End If
If Keys(vbKeyF1) Then
Keys(vbKeyF1) = False
Unload frm
Set frm = New frmMain
FullScreen = Not FullScreen
If Not CreateGLWindow(frm, 1600, 1200, 32, FullScreen) Then
Unload frm
End If
End If
Done = frm.Visible = False
If GetTickCount - LastTimeCheckFPS >= 500 Then
LastTimeCheckFPS = GetTickCount
FrameRate = FramesDrawn * 2
Debug.Print FrameRate
FramesDrawn = 0
End If
FramesDrawn = FramesDrawn + 1
Loop
Set frm = Nothing
End
End Sub
Private Sub LoadMap(Index As Integer)
Open App.Path & “\Files\Maps” & Index & “.slomap” For Binary As #1
Dim x, z, v As Integer
For x = 0 To 63
For z = 0 To 63
Get #1, , Vertex(x, z)
Next z
Next x
Close #1
For x = 0 To 62
For z = 0 To 62
Tile(x, z).VertexHeight(0) = Vertex(x, z)
Tile(x, z).VertexHeight(1) = Vertex(x + 1, z)
Tile(x, z).VertexHeight(2) = Vertex(x + 1, z + 1)
Tile(x, z).VertexHeight(3) = Vertex(x, z + 1)
For v = 0 To 3
Tile(x, z).AverageHeight = Tile(x, z).AverageHeight + Tile(x, z).VertexHeight(v)
Next v
Tile(x, z).AverageHeight = Tile(x, z).AverageHeight / 4
Next z
Next x
End Sub
Public Sub KillGLWindow()
If FullScreen Then
ResetDisplayMode
ShowPointer
End If
If hrc Then
If wglMakeCurrent(0, 0) = 0 Then
MsgBox “Release Of DC And RC Failed.”, vbInformation, “SHUTDOWN ERROR”
End If
If wglDeleteContext(hrc) = 0 Then
MsgBox “Release Rendering Context Failed.”, vbInformation, “SHUTDOWN ERROR”
End If
hrc = 0
End If
End Sub
Private Sub SaveCurrentScreen()
Dim ret As Long
ret = CreateIC(“DISPLAY”, “”, “”, 0&)
OldWidth = GetDeviceCaps(ret, HORZRES)
OldHeight = GetDeviceCaps(ret, VERTRES)
OldBits = GetDeviceCaps(ret, BITSPIXEL)
OldVertRefresh = GetDeviceCaps(ret, VREFRESH)
ret = DeleteDC(ret)
End Sub
Private Function FindDEVMODE(ByVal Width As Integer, ByVal Height As Integer, ByVal Bits As Integer, Optional ByVal VertRefresh As Long = -1) As DEVMODE
Dim ret As Boolean
Dim i As Long
Dim dm As DEVMODE
i = 0
Do
ret = EnumDisplaySettings(0&, i, dm)
If dm.dmPelsWidth = Width And _
dm.dmPelsHeight = Height And _
dm.dmBitsPerPel = Bits And _
((dm.dmDisplayFrequency = VertRefresh) Or (VertRefresh = -1)) Then Exit Do
i = i + 1
Loop Until (ret = False)
FindDEVMODE = dm
End Function
Private Sub ResetDisplayMode()
Dim dm As DEVMODE
dm = FindDEVMODE(OldWidth, OldHeight, OldBits, OldVertRefresh)
dm.dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT
If OldVertRefresh <> -1 Then
dm.dmFields = dm.dmFields Or DM_DISPLAYFREQUENCY
End If
If (ChangeDisplaySettings(dm, CDS_FULLSCREEN) <> DISP_CHANGE_SUCCESSFUL) Then
MsgBox “The Requested Mode Is Not Supported By Your Video Card”, , “Error GL”
End If
End Sub
Private Sub SetDisplayMode(ByVal Width As Integer, ByVal Height As Integer, ByVal Bits As Integer, ByRef FullScreen As Boolean, Optional VertRefresh As Long = -1)
Dim dmScreenSettings As DEVMODE
Dim p As Long
SaveCurrentScreen
dmScreenSettings = FindDEVMODE(Width, Height, Bits, VertRefresh)
dmScreenSettings.dmBitsPerPel = Bits
dmScreenSettings.dmPelsWidth = Width
dmScreenSettings.dmPelsHeight = Height
dmScreenSettings.dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or DM_PELSHEIGHT
If VertRefresh <> -1 Then
dmScreenSettings.dmDisplayFrequency = VertRefresh
dmScreenSettings.dmFields = dmScreenSettings.dmFields Or DM_DISPLAYFREQUENCY
End If
If (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) <> DISP_CHANGE_SUCCESSFUL) Then
If (MsgBox(“The Requested Mode Is Not Supported By” & vbCr & “Your Video Card. Use Windowed Mode Instead?”, vbYesNo + vbExclamation, “Error GL”) = vbYes) Then
FullScreen = False
Else
MsgBox “Program Will Now Close.”, vbCritical, “ERROR”
End
End If
End If
End Sub
Public Function DrawGLScene() As Boolean
glClear clrColorBufferBit Or clrDepthBufferBit
glLoadIdentity
DrawGLScene = True
End Function
Public Function CreateGLWindow(frm As Form, Width As Integer, Height As Integer, Bits As Integer, fullscreenflag As Boolean) As Boolean
Dim PixelFormat As GLuint
Dim pfd As PIXELFORMATDESCRIPTOR
FullScreen = fullscreenflag
If (FullScreen) Then
SetDisplayMode Width, Height, Bits, FullScreen
End If
If FullScreen Then
HidePointer
frm.WindowState = vbMaximized
End If
pfd.cColorBits = Bits
pfd.cDepthBits = 16
pfd.dwflags = PFD_DRAW_TO_WINDOW Or PFD_SUPPORT_OPENGL Or PFD_DOUBLEBUFFER
pfd.iLayerType = PFD_MAIN_PLANE
pfd.iPixelType = PFD_TYPE_RGBA
pfd.nSize = Len(pfd)
pfd.nVersion = 1
PixelFormat = ChoosePixelFormat(frm.hDC, pfd)
If PixelFormat = 0 Then
KillGLWindow
MsgBox “Can’t Find A Suitable PixelFormat.”, vbExclamation, “ERROR”
CreateGLWindow = False
End If
If SetPixelFormat(frm.hDC, PixelFormat, pfd) = 0 Then
KillGLWindow
MsgBox “Can’t Set The PixelFormat.”, vbExclamation, “ERROR”
CreateGLWindow = False
End If
hrc = wglCreateContext(frm.hDC)
If (hrc = 0) Then
KillGLWindow
MsgBox “Can’t Create A GL Rendering Context.”, vbExclamation, “ERROR”
CreateGLWindow = False
End If
If wglMakeCurrent(frm.hDC, hrc) = 0 Then
KillGLWindow
MsgBox “Can’t Activate The GL Rendering Context.”, vbExclamation, “ERROR”
CreateGLWindow = False
End If
frm.Show
SetForegroundWindow frm.hWnd
frm.SetFocus
ReSizeGLScene frm.ScaleWidth, frm.ScaleHeight
If Not InitGL() Then
KillGLWindow
MsgBox “Initialization Failed.”, vbExclamation, “ERROR”
CreateGLWindow = False
End If
CreateGLWindow = True
End Function
If you’re using lighting, you’ll need to specify normals for each vertex so that OpenGL can tell which way your polys are facing.
I did a quick scan but could find no glNormal() or glNormalPointer() in your code …