Updated scgOBJ.bas to compile with FreeBASIC v0.17
2006 01 08
Updated scgOBJ.bas, minor change, added min error checking.
Update Cube.bas, correct object rotation order, yaw, pitch, roll.
The following source code is for a converter I am working on. The Converter converts an ASC wavefront OBJ file to Freebasic OpenGL code. Only limited testing has been done on the code. If you find errors in the conversion, please point me to the OBJ file. Going out of town for the holidays, so I am posting this code a little early, not enough testing.
Compile scgOBJ , fbc scgOBJ.bas -e
Run scgOBJ, enter the file name for the cube, Cube.OBJ, this will generate Cube.bi.
Compile and run Cube.bas
Happy Holidays
JohnB
The converter.
scgOBJ.bas
Code: Select all
'
' My THANKS to the Creators of FreeBASIC !!!
'
' and following
'
' Pete's QBasic Site for QB Express
' Imortis Inglorian for How To Program A Simple Text Parser In FB/QB
' Delphi OpenGL project for example of Wavefront .OBJ Model Loader
' R. Steven Glanville for Anim8or and A8Viewer
'
' source code generator, scan and generate GL code for wavefront obj
' FreeBASIC - v0.15b - Win98se
'
' update to FreeBASIC - v0.17 - WinXP SP1
' remove option explicit and option base 0
' changed functions to Sub's
' changed '$ include to # include
' change array from (100) to (0 To 100)
' change allocate to callocate ------------ cha0s, thanks for the help
'
'#DEFINE VERSION "' Generated by scgOBJ.bas - version 0.5 - 20060106 - JohnB"
#DEFINE VERSION "' Generated by scgOBJ_017.bas - version 0.5 - 20070210 - JohnB"
'
'
'
#include "GL/gl.bi"
type TypeColor ' R G B
R as glFloat
G as glFloat
B as glFloat
end type
type TypeCoord ' X, Y, Z coordinates
X as glFloat
Y as glFloat
Z as glFloat
end type
type TypeTexCoord ' texture coordinates
U as glFloat
V as glFloat
end type
type TypeFaceVertex
v as integer ' vertex geometric
vt as integer ' vertex texture
vn as integer ' vertex normal
end type
type TypeFace
fvIndex as integer ' index to the first face vertices
fvFaces as integer ' number of face vertices in face
end type
type TypeGroup
GName as string
GFaces as integer ' Number of faces in group
GFirstFacePtr as TypeFace ptr ' Pointer to first face in group
GMaterialIndex as integer ' index to Material
end type
type TypeMaterial ' material Structure
MaterialName as string
Ambient as TypeColor
Diffuse as TypeColor
Specular as TypeColor
Shininess as glFloat
Texture as glUint
end type
type TypeModel
ModelName as string
MaterialFile as string
Vertices as integer
Normals as integer
TexCoords as integer
Groups as integer
Materials as integer
Faces as integer
FaceVertices as integer
VertexPtr as TypeCoord ptr
NormalPtr as TypeCoord ptr
TexCoordPtr as TypeTexCoord ptr
MaterialPtr as TypeMaterial ptr
GroupPtr as TypeGroup ptr
FacePtr as TypeFace ptr
FaceVertexPtr as TypeFaceVertex ptr
end type
' temp pointers
Dim temp_VertexPtr as TypeCoord Ptr
Dim temp_TexCoordPtr as TypeTexCoord Ptr
Dim temp_NormalPtr as TypeCoord Ptr
Dim temp_MaterialPtr as TypeMaterial Ptr
Dim temp_GroupPtr as TypeGroup Ptr
Dim temp_FacePtr as TypeFace Ptr
Dim temp_FirstFacePtr as TypeFace Ptr
Dim temp_FaceVertexPtr as TypeFaceVertex Ptr
Dim Shared Parsed(0 To 100) as String
Sub Parse(ToParse as String)
Dim CurrentPosition as Integer
Dim CurrentCharacter as String
Dim WordCount as Integer : WordCount = 0
Dim WordSize as Integer : WordSize = 0
For CurrentPosition = 1 to Len(ToParse)
CurrentCharacter = MID$(ToParse,CurrentPosition,1)
Select Case CurrentCharacter
Case " "
If WordSize <> 0 Then
Parsed(WordCount + 1) = MID$(ToParse, CurrentPosition - WordSize, WordSize)
WordCount = WordCount + 1
End if
WordSize = 0
Case Else
WordSize = WordSize + 1
End Select
If CurrentPosition = Len(ToParse) And WordSize <> 0 Then
WordSize = WordSize - 1
WordCount = WordCount + 1
Parsed(WordCount) = MID$(ToParse, CurrentPosition - WordSize, WordSize + 1)
End If
Next CurrentPosition
Parsed(0) = MKI$(WordCount)
End Sub
Sub ParseFaceVertex(s as String , ByRef v as integer, ByRef vt as integer, ByRef vn as integer)
Dim as integer fvtype = 0
Dim as integer start = 1
Dim as integer current
v = -1 : vt = -1 : vn = -1
If instr(s, "/") <> 0 Then fvtype = 1
If instr(s, "//") <> 0 Then fvtype = 2
Select Case fvtype
Case 0 ' type v
v = Val(s)
Case 1 ' type v/vt/vn
current = instr(s, "/")
v = Val(MID$(s, start, current - start))
start = current + 1
current = instr(start, s, "/")
vt = Val(MID$(s, start, current - start))
start = current + 1
vn = Val(MID$(s, start, Len(s) - start + 1))
Case 2 ' type v//vn
current = instr(s, "//")
v = Val(MID$(s, start, current - start))
start = current + 2
vn = Val(MID$(s, start, Len(s) - start + 1))
End Select
End Sub
Sub InitModel(M as TypeModel)
' strings
M.ModelName = ""
M.MaterialFile = ""
' integers
M.Vertices = 0
M.Normals = 0
M.TexCoords = 0
M.Materials = 0
M.Groups = 0
M.Faces = 0
M.FaceVertices = 0
' pointers
M.VertexPtr = 0
M.NormalPtr = 0
M.TexCoordPtr = 0
M.MaterialPtr = 0
M.GroupPtr = 0
M.FacePtr = 0
M.FaceVertexPtr = 0
End Sub
Dim as TypeModel M
Dim as Integer i, j, f, im, iv, ivt, ivn, ifv, iface, ig
Dim as String ln, model
Dim as Integer UnProcessed_Type = 0
Dim as glFloat default_Ambient(4) = {0.2, 0.2, 0.2, 1.0}
Dim as glFloat default_Diffuse(4) = {1.0, 1.0, 1.0, 1.0}
Dim as glFloat default_Specular(4) = {0.6, 0.6, 0.6, 1.0}
Dim as glFloat default_Shininess(1) = {300.0}
Dim as Integer debug_flag
'------------- degug help flag --------------
debug_flag = 0
'--------------------------------------------
InitModel(M)
Print
Input "Enter model name > ",M.ModelName
'M.ModelName = "galleon_uv.obj" ' downloaded as galleon.3ds, converted to obj with AN8,UVMapper
Print
'
' scan obj file
'
f = FreeFile
If Open(M.ModelName For Input as #f) <> 0 Then
Print
Print "File "; M.ModelName; " not found."
Print
End
End If
'
do until eof(f)
Line Input #f, ln
Parse(ln)
' Print CVI(Parsed(0))
If CVI(Parsed(0)) <> 0 Then
Select Case Parsed(1)
Case "mtllib"
M.MaterialFile = Parsed(2)
Case "v"
M.Vertices += 1
Case "vn"
M.Normals += 1
Case "vt"
M.TexCoords += 1
Case "g"
M.Groups += 1
' Case "usemtl"
Case "f"
M.Faces += 1
M.FaceVertices += (CVI(Parsed(0)) - 1)
Case Else
If Left(Parsed(1),1) <> "#" Then
UnProcessed_Type += 1
print "UnProcessed Type > ", ln
End If
End Select
End If
loop
close #f
'Print "v = ";M.Vertices; " vn = ";M.Normals; " vt = ";M.TexCoords
'Print "g = ";M.Groups; " f = ";M.Faces; " fv = ";M.FaceVertices
'Print "Press any key to continue."
'Sleep
'
' scan mtl file
'
If M.MaterialFile <> "" Then
f = FreeFile
If Open(M.MaterialFile For Input as #f) = 0 Then
do until eof(f)
Line Input #f, ln
Parse(ln)
If CVI(Parsed(0)) <> 0 And Parsed(1) = "newmtl" Then M.Materials += 1
loop
close #f
'
' create materials array
'
If M.Materials <> 0 Then
M.MaterialPtr = Callocate(Len(TypeMaterial) * M.Materials)
f = FreeFile
Open M.MaterialFile For Input as #f
im = -1 ' no materials
do until eof(f)
Line Input #f, ln
Parse(ln)
If CVI(Parsed(0)) <> 0 Then
Select Case Parsed(1)
Case "newmtl"
im += 1 : temp_MaterialPtr = M.MaterialPtr + im
temp_MaterialPtr->MaterialName = Parsed(2)
Case "Ka"
temp_MaterialPtr->Ambient.R = Val(Parsed(2))
temp_MaterialPtr->Ambient.G = Val(Parsed(3))
temp_MaterialPtr->Ambient.B = Val(Parsed(4))
Case "Kd"
temp_MaterialPtr->Diffuse.R = Val(Parsed(2))
temp_MaterialPtr->Diffuse.G = Val(Parsed(3))
temp_MaterialPtr->Diffuse.B = Val(Parsed(4))
Case "Ks"
temp_MaterialPtr->Specular.R = Val(Parsed(2))
temp_MaterialPtr->Specular.G = Val(Parsed(3))
temp_MaterialPtr->Specular.B = Val(Parsed(4))
Case "Ns"
temp_MaterialPtr->Shininess = Val(Parsed(2))
End Select
End If
loop
close #f
End If
Else
Print
Print "Material file not found, "; M.MaterialFile
Print
End If
End If
'
' create v, vt, vn, facevertex, face, group arrays
'
f = FreeFile
If M.Vertices > 0 Then
M.VertexPtr = Callocate(Len(TypeCoord) * M.Vertices)
If M.TexCoords > 0 Then M.TexCoordPtr = Callocate(Len(TypeTexCoord) * M.TexCoords)
If M.Normals > 0 Then M.NormalPtr = Callocate(Len(TypeCoord) * M.Normals)
If M.Groups > 0 Then M.GroupPtr = Callocate(Len(TypeGroup) * M.Groups)
If M.Faces > 0 Then M.FacePtr = Callocate(Len(TypeFace) * M.Faces)
If M.FaceVertices > 0 Then M.FaceVertexPtr = Callocate(Len(TypeFaceVertex) * M.FaceVertices)
iv = -1 : ivt = -1 : ivn = -1 : ifv = -1 : iface = -1 : ig = -1
temp_GroupPtr = M.GroupPtr : temp_FacePtr = M.FacePtr : temp_FaceVertexPtr = M.FaceVertexPtr
Open M.ModelName For Input as #f
do until eof(f)
Line Input #f, ln
Parse(ln)
If CVI(Parsed(0)) <> 0 then
Select Case Parsed(1)
Case "mtllib"
Case "v"
iv +=1 : temp_VertexPtr = M.VertexPtr + iv
temp_VertexPtr->X = Val(Parsed(2))
temp_VertexPtr->Y = Val(Parsed(3))
temp_VertexPtr->Z = Val(Parsed(4))
Case "vn"
ivn +=1 : temp_NormalPtr = M.NormalPtr + ivn
temp_NormalPtr->X = Val(Parsed(2))
temp_NormalPtr->Y = Val(Parsed(3))
temp_NormalPtr->Z = Val(Parsed(4))
Case "vt"
ivt += 1 : temp_TexCoordPtr = M.TexCoordPtr + ivt
temp_TexCoordPtr->U = Val(Parsed(2))
temp_TexCoordPtr->V = Val(Parsed(3))
Case "usemtl"
If M.MaterialFile <> "" And M.Materials <> 0 Then
For i = 0 to M.Materials -1
temp_MaterialPtr = M.MaterialPtr + i
If Parsed(2) = temp_MaterialPtr->MaterialName Then
temp_GroupPtr->GMaterialIndex = i
Exit For
Endif
Next i
End If
Case "g"
ig += 1 : temp_GroupPtr = M.GroupPtr + ig
If CVI(Parsed(0)) > 1 Then
temp_GroupPtr->GName = Parsed(2)
Else
temp_GroupPtr->GName = ""
End If
temp_GroupPtr->GFaces = 0
temp_GroupPtr->GFirstFacePtr = M.FacePtr + iface + 1
temp_GroupPtr->GMaterialIndex = -1
Case "f"
iface += 1
temp_GroupPtr->GFaces += 1
temp_FacePtr = M.FacePtr + iface
temp_FacePtr->fvIndex = ifv + 1
temp_FacePtr->fvFaces = CVI(Parsed(0)) - 1
For i = 0 to temp_FacePtr->fvFaces -1
ifv += 1 : temp_FaceVertexPtr = M.FaceVertexPtr + ifv
ParseFaceVertex(Parsed(i + 2), temp_FaceVertexPtr->v, temp_FaceVertexPtr->vt, temp_FaceVertexPtr->vn)
Next i
Case Else
If Left(Parsed(1),1) <> "#" Then
UnProcessed_Type += 1
print "UnProcessed Type > ", ln
End If
End Select
End If
loop
close #f
End If
Print "end of create loop"
'
' at this point, the wavefront obj data is store in the types, arrays etc
' the following code generates gl source code that can be used with FreeBASIC
'
'print
'print "TypeColor ", Len(TypeColor)
'print "TypeCoord ", Len(TypeCoord)
'print "TypeTexCoord ", Len(TypeTexCoord)
'print "TypeMaterial ", Len(TypeMaterial)
'print "TypeGroup ", Len(TypeGroup)
'print "TypeFace ", Len(TypeFace)
'print "TypeFaceVertex ", Len(TypeFaceVertex)
'sleep
'print
'print "iv = "; iv+1; " vt = "; ivt+1; " ivn = "; ivn+1
'print "ifv = "; ifv+1; " iface = "; iface+1; " ig = "; ig+1
'print
'print "GroupPtr = "; M.GroupPtr;" FacePtr = "; M.FacePtr;" FaceVertexPtr = "; M.FaceVertexPtr
'print
'
' output to a file
'
f = FreeFile
Open Left(M.ModelName, instr(M.ModelName, ".")) + "bi" For Output AS #f
Print #f, "'"
Print #f, VERSION
Print #f, "'"
Print #f, "' model name ", M.ModelName
Print #f, "' material file ", M.MaterialFile
Print #f, "' materials ", M.Materials
Print #f, "' verttices ", M.Vertices
Print #f, "' tex coords ", M.TexCoords
Print #f, "' normals ", M.Normals
Print #f, "' groups ", M.Groups
Print #f, "' faces ", M.Faces
Print #f, "' face vertices ", M.FaceVertices
Print #f, "' UnProcessed Type ", UnProcessed_Type
Print #f, "'"
'
' do we have data to create file
'
If M.Groups <> 0 And M.Faces <> 0 And M.Vertices <> 0 Then
'
' find min max for x,y,z vertices
'
Dim as glFloat vx_min, vx_max, vy_min, vy_max, vz_min, vz_max, vx_temp, vy_temp, vz_temp
'
vx_min = M.VertexPtr->X : vx_max = vx_min
vy_min = M.VertexPtr->Y : vy_max = vy_min
vz_min = M.VertexPtr->Z : vz_max = vz_min
'
For iv = 0 to M.Vertices -1
vx_temp = (M.VertexPtr + iv)->X
vy_temp = (M.VertexPtr + iv)->Y
vz_temp = (M.VertexPtr + iv)->Z
If vx_temp < vx_min Then vx_min = vx_temp
If vx_temp > vx_max Then vx_max = vx_temp
If vy_temp < vy_min Then vy_min = vy_temp
If vy_temp > vy_max Then vy_max = vy_temp
If vz_temp < vz_min Then vz_min = vz_temp
If vz_temp > vz_max Then vz_max = vz_temp
Next iv
Print #f, "'"
Print #f, "' vx min = "; vx_min; " vx_max = "; vx_max
Print #f, "' vy min = "; vy_min; " vy_max = "; vy_max
Print #f, "' vz min = "; vz_min; " vz_max = "; vz_max
Print #f, "'"
Print #f,
'
' generate code for Materials
'
If M.Materials <> 0 Then
Print #f, "'"
Print #f, "' Generate Material Variables"
Print #f, "'"
For im = 0 to M.Materials - 1
temp_MaterialPtr = M.MaterialPtr + im
' Ambient
Print #f, "Dim as glFloat "; temp_MaterialPtr->MaterialName; "_Ambient(4) = {";
Print #f, temp_MaterialPtr->Ambient.R; ",";temp_MaterialPtr->Ambient.G; ",";temp_MaterialPtr->Ambient.R; ", 1.0 }"
' Diffuse
Print #f, "Dim as glFloat "; temp_MaterialPtr->MaterialName; "_Diffuse(4) = {";
Print #f, temp_MaterialPtr->Diffuse.R; ",";temp_MaterialPtr->Diffuse.G; ",";temp_MaterialPtr->Diffuse.R; ", 1.0 }"
' Specular
Print #f, "Dim as glFloat "; temp_MaterialPtr->MaterialName; "_Specular(4) = {";
Print #f, temp_MaterialPtr->Specular.R; ",";temp_MaterialPtr->Specular.G; ",";temp_MaterialPtr->Specular.R; ", 1.0 }"
' Shininess
Print #f, "Dim as glFloat "; temp_MaterialPtr->MaterialName; "_Shininess(1) = {" ;temp_MaterialPtr->Shininess; " }"
' Print #f, "'"
Next i
Else
' add code for default Ambient, Diffuse, Specular and Shininess
' Ambient
Print #f, "Dim as glFloat default_Ambient(4) = { 0.2, 0.2, 0.2, 1.0 }"
' Diffuse
Print #f, "Dim as glFloat default_Diffuse(4) = { 1.0, 1.0, 1.0, 1.0 }"
' Specular
Print #f, "Dim as glFloat default_Specular(4) = { 0.6, 0.6, 0.6, 1.0 }"
' Shininess
Print #f, "Dim as glFloat default_Shininess(1) = { 300.0 }"
End If
'
' generate code for Group Faces, possible zero faces in group !!!
'
If M.Groups <> 0 Then
For ig = 0 to M.Groups - 1
temp_GroupPtr = M.GroupPtr + ig
Print #f, "'"
Print #f, "' Group Name "; temp_GroupPtr->GName
Print #f, "' Number of Faces in the Group "; temp_GroupPtr->GFaces
Print #f,
If temp_GroupPtr->GFaces > 0 Then
If (M.Materials > 0) And (temp_GroupPtr->GMaterialIndex <> -1) Then
temp_MaterialPtr = M.MaterialPtr + temp_GroupPtr->GMaterialIndex
Print #f, "' Material Name "; temp_MaterialPtr->MaterialName
Print #f, "'"
Print #f, "glMaterialfv(GL_FRONT_AND_BACK, GL_AMBIENT, @"; temp_MaterialPtr->MaterialName; "_Ambient(0))"
Print #f, "glMaterialfv(GL_FRONT_AND_BACK, GL_DIFFUSE, @"; temp_MaterialPtr->MaterialName; "_Diffuse(0))"
Print #f, "glMaterialfv(GL_FRONT_AND_BACK, GL_SPECULAR, @"; temp_MaterialPtr->MaterialName; "_Specular(0))"
Print #f, "glMaterialfv(GL_FRONT_AND_BACK, GL_SHININESS, @"; temp_MaterialPtr->MaterialName; "_Shininess(0))"
Print #f,
Else
Print #f, "' No Material in obj file, using default material"
Print #f, "'"
Print #f, "glMaterialfv(GL_FRONT_AND_BACK, GL_AMBIENT, @default_Ambient(0))"
Print #f, "glMaterialfv(GL_FRONT_AND_BACK, GL_DIFFUSE, @default_Diffuse(0))"
Print #f, "glMaterialfv(GL_FRONT_AND_BACK, GL_SPECULAR, @default_Specular(0))"
Print #f, "glMaterialfv(GL_FRONT_AND_BACK, GL_SHININESS, @default_Shininess(0))"
Print #f,
End If
For iface = 0 to temp_GroupPtr->GFaces - 1
temp_FacePtr = temp_GroupPtr->GFirstFacePtr + iface
ifv = temp_FacePtr->fvIndex
Select Case temp_FacePtr->fvFaces
Case 3
Print #f, "glBegin(GL_TRIANGLES)"
Case 4
Print #f, "glBegin(GL_QUADS)"
Case Else
Print #f, "glBegin(GL_POLYGON)"
End Select
For i = 0 to temp_FacePtr->fvFaces - 1
temp_FaceVertexPtr = M.FaceVertexPtr + ifv + i
iv = temp_FaceVertexPtr->v
ivt = temp_FaceVertexPtr->vt
ivn = temp_FaceVertexPtr->vn
If ivt > 0 Then
Print #f, "glTexCoord2f( "; (M.TexCoordPtr + ivt -1)->U; ","; (M.TexCoordPtr + ivt -1)->V; " )"
End If
If ivn > 0 Then
Print #f, "glNormal3f( ";
Print #f, (M.NormalPtr + ivn -1)->X; ","; (M.NormalPtr + ivn -1)->Y; ","; (M.NormalPtr + ivn -1)->Z; " )"
End If
If iv > 0 Then
Print #f, "glVertex3f( ";
Print #f, (M.VertexPtr + iv -1)->X; ","; (M.VertexPtr + iv -1)->Y; ",";(M.VertexPtr + iv -1)->Z; " )"
End If
Next i
Print #f, "glEnd()"
Print #f,
Next iface
End If
Next ig
End If
Else
Print
Print "See Data in Output file.
Print
End If
If M.Vertices > 0 Then DeAllocate(M.VertexPtr)
If M.TexCoords > 0 Then DeAllocate(M.TexCoordPtr)
If M.Normals > 0 Then DeAllocate(M.NormalPtr)
If M.Materials > 0 Then DeAllocate(M.MaterialPtr)
If M.Groups > 0 Then DeAllocate(M.GroupPtr)
If M.Faces > 0 Then DeAllocate(M.FacePtr)
If M.FaceVertices > 0 Then DeAllocate(M.FaceVertexPtr)
Close #f
Print
Print "Output file is > "; Left(M.ModelName, instr(M.ModelName, ".")) + "bi"
Print "Press any key to continue."
Sleep
End
A simple cube.
Cube.obj
Code: Select all
# file generated by UVMapper
# NumVerts/NumTVerts/NumVNormals/NumFacets 8/24/30/6
# NumGroups/NumMaterials/NumRegions 1/0/0
# x/y/color/ppu 1024/768/0/50.00000000
v -30.00000000 -30.00000000 -30.00000000
v -30.00000000 -30.00000000 30.00000000
v -30.00000000 30.00000000 -30.00000000
v -30.00000000 30.00000000 30.00000000
v 30.00000000 -30.00000000 -30.00000000
v 30.00000000 -30.00000000 30.00000000
v 30.00000000 30.00000000 -30.00000000
v 30.00000000 30.00000000 30.00000000
vt 0.98000002 0.65000004
vt 0.75500000 0.65000004
vt 0.75500000 0.35000002
vt 0.98000002 0.35000002
vt 0.48999998 0.35000002
vt 0.48999998 0.65000004
vt 0.26499999 0.65000004
vt 0.26499999 0.35000002
vt 0.24499999 0.35000002
vt 0.24499999 0.65000004
vt 0.02000000 0.65000004
vt 0.02000000 0.35000002
vt 0.73500001 0.65000004
vt 0.50999999 0.65000004
vt 0.50999999 0.35000002
vt 0.73500001 0.35000002
vt 0.26499999 0.67500001
vt 0.48999998 0.67500001
vt 0.48999998 0.97500002
vt 0.26499999 0.97500002
vt 0.48999998 0.02500000
vt 0.48999998 0.32500002
vt 0.26499999 0.32500002
vt 0.26499999 0.02500000
vn 0.00000000 0.00000000 -1.00000000
vn 0.00000000 0.00000000 1.00000000
vn -1.00000000 0.00000000 0.00000000
vn 1.00000000 0.00000000 0.00000000
vn 0.00000000 1.00000000 0.00000000
vn 0.00000000 -1.00000000 0.00000000
vn 0.00000000 0.00000000 -1.00000000
vn 0.00000000 -1.00000000 0.00000000
vn -1.00000000 0.00000000 0.00000000
vn 0.00000000 0.00000000 1.00000000
vn 0.00000000 -1.00000000 0.00000000
vn -1.00000000 0.00000000 0.00000000
vn 0.00000000 0.00000000 -1.00000000
vn 0.00000000 1.00000000 0.00000000
vn -1.00000000 0.00000000 0.00000000
vn 0.00000000 0.00000000 1.00000000
vn 0.00000000 1.00000000 0.00000000
vn -1.00000000 0.00000000 0.00000000
vn 0.00000000 0.00000000 -1.00000000
vn 0.00000000 -1.00000000 0.00000000
vn 1.00000000 0.00000000 0.00000000
vn 0.00000000 0.00000000 1.00000000
vn 0.00000000 -1.00000000 0.00000000
vn 1.00000000 0.00000000 0.00000000
vn 0.00000000 0.00000000 -1.00000000
vn 0.00000000 1.00000000 0.00000000
vn 1.00000000 0.00000000 0.00000000
vn 0.00000000 0.00000000 1.00000000
vn 0.00000000 1.00000000 0.00000000
vn 1.00000000 0.00000000 0.00000000
g group1
f 3/1/13 7/2/25 5/3/19 1/4/7
f 6/5/22 8/6/28 4/7/16 2/8/10
f 2/9/12 4/10/18 3/11/15 1/12/9
f 7/13/27 8/14/30 6/15/24 5/16/21
f 4/17/17 8/18/29 7/19/26 3/20/14
f 5/21/20 6/22/23 2/23/11 1/24/8
Cube.bas
Code: Select all
'
' display cube
' FreeBASIC - v0.15b - Win98se
' cube.bas - 20060106 - JohnB
'
'
' 20060106 - fixed object rotation, order needed to be yaw, pitch, roll
'
Option Explicit
Option Base 0
'$include: "SDL/SDL.bi"
'$include: "SDL/SDL_mouse.bi"
'$include: "GL/gl.bi"
'$include: "GL/glu.bi"
'
'SDL code
'
Dim result As unSigned Integer
Dim video As SDL_Surface Ptr
Dim event As SDL_Event
'Dim w As Integer : w = 800
'Dim h As Integer : h = 600
Dim w As Integer : w = 1024
Dim h As Integer : h = 768
Dim bpp As Integer : bpp = 32
dim passes as integer
dim time_start as integer
dim time_end as integer
result = SDL_Init(SDL_INIT_EVERYTHING)
If result <> 0 Then
End 1
End If
SDL_GL_SetAttribute SDL_GL_DOUBLEBUFFER, 1
dim flags as uinteger : flags = SDL_FULLSCREEN Or SDL_OPENGL Or SDL_OPENGLBLIT Or SDL_HWSURFACE Or SDL_HWACCEL Or SDL_OPENGLBLIT
video = SDL_SetVideoMode(w, h, bpp, flags)
If video = 0 Then
SDL_Quit
End 1
End If
glViewport 0, 0, w, h
glMatrixMode GL_PROJECTION
glLoadIdentity
gluPerspective 80/2, w / h, 1.0, 5000.0
glMatrixMode GL_MODELVIEW
glLoadIdentity
glShadeModel GL_SMOOTH
glClearColor 0.0, 0.0, 0.0, 1.0
glClearDepth 1.0
glEnable GL_DEPTH_TEST
glDepthFunc GL_LEQUAL
glHint GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST
'
'lights
'
Dim lightAmb(4) As Single : lightAmb(0) = 0.1 : lightAmb(1) = 0.1 : lightAmb(2) = 0.1 : lightAmb(3) = 1.0
Dim lightDif(4) As Single : lightDif(0) = 1.0 : lightDif(1) = 1.0 : lightDif(2) = 1.0 : lightDif(3) = 1.0
Dim lightSpec(4) As Single : lightSpec(0) = 0.2 : lightSpec(1) = 0.2 : lightSpec(2) = 0.2 : lightSpec(3) = 1.0
Dim lightPos(4) As Single : lightPos(0) = 120.0 : lightPos(1) = 120.0 : lightPos(2) = 120.0 : lightPos(3) = 1.0
glLightfv GL_LIGHT1, GL_AMBIENT, @lightAmb(0)
glLightfv GL_LIGHT1, GL_DIFFUSE, @lightDif(0)
glLightfv GL_LIGHT1, GL_SPECULAR, @lightSpec(0)
glLightfv GL_LIGHT1, GL_POSITION,@lightPos(0)
glEnable GL_LIGHT1
glEnable GL_LIGHTING
glPolygonMode(GL_FRONT_AND_BACK, GL_FILL)
glDisable(GL_TEXTURE_2D)
dim cube1 as uinteger
cube1 = glGenLists(1)
glNewList cube1, GL_COMPILE
'
' insert generated code here
' -----------------------------------------------------------------------------
'$include: "Cube.bi"
' -----------------------------------------------------------------------------
' end generated code
'
glEndList
dim done as integer : done = 0
dim z_start as single : z_start = -120.0
dim world_rotate_x as single : world_rotate_x = 0.0
dim world_rotate_y as single : world_rotate_y = 0.0
dim object_translate_x as single : object_translate_x = 0.0
dim object_translate_y as single : object_translate_y = 0.0
dim object_translate_z as single : object_translate_z = z_start
dim object_rotate_x as single : object_rotate_x = 0.0
dim object_rotate_y as single : object_rotate_y = 0.0
dim object_rotate_z as single : object_rotate_z = 0.0
SDL_EnableKeyRepeat(1, 1)
SDL_ShowCursor 0
passes = 0
time_start = timer
do while (done = 0)
passes += 1
glClear GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT
glPushMatrix
glRotatef(world_rotate_y, 0.0, 1.0, 0.0)
glRotatef(world_rotate_x, 1.0, 0.0, 0.0)
glTranslatef object_translate_x, object_translate_y, object_translate_z
glRotatef(object_rotate_z, 0.0, 0.0, 1.0)
glRotatef(object_rotate_x, 1.0, 0.0, 0.0)
glRotatef(object_rotate_y, 0.0, 1.0, 0.0)
glCallList cube1
glPopMatrix
SDL_GL_SwapBuffers
do while (SDL_PollEvent(@event))
if (event.type = SDL_QUIT_) then done = 1
if (event.type = SDL_KEYDOWN) then
select case event.key.keysym.sym
case SDLK_ESCAPE
done = 1
case SDLK_UP
world_rotate_x += 0.1
case SDLK_DOWN
world_rotate_x -= 0.1
case SDLK_LEFT
world_rotate_y += 0.1
case SDLK_RIGHT
world_rotate_y -= 0.1
case SDLK_PAGEUP
object_translate_z += 1.0
case SDLK_PAGEDOWN
object_translate_z -= 1.0
case SDLK_KP2
object_rotate_x += 1.0
case SDLK_KP8
object_rotate_x -= 1.0
case SDLK_KP6
object_rotate_y += 1.0
case SDLK_KP4
object_rotate_y -= 1.0
case SDLK_KP1
object_rotate_z += 1.0
case SDLK_KP3
object_rotate_z -= 1.0
case SDLK_r
world_rotate_x = 0.0
world_rotate_y = 0.0
object_translate_z = z_start
object_rotate_x = 0.0
object_rotate_y = 0.0
object_rotate_z = 0.0
end select
end if
loop
loop
SDL_ShowCursor 1
SDL_Quit
time_end = timer
print "Passes = ", passes
print "FPS = ", passes/(time_end - time_start)
print
End