'Open GL wrapper, alpha release 1.0, JohnK, lots of help from FreeBasic Developers, and of course SGI $IFNDEF __GL_inc $INCLUDE <\GL\gl.inc> $INCLUDE $ENDIF $IFNDEF __glwgl_inc declare function wglCreateContext lib "opengl32" alias "wglCreateContext" (BYVAL dw1 as long) as long declare sub wglDeleteContext lib "opengl32" alias "wglDeleteContext"(BYVAL dw1 as long) declare sub wglMakeCurrent lib "opengl32" alias "wglMakeCurrent"(BYVAL dw1 as long, BYVAL dw2 as long) $ENDIF $IFNDEF __WIN32API ' pixel builder type PIXELFORMATDESCRIPTOR nSize as word nVersion as word dwFlags as dword iPixelType As Byte cColorBits As Byte cRedBits As Byte cRedShift As Byte cGreenBits As Byte cGreenShift As Byte cBlueBits As Byte cBlueShift As Byte cAlphaBits As Byte cAlphaShift As Byte cAccumBits As Byte cAccumRedBits As Byte cAccumGreenBits As Byte cAccumBlueBits As Byte cAccumAlphaBits As Byte cDepthBits As Byte cStencilBits As Byte cAuxBuffers As Byte iLayerType As Byte bReserved As Byte dwLayerMask as dword dwVisibleMask as dword dwDamageMask as dword end type ' import gdi32.dll declare function ChoosePixelFormat lib "gdi32" alias "ChoosePixelFormat" (BYVAL dw1 as long, dw2 as PIXELFORMATDESCRIPTOR) as long Declare Function SetPixelFormat Lib "gdi32" Alias "SetPixelFormat" (ByVal hDC As Long, ByVal n As Long, pcPixelFormatDescriptor As PIXELFORMATDESCRIPTOR) As Long Declare Function SwapBuffers Lib "gdi32" Alias "SwapBuffers" (ByVal hDC As Long) As Long $IFNDEF __RQINC2 'rapidQ2 includes ' import user32.dll declare function GetDC lib "user32" alias "GetDC" (BYVAL dw1 as long) as long declare sub ReleaseDC lib "user32" alias "ReleaseDC" (BYVAL dw1 as long, BYVAL dw2 as long) $ENDIF 'rapidQ2.inc $ENDIF 'windows inc $DEFINE PFD_MAIN_PLANE 0 $DEFINE PFD_TYPE_RGBA 0 $DEFINE PFD_DOUBLEBUFFER 1 $DEFINE PFD_DRAW_TO_WINDOW 4 $DEFINE PFD_SUPPORT_OPENGL &H20 $DEFINE PFD_DRAW_TO_BITMAP &H00000008 $DEFINE PFD_SUPPORT_GDI &H00000010 $DEFINE PFD_GENERIC_ACCELERATED &H00001000 $DEFINE PFD_SUPPORT_DIRECTDRAW &H00002000 '=========== The main object now... =================== DIM QGLinternalBMP AS QBITMAPEX TYPE QGL EXTENDS QOBJECT PRIVATE: OrigWidth AS INTEGER OrigHeight AS INTEGER ParentHandle AS LONG FPSTimer AS QTIMER 'periodic update of Frames/sec FrameCount AS DWORD 'this keeps track of Frames for FPS PUBLIC: RenderToBitMap AS INTEGER PROPERTY SET Set_RenderToBitmap Bitmap AS QBITMAP 'for rendering to a bmp Width AS INTEGER Height AS INTEGER Front AS GLdouble 'front and back clipping planes Back AS GLdouble MipMap AS INTEGER FullScreen AS INTEGER PROPERTY SET Set_FullScreen hDC AS LONG 'handle to device context (DC) in the parent window hBMP AS LONG 'handle to BMP (device context handle) hglRC AS LONG 'OpenGL specific -- rendering context (like a handle to DC) hGLRC_bmp AS LONG 'OpenGL rendering context to bitmap 'a rendering context is like a windows DC fix for OpenGL bpp AS INTEGER 'bits per pixel of screen DepthBits AS INTEGER StencilBits AS INTEGER 'set the depth, stencil, and accum bit resolutions AccumBits AS INTEGER ' FrameRate AS SINGLE FOV AS DOUBLE 'field of view AspectRatio AS DOUBLE FogEnabled AS INTEGER PROPERTY SET Set_FogEnabled FogMode AS INTEGER PROPERTY SET Set_FogMode '************************************************************************** ' Set OpenGL viewport using width and height of GL form -- our drawing boundries '************************************************************************** SUB ReSize(width AS INTEGER, height AS INTEGER) 'adjusts the viewport onResize IF height > 0 THEN QGL.Height = height 'Prevent Divide By Zero error IF width > 0 THEN QGL.width = width glViewport(0,0, width, height) 'viewport doesn't have to be whole form END IF END IF ' ********* Calculate The Aspect Ratio Of The Window **************** ' The parameters are (view angle, aspect ration of the width to the height,closest camera distance before clipping ' FOV deg in y-direction /Aspect Ratio =FOV in x-direction/ dist to Near clipping plane/ dist to far clipping Plane glMatrixMode GL_PROJECTION '' Select The Projection Matrix glLoadIdentity '' Reset The Projection Matrix gluPerspective(QGL.FOV, (QGL.AspectRatio * width/height), QGL.Front, QGL.Back) glMatrixMode (GL_MODELVIEW) END SUB '************************************************************************************************** 'initalize the interface to windows: ' Run this at the Form.OnShow event and pass the Qform that will be drawn '**************************************************************************************************** ' FUNCTION Init(MainForm AS QFORM) AS INTEGER DIM pf AS PIXELFORMATDESCRIPTOR DIM Hresult AS LONG RESULT = 0 'returns TRUE on suceed QGL.ParentHandle = MainForm.Handle 'store this for closing IF QGL.Width = 0 THEN QGL.Width = MainForm.ClientWidth IF QGL.Height = 0 THEN QGL.Height = MainForm.ClientHeight QGL.hDC = GetDC(MainForm.Handle) 'global DC,don't free this hdc until the end of our program pf.nSize = SIZEOF(pf) pf.nVersion = 1 pf.dwFlags = PFD_DRAW_TO_WINDOW OR _ PFD_SUPPORT_OPENGL OR _ PFD_DOUBLEBUFFER OR _ 'don't add PFD_USE_GDI PFD_GENERIC_ACCELERATED 'last flag probably won't work pf.dwLayerMask = PFD_MAIN_PLANE pf.iPixelType = PFD_TYPE_RGBA 'RGB and Alpha pixel type 'color bitplanes in each color buffer. For RGBA pixel = size of the color buffer excluding the alpha IF QGL.bpp < 32 THEN pf.cColorBits = 24 ELSE pf.cColorBits = QGL.bpp pf.cDepthBits = QGL.DepthBits 'Depthbits is ignored for RGBA, but we do it anyway pf.cAccumBits = QGL.AccumBits 'No special bitplanes needed pf.cStencilBits = QGL.stencilBits pf.iLayerType = PFD_MAIN_PLANE Hresult = ChoosePixelFormat(QGL.hDC, pf) IF Hresult = 0 THEN EXIT FUNCTION 'pixel format failed IF SetPixelFormat(QGL.hDC, Hresult, pf) = 0 THEN EXIT FUNCTION QGL.hglRC = wglCreateContext(QGL.hDC) 'create a rendering context from our hdc wglMakeCurrent (QGL.hDC, QGL.hglRC) 'make it the one drawn on RESULT = QGL.hDC END FUNCTION PROPERTY SET Set_RenderToBitmap(TheState AS INTEGER) DIM pf AS PIXELFORMATDESCRIPTOR DIM Hresult AS LONG IF TheState = False THEN IF QGL.hGLRC_bmp THEN wglMakeCurrent (QGL.hDC, QGL.hglRC) wglDeleteContext QGL.hGLRC_bmp QGL.Bitmap.Width = 0 'deallocate mem! QGL.Bitmap.Height = 0 END IF ELSE IF QGL.Bitmap.Width = 0 THEN QGL.Bitmap.Width = QGL.Width QGL.Bitmap.Height = QGL.Height IF QGL.bpp = 32 THEN QGL.Bitmap.PixelFormat = pf32Bit ELSE QGL.bpp = 24 QGL.Bitmap.PixelFormat = pf24Bit 'only support 24 bit or higher END IF END IF pf.nSize = SIZEOF(pf): pf.nVersion = 1 pf.dwFlags = PFD_SUPPORT_OPENGL OR _ PFD_SUPPORT_GDI OR _ PFD_DRAW_TO_BITMAP OR _ PFD_GENERIC_ACCELERATED 'last flag probably won't work pf.iPixelType = PFD_TYPE_RGBA 'RGB and Alpha pixel type 'color bitplanes in each color buffer. For RGBA pixel = size of the color buffer excluding the alpha pf.cColorBits = QGL.bpp pf.cDepthBits = QGL.DepthBits 'Depthbits is ignored for RGBA, but we do it anyway pf.cAccumBits = QGL.AccumBits 'No special bitplanes needed pf.cStencilBits = QGL.stencilBits pf.iLayerType = PFD_MAIN_PLANE pf.dwLayerMask = PFD_MAIN_PLANE QGL.hBMP = QGL.Bitmap.handle Hresult = ChoosePixelFormat(QGL.hBMP, pf) IF (Hresult = 0) THEN Showmessage "Render to Bitmap Failed" 'pixel format failed ELSE IF SetPixelFormat(QGL.hBMP, Hresult, pf) <> 0 THEN QGL.hGLRC_bmp = wglCreateContext(QGL.hBMP) 'create a rendering context from bitmap handle wglMakeCurrent (QGL.hBMP, QGL.hGLRC_bmp) 'set up a DIB context for openGL screen END IF END IF END IF QGL.RenderToBitmap = TheState END PROPERTY '************************************************************************** ' Properly exit from the program and release device context (DC) ' only at program end. '************************************************************************** SUB Close() 'must run at end to free resources IF QGL.FullScreen THEN QGL.bpp = Screen.GetPixelDepth Screen.SetResolution(QGL.OrigWidth, QGL.OrigHeight, QGL.bpp, 0) END IF IF QGL.hGLRC_bmp THEN wglDeleteContext QGL.hGLRC_bmp END IF IF QGL.hglRC THEN wglMakeCurrent 0, 0 wglDeleteContext QGL.hglRC IF QGL.hDC THEN ReleaseDC QGL.ParentHandle, QGL.hDC END IF END SUB SUB Flip SwapBuffers GL.hDC ' flip the screen QGL.FrameCount++ IF QGL.FrameCount > 32767 THEN QGL.FrameCount = 1 END SUB PROPERTY SET Set_FullScreen(GoFull AS INTEGER) IF QGL.Width > 319 AND QGL.Height > 239 THEN IF GoFull = True THEN QGL.bpp = Screen.GetPixelDepth IF Screen.SetResolution(QGL.Width, QGL.Height, QGL.bpp, 0) <> DISP_CHANGE_SUCCESSFUL THEN 'failed, menus, statusbar... SELECT CASE QGL.Width CASE IS < 641 Screen.SetResolution(640, 480, QGL.bpp, 0) CASE < 801 Screen.SetResolution(800, 600, QGL.bpp, 0) CASE ELSE Screen.SetResolution(1024, 768, QGL.bpp, 0) END SELECT END IF ELSE QGL.bpp = Screen.GetPixelDepth Screen.SetResolution(QGL.OrigWidth, QGL.OrigHeight, QGL.bpp, 0) END IF QGL.FullScreen = GoFull END IF END PROPERTY PRIVATE: FUNCTION GL_GenerateTexture() AS LONG DIM tex AS GLuint DIM ClrBits AS GLint DIM format AS GLenum DIM NotBMP As INTEGER RESULT = 0 'texture ok size?, powers of 2? IF(QGLinternalBMP.Width < 2) OR (QGLinternalBMP.Height < 2) THEN EXIT FUNCTION ' IF(QGLinternalBMP.Width AND (QGLinternalBMP.Width-1)) OR _ ' (QGLinternalBMP.Height AND (QGLinternalBMP.Height-1)) THEN EXIT FUNCTION 'generate and bind the texture, openGl keeps track glGenTextures 1, tex glBindTexture GL_TEXTURE_2D, tex '' Swap R and B so we can use the GL_RGBA texture format? SELECT CASE QGLinternalBMP.PixelFormat CASE pf32Bit ClrBits = 4 format = GL_BGRA 'typical GL_RGBA but we are in windows CASE pf24bit ClrBits = 3 format = GL_BGR 'typical GL_RGB but we are in windows CASE pf16bit QGLinternalBMP.PixelFormat = pf24bit ClrBits = 3 format = GL_BGR 'typical GL_RGB but we are in windows CASE pf8bit 'only 24 bit supported... ' ClrBits = 1 ' format = GL_COLOR_INDEX QGLinternalBMP.PixelFormat = pf24bit ClrBits = 3 format = GL_BGR 'typical GL_RGB but we are in windows END SELECT IF QGL.MipMap THEN ' glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT) ' glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT) gluBuild2DMipmaps(GL_TEXTURE_2D, ClrBits,_ QGLinternalBMP.Width, QGLinternalBMP.Height,_ format,GL_UNSIGNED_BYTE,_ QGLinternalBMP.Pointer) glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, QGL.MipMap glTexParameteri GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR 'choose better option ELSE glTexImage2D(GL_TEXTURE_2D, 0, ClrBits,_ QGLinternalBMP.Width, QGLinternalBMP.Height,_ 0, format, GL_UNSIGNED_BYTE,_ QGLinternalBMP.Pointer) glTexParameteri GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_NEAREST 'GL_LINEAR is smoother but slower glTexParameteri GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_NEAREST END IF RESULT = tex END FUNCTION PUBLIC: FUNCTION CreateTextureFromFile(ImgFileName as string) AS LONG RESULT = 0 IF FILEEXISTS(ImgFileName) = False THEN EXIT FUNCTION ' IF INSTR(UCASE$(ImgFileName), ".JPG") OR _ ' INSTR(UCASE$(ImgFileName), ".TGA") OR _ ' INSTR(UCASE$(ImgFileName), ".GIF") OR _ ' INSTR(UCASE$(ImgFileName), ".PCX") AND NViewLibPresent THEN ' QGLinternalBMP.LoadOtherImage(ImgFileName, 0,"") ' ELSE QGLinternalBMP.LoadFromFile(ImgFileName) ' END IF RESULT = QGL.GL_GenerateTexture END FUNCTION FUNCTION CreateTextureFromBitMap(ImgBMP as QBITMAP) AS LONG RESULT = 0 IF ImgBMP.Width > 1 AND ImgBMP.Height > 1 THEN QGLinternalBMP.Width = ImgBMP.Width QGLinternalBMP.Height = ImgBMP.Height QGLinternalBMP.PixelFormat = ImgBMP.PixelFormat QGLinternalBMP.Draw(0, 0, ImgBMP.BMP) RESULT = QGL.GL_GenerateTexture END IF END FUNCTION '********* Fog property, affects whole scene ******************* PROPERTY SET Set_FogEnabled(theState AS INTEGER) IF theState THEN glEnable(GL_FOG) ELSE glDisable(GL_FOG) QGL.FogEnabled = theState END PROPERTY PROPERTY SET Set_FogMode(theMode AS INTEGER) glFogi GL_FOG_MODE, theMode ' Mode = GL_LINEAR, GL_EXP, GL_EXP2 QGL.FogMode = theMode END PROPERTY SUB FogColor(R#, G#, B#) DEFSNG fogColor(0 to 3) = {R#, G#,B#, 1.0} '' Fog Color, alpha always 1? glFogfv GL_FOG_COLOR, fogColor(0) '' Set Fog Color END SUB SUB SetFogParams (Start#, End#, Density#) glFogf GL_FOG_DENSITY, Density# '' How Dense Will The Fog Be glHint GL_FOG_HINT, GL_DONT_CARE '' Fog Hint Value glFogf GL_FOG_START, Start# '' Fog Start Depth glFogf GL_FOG_END, End# '' Fog End Depth END SUB PRIVATE: SUB FPSTimerOver 'this keeps track of Frames/sec QGL.FrameRate = QGL.FrameCount '/QGL.FPSTimer.Interval, which is 1 sec QGL.FrameCount = 0 END SUB CONSTRUCTOR hDC = 0 hglRC = 0 hBMP = 0 hGLRC_bmp = 0 FullScreen = False OrigWidth = Screen.Width OrigHeight = Screen.Height bpp = 24 DepthBits = 8 StencilBits = 16 AccumBits = 0 Front = 0.1 Back = 500.0 FOV = 60.0 AspectRatio = 1.0 'equal width/height ratio in scaling FPSTimer.Enabled = True FPSTimer.OnTimer = QGL.FPSTimerOver FPSTimer.Interval = 1000 FogEnabled = False FogMode = GL_EXP END CONSTRUCTOR END TYPE '************************************************************** '************************************************************** ' MD2 (quake) animations '************************************************************** '************************************************************** TYPE MD2Header ' file Header data ident AS INTEGER version AS INTEGER skinwidth AS INTEGER ' Width of skin texture (pixels) skinheight AS INTEGER ' Height of skin texture (pixels) framesize AS INTEGER ' Number of different components num_skins AS INTEGER ' Skins num_xyz AS INTEGER ' Vertices (x, y, z) num_st AS INTEGER ' Texture coordinates (s, t) num_tris AS INTEGER ' Triangles num_glcmds AS INTEGER ' GL Commands (which we aren't going to use) num_frames AS INTEGER ' Frames (transform matrices) ' File offset of different components ofs_skins AS INTEGER ' Skins ofs_st AS INTEGER ' Texture coordinates (s,t) ofs_tris AS INTEGER ' Triangles ofs_frames AS INTEGER ' Frames ofs_glcmds AS INTEGER ' GL Commands (which we aren't going to use) ofs_end AS INTEGER ' End of file END TYPE ' 'These values are set at the max allowed MD2 specs, or dynamically allocate these after loading $DEFINE MD2_MAX_VERTICES 1024 '2048 $DEFINE MD2_MAX_TRIANGLES 2048 '4096 $DEFINE MD2_MAX_FRAMES 256 '512 $DEFINE MD2_MAX_TEXT_COORD 1024 '2048 $DEFINE MD2_MAX_ANIMATIONS 1024 TYPE QMD2model EXTENDS QMEMORYSTREAM TheModel AS MD2Header vertex(MD2_MAX_FRAMES, MD2_MAX_VERTICES, 2) AS BYTE 'each byte is rescaled by Frame normal(MD2_MAX_FRAMES, MD2_MAX_VERTICES) AS BYTE 'index into table of normal TexCoord(MD2_MAX_TEXT_COORD, 1) AS SINGLE 'actual values in SHORT indexXYZ(MD2_MAX_TRIANGLES, 2) AS SHORT 'index to which vertex indexST(MD2_MAX_TRIANGLES, 2) AS SHORT 'index for texture coord Frame_Scale(MD2_MAX_FRAMES, 2) AS SINGLE Frame_Translate(MD2_MAX_FRAMES, 2) AS SINGLE Frame_Name(MD2_MAX_FRAMES) AS STRING * 16 skins(32) AS GLint 'texture ID's for OpenGL bindTexture 'individual render frame specific StartFrame AS INTEGER CurrentFrame AS INTEGER 'for updating animation MaxFrame AS INTEGER 'of single frames 'animation list specific AnimationFrame(MD2_MAX_ANIMATIONS) AS GLint 'array of Displaylist handles MaxAnimationFrame AS INTEGER 'highest display List index KeyFrame(MD2_MAX_FRAMES) AS SHORT 'special locations in animation KeyFrameIndex AS SHORT 'fluffy stuff Position AS QD3DVECTOR 'set our 3D position Rotation As QD3DVECTOR 'set the rotation angle in degs for each axis Scale As QD3DVECTOR 'set scaling for each axis hDC AS LONG 'set handle for device context for auto flipping 'frames per second counters FPSTimer AS QTIMER 'do background timing FPS AS SINGLE PROPERTY SET MD2_Set_FPS 'animation can be too fast ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Functions '''''''''''''''''''''' ' LoadMD2 model, Input: a MD2 Header structure, this allows multiple 3D objects SUB LoadMD2File (TheFileName AS STRING) DIM theFileDir$ AS STRING DIM TheFile AS QFILESTREAM DIM i AS INTEGER DIM j AS INTEGER DIM TempStr AS STRING DIM OpenDialog AS QOPENDIALOG 'open file dialog IF TheFileName = "" THEN openDialog.Caption = "select a Quake model " openDialog.filter = "*.MD2 (quake)|*.MD2" IF openDialog.execute THEN theFileDir$ = OpenDialog.InitialDir theFileName = UCASE$(OpenDialog.FileName) END IF END IF ' Open file, if it exists then load it up IF FILEEXISTS(theFileDir$ + theFileName) THEN TheFile.Open(theFileDir$ + theFileName, fmOpenRead) ELSE ShowMessage "Failed to open " + TheFileName EXIT SUB 'be sure to compile with the latest fixed libs END IF TheFile.ReadUDT(This.TheModel) WITH THIS '------------------------------------------------------------- 'load the 'skins', which are texures from bitmap files '------------------------------------------------------------- ' REDIM SMD2_skins(TheModel.num_skins) 'crashes IF .TheModel.num_skins > 0 THEN TheFile.Seek(soFromBeginning, .TheModel.ofs_skins) 'position in the file with offset in .TheModel.ofs_skins for i = 0 to .TheModel.num_skins - 1 ' Load all texture files TempStr = TheFile.ReadStr(64) ' Read texture name TempStr = RTRIM$(REPLACESUBSTR$(TempStr, "/","\")) 'condition it TempStr = LEFT$(TempStr,INSTR(TempStr, CHR$(0))-1) IF FileExists(theFileDir$ + tempStr) = False THEN theFileDir$ = "" 'not in directory IF FileExists(tempStr) = False THEN tempStr = LEFT$(TheFileName, INSTR(TheFileName, ".MD2")-1) + ".bmp" 'next shot IF FileExists(tempStr) = False THEN tempStr = LEFT$(tempStr, INSTR(tempStr, ".bmp")-1) + ".jpg" 'last shot END IF END IF END IF This.skins(i) = GL.CreateTextureFromFile(theFileDir$ + tempStr) 'Load texture if This.skins(i) = 0 then ShowMessage "Failed to load texture: " + theFileDir$ + tempStr ' end end if next i ELSE tempStr = LEFT$(TheFileName, INSTR(TheFileName, ".MD2")-1) + ".bmp" 'next shot This.skins(0) = GL.CreateTextureFromFile(tempStr) END IF '------------------------------------------------------------- 'get Texture coordinates (s, t) '------------------------------------------------------------- IF .TheModel.num_st > MD2_MAX_TEXT_COORD THEN Showmessage "Err: Too many tex coords" TheFile.Seek(soFromBeginning, .TheModel.ofs_st) ' Seek to texture coordinates for i = 0 to .TheModel.num_st - 1 This.TexCoord(i, 0) = (TheFile.ReadNum(num_WORD))/(1.0* QGLinternalBMP.Width) This.TexCoord(i, 1) = (TheFile.ReadNum(num_WORD))/(-1.0 * QGLinternalBMP.Height) next i '------------------------------------------------------------- 'get model triangles, indexes to all vertices '------------------------------------------------------------- IF .TheModel.num_tris > MD2_MAX_TRIANGLES THEN Showmessage "Err: Too many triangles" TheFile.Seek( soFromBeginning, .TheModel.ofs_tris) ' Seek to triangles for i = 0 to .TheModel.num_tris - 1 ' Load triangles TheFile.LoadArray(This.indexXYZ(i, 0), 3) TheFile.LoadArray(This.indexST(i, 0), 3) next i '------------------------------------------------------------- 'get model frames, which are basically 4x4 matrices and all their vertices & normals '------------------------------------------------------------- IF .TheModel.num_frames > MD2_MAX_FRAMES THEN Showmessage "Err: Too many frames" .MaxFrame = MD2_MAX_FRAMES ELSE .MaxFrame = .TheModel.num_frames END IF IF .TheModel.num_xyz > MD2_MAX_VERTICES THEN Showmessage "Err: Too many verts" TempStr = "" TheFile.Seek( soFromBeginning, .TheModel.ofs_frames) ' Seek to frames for i = 0 to .TheModel.num_frames - 1 ' Load each animation frame TheFile.LoadArray(This.Frame_Scale(i,0), 3) TheFile.LoadArray(This.Frame_Translate(i,0), 3) .Frame_Name(i)= TheFile.ReadStr(16) 'a char string with terminating 0's .Frame_Name(i)= LTRIM$(RTRIM$((LEFT$(This.Frame_Name(i), INSTR(This.Frame_Name(i), CHR$(0))-1)))) 'trim off zero chars IF TempStr <> LEFT$(This.Frame_Name(i), 3) THEN TempStr = LEFT$(This.Frame_Name(i),3) ' IF TempStr <> This.Frame_Name(i) - STR$(VAL(This.Frame_Name(i))) THEN ' TempStr = This.Frame_Name(i) - STR$(VAL(This.Frame_Name(i))) .KeyFrameIndex++ .KeyFrame(.KeyFrameIndex) = i 'keep track of unique frames by name END IF FOR j = 0 to .TheModel.num_xyz - 1 ' Read vertices TheFile.LoadArray(This.vertex(i,j,0) ,3) 'get 3D coord of vertices TheFile.LoadArray(This.normal(i,j) , 1) 'an indexes to normal table NEXT j next i TheFile.Close END WITH END SUB PRIVATE: SUB DoTransformations WITH THIS IF (.Scale.x <> 1.0) OR (.Scale.y <> 1.0) OR (.Scale.z <> 1.0) THEN glScalef(This.Scale.x, This.Scale.y, This.Scale.z) END IF IF (.Position.x <> 0.0) OR (.Position.y <> 0.0) OR (.Position.z <> 0.0) THEN glTranslatef (This.Position.x, This.Position.y, This.Position.z) END IF IF (.Rotation.x <> 0.0) OR (.Rotation.y <> 0.0) OR (.Rotation.z <> 0.0) THEN glRotatef (This.Rotation.x, 1, 0, 0) glRotatef (This.Rotation.y, 0, 1, 0) glRotatef (This.Rotation.z, 0, 0, 1) END IF END WITH END SUB PUBLIC: SUB SetPosition (X AS SINGLE, Y AS SINGLE, Z AS SINGLE) 'like Qd3dFrame This.Position.x = x This.Position.y = y This.Position.z = z ' This.DoTransformations END SUB SUB SetRotation (X AS SINGLE, Y AS SINGLE, Z AS SINGLE) This.Rotation.x = x This.Rotation.y = y This.Rotation.z = z ' This.DoTransformations END SUB SUB SetScale (X AS SINGLE, Y AS SINGLE, Z AS SINGLE) 'like Qd3dFrame This.Scale.x = x This.Scale.y = y This.Scale.z = z ' This.DoTransformations END SUB '''''''''''''''''' ' Draw an interpolated MD2 frame ' Expects: ' theModel = pointer to model ' theFrameNum = index of first frame ' theFrameNum2 = index of the second frame ' theFrameFactor = 0 to draw the first frame, 1 to draw the second frame, or a value between 0 and 1 ' theSkin = skin to use SUB DrawMD2 (theFrameNum AS INTEGER, theFrameNum2 AS INTEGER, theFrameFactor AS SINGLE, theSkin AS INTEGER) DIM i as integer, i2 as integer, i3 as integer DIM tempVec(2) AS SINGLE DIM PartFrame AS SINGLE This.DoTransformations glBindTexture (GL_TEXTURE_2D, This.skins(theSkin)) ' Apply model scaling glMatrixMode (GL_MODELVIEW) glPushMatrix glRotatef( -90, 1, 0, 0 ) glRotatef( -90, 0, 0, 1 ) PartFrame = 1.0 - theFrameFactor 'get the remaining portion of frame 'linear interpolate position between frames tempVec(0) = This.Frame_translate(TheFrameNum, 0) * PartFrame + This.Frame_translate(TheFrameNum2, 0) * theFrameFactor tempVec(1) = This.Frame_translate(TheFrameNum, 1) * PartFrame + This.Frame_translate(TheFrameNum2, 1) * theFrameFactor tempVec(2) = This.Frame_translate(TheFrameNum, 2) * PartFrame + This.Frame_translate(TheFrameNum2, 2) * theFrameFactor glTranslatef (tempVec (0), tempVec (1), tempVec (2)) 'linear interpolate scale between frames tempVec(0) = This.Frame_scale(TheFrameNum, 0) * PartFrame + This.Frame_scale(TheFrameNum2, 0) * theFrameFactor tempVec(1) = This.Frame_scale(TheFrameNum, 1) * PartFrame + This.Frame_scale(TheFrameNum2, 1) * theFrameFactor tempVec(2) = This.Frame_scale(TheFrameNum, 2) * PartFrame + This.Frame_scale(TheFrameNum2, 2) * theFrameFactor glScalef (tempVec (0), tempVec (1), tempVec (2)) ' Render each triangle glBegin (GL_TRIANGLES) for i = 0 to This.TheModel.num_tris - 1 for i2 = 0 to 2 ' glNormal3fv (This.Frames(TheFrameNum).verts (This.tris(i).index_xyz (i2)).normal * (1 - theFrameFactor) + This.Frames(TheFrameNum2).verts (This.tris(i).index_xyz (i2)).normal * theFrameFactor) glTexCoord2fv(This.TexCoord(This.indexST(i,i2),0)) tempVec(0) = This.Vertex(theFrameNum2, This.indexXYZ(i, i2), 0) * theFrameFactor + _ This.Vertex(theFrameNum, This.indexXYZ(i, i2), 0) * PartFrame tempVec(1) = This.Vertex(theFrameNum2, This.indexXYZ(i, i2), 1) * theFrameFactor + _ This.Vertex(theFrameNum, This.indexXYZ(i, i2), 1) * PartFrame tempVec(2) = This.Vertex(theFrameNum2, This.indexXYZ(i, i2), 2) * theFrameFactor + _ This.Vertex(theFrameNum, This.indexXYZ(i, i2), 2) * PartFrame glVertex3fv(tempVec(0)) next i2 next i glEnd glPopMatrix ' Restore modelview matrix glMatrixMode (GL_MODELVIEW) END SUB FUNCTION CreateAnimationSet(FirstFrame AS INTEGER, LastFrame AS INTEGER, FrameFactor AS SINGLE) AS LONG DIM i as integer, NumFrame as integer DIM FrameStep as single WITH THIS .StartFrame = .MaxAnimationFrame 'start from last animation index NumFrame = FirstFrame 'set our Frame counter FrameStep = FrameFactor 'and the portion to next frame DO .AnimationFrame(.MaxAnimationFrame) = glGenLists(1) 'allow seperate lists by start index glNewList( .AnimationFrame(.MaxAnimationFrame), GL_COMPILE) This.DrawMD2 (NumFrame, NumFrame + 1, FrameStep, This.skins(1)) glEndList .MaxAnimationFrame++ 'next list index IF .MaxAnimationFrame > MD2_MAX_ANIMATIONS THEN EXIT DO 'out of room FrameStep = FrameStep + FrameFactor 'next part of animation IF FrameStep > 1.0 THEN FrameStep = 1.0: NumFrame++ 'if finished to next frame, increment LOOP UNTIL (NumFrame >= LastFrame) RESULT = .StartFrame 'return start number of animation END WITH END FUNCTION SUB Animate static i as integer IF i <> This.CurrentFrame THEN This.DoTransformations glCallList(This.AnimationFrame(This.CurrentFrame)) i = This.CurrentFrame IF This.hDC <> 0 THEN SwapBuffers This.hDC END IF END SUB SUB MD2_Set_FPS(TheFramesPerSecond AS SINGLE) IF TheFramesPerSecond > 0.0 THEN This.FPS = TheFramesPerSecond This.FPSTimer.Interval = INT(1000/This.FPS) 'timer units in ms IF This.FPSTimer.Enabled = 0 THEN This.FPSTimer.Enabled = 1 ELSE This.FPSTimer.Enabled = 0 END IF END SUB SUB FPSTimerOver This.CurrentFrame++ if This.CurrentFrame => This.MaxAnimationFrame then This.CurrentFrame = This.StartFrame END SUB SUB New() WITH THIS .hDC = 0 .FPSTimer.Enabled = 0 .FPSTimer.OnTimer = This.FPSTimerOver .StartFrame = 0 .CurrentFrame = 0 .MaxFrame= 0 .MaxAnimationFrame = 0 .KeyFrameIndex = 0 .Position.x = 0.0 .Position.y = 0.0 .Position.z = 0.0 .Rotation.x = 0.0 .Rotation.y = 0.0 .Rotation.z = 0.0 .Scale.x = 1.0 .Scale.y = 1.0 .Scale.z = 1.0 END WITH END SUB SUB Clear DIM i AS INTEGER WITH THIS IF .MaxAnimationFrame > 0 THEN glDeleteLists(.AnimationFrame(0), .MaxAnimationFrame + 1) .New MEMSET(VARPTR(This.vertex(0,0,0)), 0, (MD2_MAX_FRAMES * MD2_MAX_VERTICES * 2)) MEMSET(VARPTR(This.normal(0,0)), 0, (MD2_MAX_FRAMES * MD2_MAX_VERTICES)) MEMSET(VARPTR(This.TexCoord(0,0)), 0, (MD2_MAX_TEXT_COORD * 2 * SIZEOF(SINGLE))) MEMSET(VARPTR(This.indexXYZ(0, 0)), 0, (MD2_MAX_TRIANGLES* 3 * SIZEOF(SHORT))) MEMSET(VARPTR(This.indexST(0 ,0)), 0, (MD2_MAX_TRIANGLES* 3 * SIZEOF(SHORT))) MEMSET(VARPTR(This.Frame_Scale(0, 0)), 0, (MD2_MAX_FRAMES* 3 * SIZEOF(SINGLE))) MEMSET(VARPTR(This.Frame_Translate(0, 0)), 0, (MD2_MAX_FRAMES* 3 * SIZEOF(SINGLE))) MEMSET(VARPTR(This.Frame_Name(0)), 0,(MD2_MAX_FRAMES * 16)) MEMSET(VARPTR(This.skins(0)), 0, (32 * SIZEOF(GLint))) END WITH END SUB SUB CalcMD2Normals ' DIM i As INTEGER, i2 As INTEGER, i3 As INTEGER 'DIM tempNormal(2) AS SINGLE 'DIM tempTriangle(2,2) AS SINGLE ' ' Note: The MD2 file format stores normals as indexed lookups into some normal table. ' ' I cannot find this table, so I will simply recalculate them. ' ' ' Calculate for all frames ' for i3 = 0 to theModel.num_frames - 1 ' for i = 0 to theModel.num_tris - 1 ' for i2 = 0 to 2 ' tempTriangle (i2) = theFrame.verts (Stris(i).index_xyz (i2)).v ' next ' ' ' Calculate normal as cross product between edges 0-1 and 0-2 ' tempNormal = Normalize (-CrossProduct (tempTriangle (1) - tempTriangle (0), tempTriangle (2) - tempTriangle (0))) ' ' ' Add new normal to normals at ALL vertices of the triangle. ' ' This will have an averaging effect over vertices that are shared between multiple triangles ' for i2 = 0 to 2 ' theFrame.verts (Stris(i).index_xyz (i2)).normal = theFrame.verts (Stris(i).index_xyz (i2)).normal + tempNormal ' next ' next ' ' ' Normalise all normals ' for i = 0 to theModel.num_xyz - 1 ' theFrame.verts (i).normal = Normalize (theFrame.verts (i).normal) ' next ' next END SUB CONSTRUCTOR New END CONSTRUCTOR END TYPE