Another thing in OpenGL is quadrics. First of all I have to thank @Ashish Kushwaha for his help with quadrics here as he showed me how to bring them to QB64 in 2017. Quadrics are not directly supported by QB64, so they have to be helped via the H file. After that, they already work willingly.
The source code and zip file are attached. The zip contains 6 texture files, the source code and the necessary h file. Without it, it won't work. Upload the H file to the same folder where you have QB64PE.EXE!
Unlike the default C version, I went further here and allowed you to cause deformations of quadrics (within their parameters), i.e. a cube can be made into a brick, a block, a slab, a sphere can be made into something warped, the diameter of a cylinder can be changed and so on.
Zoom is added in the Z axis using the mouse wheel, lighting using the L key. You can change the quadric by pressing the space bar.
Quadrics can also be placed inside each other to create a new shape, but that is not part of this program.
quadrics.zip (Size: 1.97 MB / Downloads: 44)
The source code and zip file are attached. The zip contains 6 texture files, the source code and the necessary h file. Without it, it won't work. Upload the H file to the same folder where you have QB64PE.EXE!
Unlike the default C version, I went further here and allowed you to cause deformations of quadrics (within their parameters), i.e. a cube can be made into a brick, a block, a slab, a sphere can be made into something warped, the diameter of a cylinder can be changed and so on.
Zoom is added in the Z axis using the mouse wheel, lighting using the L key. You can change the quadric by pressing the space bar.
Quadrics can also be placed inside each other to create a new shape, but that is not part of this program.
Code: (Select All)
'Quadric demo. Show how do texture to quadric object. Thank Ashish Kushwaha for help with knowledge about gluNewQuadric arrays. Its directly unsupported QB64 type, so this program muss use external C++ help H file!
'first i declare all need glut statements (directly unsupported) See to file help.h how its writed. Its inspired by Ashish's Planets.bas and void gluSphere used inside H file :)
Screen _NewImage(1024, 768, 32)
Declare Library "help3"
Sub initQuadric ()
Sub drawCylinder (ByVal Baze As Double, Byval top As Double, Byval height As Double, Byval slices As Integer, Byval stacks As Integer)
Sub drawDisk (ByVal inner As Double, Byval outer As Double, Byval slices As Integer, Byval loops As Integer)
Sub drawSphere (ByVal radius As Double, Byval slices As Integer, Byval stacks As Integer)
Sub drawCone (ByVal baze As Double, Byval height As Double, Byval slices As Integer, Byval stacks As Integer)
Sub drawPartialDisk (ByVal inner As Double, Byval outter As Double, Byval slices As Integer, Byval loops As Integer, Byval start As Double, Byval sweep As Double) 'pokud nedas slovo BYVAL, predavas offsety!
End Declare
Declare CustomType Library
Sub gluBuild2DMipmaps (ByVal Target As _Unsigned Long, Byval iFormat As Long, Byval Wdth As Long, Byval Hght As Long, Byval format As _Unsigned Long, Byval typ As _Unsigned Long, Byval dat As _Offset)
End Declare
_Title "OpenGL Quadrics in QB64"
Type GL_Loader
PointerGL As Long
TextureName As String
Filtering As _Unsigned _Byte
End Type
ReDim Shared GLL(0) As GL_Loader, t As Long
Dim Shared GL_InitInfo As _Byte, preINIT As _Byte
Dim Shared ExitSignal As _Byte, Blend As _Byte
'---------------------------------------------------
Dim Shared LightAmbient(3)
Dim Shared LightDiffuse(3) 'three arrays for light. Try comment DEPTH stetements...
Dim Shared LightPosition(3)
'declare arrays for lightning:
LightAmbient(0) = 0.5F: LightAmbient(1) = 0.5F: LightAmbient(2) = 0.5F: LightAmbient(3) = 1.0F 'ambient light
LightDiffuse(0) = 1.0F: LightDiffuse(1) = 1.0F: LightDiffuse(2) = 1.0F: LightDiffuse(3) = 1.0F: 'direct light
LightPosition(0) = 0.0F: LightPosition(1) = 0.0F: LightPosition(2) = 2.0F: LightPosition(3) = 1.0F 'light position
Dim Shared Part1, Part2, P1, P2, Xrot, Yrot, Xspeed, Yspeed, Li, Z, Selected
Dim Shared Textures(5) As Long
Z = -5
Li = 1
P1 = 0
P2 = 1
'extras
Type Object ' this array - for this program use: index 0 for cube;
W As Single 'object width
H As Single 'object height
D As Single 'object depth
R1 As Single 'object radius 1
R2 As Single 'object radius 2
Slices As Single
Stacks As Single
Loops As Single
Baze As Single
Top As Single
Height As Single
Inner As Single
Outer As Single
End Type
Dim Shared Set(5) As Object
Set(0).W = 1: Set(0).H = 1: Set(0).D = 1 'cube
Set(1).Baze = 1: Set(1).Top = 1.4: Set(1).Height = 1: Set(1).Slices = 8: Set(1).Stacks = 4
Set(2).Inner = 0.1: Set(2).Outer = 0.7: Set(2).Slices = 40: Set(2).Loops = 60 'disc
Set(3).R1 = 1.3: Set(3).Slices = 12: Set(3).Stacks = 12 'sphere basic settings
Set(4).R1 = 1: Set(4).Height = 1: Set(4).Slices = 16: Set(4).Stacks = 30 'cone
Set(5).Inner = 0.2: Set(5).Outer = 0.4: Set(5).Slices = 12: Set(5).Loops = 40: Set(5).R1 = 45: Set(5).R2 = 135 'partial disc
_DisplayOrder _GLRender , _Software ' OpenGL draw first, therefore Software screen can rewrite OpenGL screen content
Do While _KeyHit <> 27
While _MouseInput
Z = Z + _MouseWheel 'depth select
Wend
i$ = InKey$
Locate 1
Select Case Selected
Case 0 'cube
Print "Press Q/A for Width, W/S for Height, E/D for Depth, Mousewheel for zoom "
Select Case UCase$(i$)
Case "Q": Set(0).W = Set(0).W + .1
Case "A": Set(0).W = Set(0).W - .1
Case "W":: Set(0).H = Set(0).H + .1
Case "S": Set(0).H = Set(0).H - .1
Case "E":: Set(0).D = Set(0).D + .1
Case "D":: Set(0).D = Set(0).D - .1
End Select
Case 1 'cylinder
Print "Press Q/A for set Base, W/S for set Top, E/D for Height, R/F for Slices, G/T for Stacks, Mouse wheel for zoom"
Select Case UCase$(i$)
Case "Q": Set(1).Baze = Set(1).Baze + .1
Case "A": Set(1).Baze = Set(1).Baze - .1
Case "W": Set(1).Top = Set(1).Top + .1
Case "S": Set(1).Top = Set(1).Top - .1
Case "E": Set(1).Height = Set(1).Height + .1
Case "D": Set(1).Height = Set(1).Height - .1
Case "R": Set(1).Slices = Set(1).Slices + 1
Case "F": Set(1).Slices = Set(1).Slices - 1
Case "G": Set(1).Stacks = Set(1).Stacks + 1
Case "T": Set(1).Stacks = Set(1).Stacks - 1
End Select
Case 2 'disc
' Sub drawDisk (ByVal inner As Double, Byval outer As Double, Byval slices As Integer, Byval loops As Integer)
Print "Press Q/A for inner radius W/S for outer radius, E/D for slices, R/F for loops settin, Mouse wheel for zoom. "
Select Case UCase$(i$)
Case "Q": Set(2).Inner = Set(2).Inner + .1
Case "A": Set(2).Inner = Set(2).Inner - .1
Case "W": Set(2).Outer = Set(2).Outer + .1
Case "S": Set(2).Outer = Set(2).Outer - .1
Case "E": Set(2).Slices = Set(2).Slices + 1
Case "D": Set(2).Slices = Set(2).Slices - 1
Case "R": Set(2).Loops = Set(2).Loops + 1
Case "F": Set(2).Loops = Set(2).Loops - 1
End Select
Case 3 'sphere
' Sub drawSphere (ByVal radius As Double, Byval slices As Integer, Byval stacks As Integer)
Print "Press Q/A for radius W/S for slices, E/D for stacks, Mouse wheel for zoom. "
Select Case UCase$(i$)
Case "Q": Set(3).R1 = Set(3).R1 + .1
Case "A": Set(3).R1 = Set(3).R1 - .1
Case "E": Set(3).Stacks = Set(3).Stacks + 1
Case "D": Set(3).Stacks = Set(3).Stacks - 1
Case "W": Set(3).Slices = Set(3).Slices + 1
Case "S": Set(3).Slices = Set(3).Slices - 1
End Select
Case 4 'cone
Print "Press Q/A for base radius W/S for height, E/D for slices, R/F for stacks, Mouse wheel for zoom. "
Select Case UCase$(i$)
Case "Q": Set(4).R1 = Set(4).R1 + .1
Case "A": Set(4).R1 = Set(4).R1 - .1
Case "R": Set(4).Stacks = Set(4).Stacks + 1
Case "F": Set(4).Stacks = Set(4).Stacks - 1
Case "E": Set(4).Slices = Set(4).Slices + 1
Case "D": Set(4).Slices = Set(4).Slices - 1
Case "W": Set(4).Height = Set(4).Height + 1
Case "S": Set(4).Height = Set(4).Height - 1
End Select
Case 5 'partial disc
'Sub drawPartialDisk (ByVal inner As Double, Byval outter As Double, Byval slices As Integer, Byval loops As Integer, Byval start As Double, Byval sweep As Double) 'pokud nedas slovo BYVAL, predavas offsety!
Print "Q/A start, W/S sweep, E/D inner rad., R/F outer rad., T/G slices, Y/H loops Mouse wheel for zoom. "
Select Case UCase$(i$)
Case "Q": Set(5).R1 = Set(5).R1 + 1 'start
Case "A": Set(5).R1 = Set(5).R1 - 1
Case "W": Set(5).R2 = Set(5).R2 + 1 'sweep
Case "S": Set(5).R2 = Set(5).R2 - 1
Case "E": Set(5).Inner = Set(5).Inner + .1
Case "D": Set(5).Inner = Set(5).Inner - .1
Case "R": Set(5).Outer = Set(5).Outer + .1
Case "F": Set(5).Outer = Set(5).Outer - .1
Case "T": Set(5).Slices = Set(5).Slices + 1
Case "G": Set(5).Slices = Set(5).Slices - 1
Case "Y": Set(5).Loops = Set(5).Loops + 1
Case "H": Set(5).Loops = Set(5).Loops - 1
End Select
End Select
Select Case LCase$(i$)
Case "l": Li = Li * -1: _Delay .25 'enable / disable lightning
Case Chr$(32): Selected = Selected + 1: If Selected > 5 Then Selected = 0
End Select
Loop
Sub _GL
Static set()
If preINIT = 0 Then 'procedures starting so: 1] libraries H, DLL 2] SHARED variables and SUB _GL 3] SHARED arrays and QB64
preINIT = 1
Exit Sub
End If
Xrot = Xrot + .3
Yrot = Yrot - .3
Init2
'call initializing functions to do visible texture
W = _Width
H = _Height
_glViewport 0, 0, W, H
_glMatrixMode _GL_PROJECTION
_glLoadIdentity
_glEnable _GL_DEPTH_TEST
If Li = 1 Then _glEnable _GL_LIGHTING Else _glDisable _GL_LIGHTING
_glEnable _GL_LIGHT0
_glLightfv _GL_LIGHT0, _GL_SPECULAR, _Offset(LightAmbient())
_glLightfv _GL_LIGHT0, _GL_AMBIENT, _Offset(LightDiffuse())
_glLightfv _GL_LIGHT0, _GL_POSITION, _Offset(LightPosition())
_glShadeModel _GL_SMOOTH 'how to shade model with light
_gluPerspective 33, W / H, 0.1, 600.0
texture& = Textures(Selected) 'let each object have its own texture, textures are call from INIT2 in begin this program
_glEnable _GL_TEXTURE_2D
_glBindTexture _GL_TEXTURE_2D, texture&
_glClear _GL_COLOR_BUFFER_BIT
_glClear _GL_DEPTH_BUFFER_BIT
_glTranslatef 0.0F, 0.0F, Z
_glRotatef Xrot, 1.0F, 0.0F, 0.0F
_glRotatef Yrot, 0.0F, 1.0F, 0.0F
Rem Dim As Double pb, part1
Select Case Selected
Case 0
glDrawCube Set(0).W, Set(0).H, Set(0).D
Case 1
drawCylinder Set(1).Baze, Set(1).Top, Set(1).Height, Set(1).Slices, Set(1).Stacks
Case 2:
drawDisk Set(2).Inner, Set(2).Outer, Set(2).Slices, Set(2).Loops
Case 3:
drawSphere Set(3).R1, Set(3).Slices, Set(3).Stacks
Case 4:
drawCone Set(4).R1, Set(4).Height, Set(4).Slices, Set(4).Stacks
Case 5
drawPartialDisk Set(5).Inner, Set(5).Outer, Set(5).Slices, Set(5).Loops, Set(5).R1, Set(5).R2
End Select
End Sub
Sub Init2
If GL_InitInfo = 0 Then
Textures(0) = LoadTexture("0.png", 1)
Textures(1) = LoadTexture("1.png", 1)
Textures(2) = LoadTexture("2.png", 1)
Textures(3) = LoadTexture("3.png", 1) 'numbers as filenames = none upcase / lowercase problem for Linux...
Textures(4) = LoadTexture("4.png", 1)
Textures(5) = LoadTexture("5.png", 1)
initQuadric
GL_InitInfo = 1
Exit Sub
End If
End Sub
Sub glDrawCube (W, H, D)
_glBegin _GL_QUADS
'front wall
'_glNormal3f 0.0F, 0.0F, 1.0F
_glTexCoord2f 0.0F, 0.0F: _glVertex3f -1.0F * W, -1.0F * H, 1.0F * D 'levy spodni bod
_glTexCoord2f 1.0F, 0.0F: _glVertex3f 1.0F * W, -1.0F * H, 1.0F * D
_glTexCoord2f 1.0F, 1.0F: _glVertex3f 1.0F * W, 1.0F * H, 1.0F * D
_glTexCoord2f 0.0F, 1.0F: _glVertex3f -1.0F * W, 1.0F * H, 1.0F * D
'rear wall
'_glNormal3f 0.0F, 0.0F, -1.0F
_glTexCoord2f 1.0F, 0.0F: _glVertex3f -1.0F * W, -1.0F * H, -1.0F * D
_glTexCoord2f 1.0F, 1.0F: _glVertex3f -1.0F * W, 1.0F * H, -1.0F * D
_glTexCoord2f 0.0F, 1.0F: _glVertex3f 1.0F * W, 1.0F * H, -1.0F * D
_glTexCoord2f 0.0F, 0.0F: _glVertex3f 1.0F * W, -1.0F * H, -1.0F * D
'top wall
'_glNormal3f 0.0F, 1.0F, 0.0F
_glTexCoord2f 0.0F, 1.0F: _glVertex3f -1.0F * W, 1.0F * H, -1.0F * D
_glTexCoord2f 0.0F, 0.0F: _glVertex3f -1.0F * W, 1.0F * H, 1.0F * D
_glTexCoord2f 1.0F, 0.0F: _glVertex3f 1.0F * W, 1.0F * H, 1.0F * D
_glTexCoord2f 1.0F, 1.0F: _glVertex3f 1.0F * W, 1.0F * H, -1.0F * D
'bottom wall
'_glNormal3f 0.0F, -1.0F, 0.0F
_glTexCoord2f 1.0F, 1.0F: _glVertex3f -1.0F * W, -1.0F * H, -1.0F * D
_glTexCoord2f 0.0F, 1.0F: _glVertex3f 1.0F * W, -1.0F * H, -1.0F * D
_glTexCoord2f 0.0F, 0.0F: _glVertex3f 1.0F * W, -1.0F * H, 1.0F * D
_glTexCoord2f 1.0F, 0.0F: _glVertex3f -1.0F * W, -1.0F * H, 1.0F * D
'right wall
'_glNormal3f 1.0F, 0.0F, 0.0F
_glTexCoord2f 1.0F, 0.0F: _glVertex3f 1.0F * W, -1.0F * H, -1.0F * D
_glTexCoord2f 1.0F, 1.0F: _glVertex3f 1.0F * W, 1.0F * H, -1.0F * D
_glTexCoord2f 0.0F, 1.0F: _glVertex3f 1.0F * W, 1.0F * H, 1.0F * D
_glTexCoord2f 0.0F, 0.0F: _glVertex3f 1.0F * W, -1.0F * H, 1.0F * D
'left wall
'_glNormal3f -1.0F, 0.0F, 0.0F
_glTexCoord2f 0.0F, 0.0F: _glVertex3f -1.0F * W, -1.0F * H, -1.0F * D
_glTexCoord2f 1.0F, 0.0F: _glVertex3f -1.0F * W, -1.0F * H, 1.0F * D
_glTexCoord2f 1.0F, 1.0F: _glVertex3f -1.0F * W, 1.0F * H, 1.0F * D
_glTexCoord2f 0.0F, 1.0F: _glVertex3f -1.0F * W, 1.0F * H, -1.0F * D
_glEnd
End Sub
Function LoadTexture (image As String, Filter As _Unsigned _Byte)
' If GL_InitInfo = 0 Then GL_Init
If _FileExists(image) Then
TT = 0
Do Until TT = UBound(GLL)
If GLL(TT).TextureName = image$ And GLL(TT).Filtering = Filter Then
LoadTexture = GLL(TT).PointerGL 'prevent memory leak loading next and next texture again and angain...
Exit Function
End If
TT = TT + 1
Loop
tex& = _LoadImage(image$, 32)
_ClearColor _RGB32(255, 255, 0), tex&
texinv& = _NewImage(_Width(tex&), _Height(tex&), 32)
_PutImage (0, _Height(tex&))-(_Width(tex&), 0), tex&, texinv&
Dim Texture As _Unsigned Long
_glGenTextures 1, _Offset(Texture) 'generate our texture handle (reserve place in memory for new texture)
_glBindTexture _GL_TEXTURE_2D, Texture 'select our texture handle (set this texture for use)
gluBuild2DMipmaps _GL_TEXTURE_2D, 4, _Width(texinv&), _Height(texinv&), _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, _Offset(texinv&)
Dim m As _MEM
m = _MemImage(texinv&)
Select Case Filter
Case 3
'set our texture wrapping
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_S, _GL_REPEAT
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_T, _GL_REPEAT
Case 0
'set out texture filtering
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_NEAREST 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_NEAREST 'for scaling down
Case 1
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR 'for scaling down
Case 2 'works....not sure, if this output is correct
'gluBuild2DMipmaps(GL_TEXTURE_2D, pic->bpp/8, pic->width, pic->height, textureType, GL_UNSIGNED_BYTE, pic->data);
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR_MIPMAP_LINEAR 'for scaling down
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR '
' 'for scaling UP
End Select
_FreeImage tex&
_glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGB, _Width(texinv&), _Height(texinv&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, m.OFFSET
saveit:
U = UBound(GLL)
GLL(U).PointerGL = Texture
GLL(U).TextureName = image
GLL(U).Filtering = Filter
ReDim _Preserve GLL(U + 1) As GL_Loader
_MemFree m
Else
Print "LoadTexture Error: "; image$; " - file not found."
End If
LoadTexture = Texture
End Function
quadrics.zip (Size: 1.97 MB / Downloads: 44)