Thanks for the reply ! To be honest, I started studying OPENGL many times, but I always gave up. I like the light options and that I don't have to calculate the position of the points in the program.
Thank for reaction, @mnrvovrfc. Zip file is now updated, all filenammes are lowercase. To problem with mouse. I can not replicate this bug here, so you can help me find who is problem under Linux. My tip is - try comment statement _MouseMove - line 49. If this not help, try also comment _MouseHide - row 43. I don't think the _MouseMovementX and _MousemovementY functions should be causing the problem, so try those too to see what's causing the problem. Once I will know that, I can then modify the program for the precompiler by adding the $IF WIN condition...
@MasterGy - it just looks like that with those calculations. Today I studied a program in OpenGL to calculate shadows, well, that's really a different universe. I was completely out of it (i have brain error from it - knowledge out of range) But what an amazing thing, these are Display Lists. That would be really hard to solve with Maptriangle, I really can't imagine that. It's - if I convert it to 2D - it's basically the same as if you upload images to memory and then you just insert them and the program is fast. This in OpenGL does the same with models (already textured) and then you actually just take copies of those bodies and put them on the scene. I'm now trying to get as far with OpenGL as possible (as far as I can) and then start mixing it with MEMSOUND. It's just going to be a massacre. I've also been toying with the idea of trying to convert from the OpenGL 3DWorld demo to _MapTriangle3D, what do you think?
(04-03-2023, 02:12 PM)Petr Wrote: ... To problem with mouse. I can not replicate this bug here, so you can help me find who is problem under Linux. My tip is - try comment statement _MouseMove - line 49. If this not help, try also comment _MouseHide - row 43. ...
Taking line 49 out of commission did the trick. Turning _MouseHide into a comment did no good because it's outside the main loop. I tried this on a different Linux OS installation and instead of crashing to terminal, the program hanged strictly locking the mouse to the center of its window. Never had that happen to me before even on Windows. :/
It looks like the inner workings of _MouseMove collides somewhere with the OpenGL stuff. It might be a thread conflict or a race condition. It indicates that the programmer has the choice to compose entirely of OpenGL statements and functions to do graphics and HID response, or to utilize the ordinary ones in QB64(PE) like LINE, _KeyDown and _MouseMove. One or the other, not both.
@mnrvovrfc the locking of the mouse in the middle of the screen, that was the intended action, simply so that when controlling the movement (rotation in the X/Z axes) it does not happen that you leave the program window with the mouse and the program stops responding to movement. But it shouldn't cause the program to freeze or crash. It worked flawlessly this way in Windows. I will disable this line in the source code for Linux and the problem will be over. Thanks for trying it out.
04-03-2023, 09:02 PM (This post was last modified: 04-14-2023, 02:55 PM by Petr.
Edit Reason: BYVAL....
)
Here is Display List Demo.
It speeds up work considerably. For example, in this program, in the BuildLists Sub, a cube is classically created using the glVertex3f and _glCoord2f commands. So it is then stored without being displayed in memory. Then, when needed, it is called into place, covered with (any) texture, and displayed. OpenGL doesn't have to calculate anything anymore, it just takes it and slaps it in place. This is a significant acceleration of work. Being able to finish this was an experience.
I ran into a problem that I ended up having to solve by using a different command. This is the _glColor3fv command. Reads three color values from the array at once. So. I am asking people who know C to take a look at this source code, the original initialization in the C language is also commented there, it is lines 20 to 43 and 172 to 177. I think I did what I could, but at end I use the classic field and the _glColor3f command, but since these mismatches will increase, I am interested in how to go about it.
Thank you.
The program requires an attached freely available texture to run.
Code: (Select All)
_Title "Display List demo"
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
$If WIN Then
$End If
Type GL_Loader ' array for loading textures
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 ' is need for OpenGL init
Dim Shared ExitSignal As _Byte ' is need for correct OpenGL exit when program end
'HOW CALL 3 values once in QB64 using Offset????
'-------------------------------------------------------
Dim Shared BoxCol(5) As RGB 'for cube colors
Restore BXC
For Row = 1 To 5
For Column = 1 To 3
Read Value
Select Case Column
Case 1: BoxCol(Row).R = Value
Case 2: BoxCol(Row).G = Value
Case 3: BoxCol(Row).B = Value
End Select
Next
Next
'colors for cube
BXC:
Data 1.0,0.0,0.0
Data 1.0,0.5,0.0
Data 1.0,1.0,0.0
Data 0.0,1.0,0.0
Data 0.0,1.0,1.0
Dim Shared TopCol(5) As RGB
Restore TPC
For Row = 1 To 5
For Column = 1 To 3
Read Value
Select Case Column
Case 1: TopCol(Row).R = Value
Case 2: TopCol(Row).G = Value
Case 3: TopCol(Row).B = Value
End Select
Next
Next
'colors for lid
TPC: '
Data 0.5,0.0,0.0
Data 0.5,0.25,0.0
Data 0.5,0.5,0.0
Data 0.0,0.5,0.0
Data 0.0,0.5,0.5
Dim Shared As _Unsigned Long Box, Top
Dim Shared BoxTexture(1) As _Unsigned Long
Dim Shared As Single Yrot, Xrot
Screen _NewImage(1024, 768, 32)
Print "What you see on the screen is just 1 cube copyed as more cubes and colored and textured with _glGenLists, _glNewList and _glCallList. Use arrows."
Do
i& = _KeyHit
Select Case i&
Case 20480 'arrow up
Xrot = Xrot + .4
Case 18432 'arrow down
Xrot = Xrot - .4
Case 19200 'arrow left
Yrot = Yrot - .4
Case 19712 'arrow right
Yrot = Yrot + .4
End Select
If ExitSignal Then System
_Limit 50
Loop
Sub _GL ()
' Static Xrot, Yrot
Init2
GL_Init
_glClear _GL_COLOR_BUFFER_BIT And _GL_DEPTH_BUFFER_BIT 'Clear screen and depth buffer
_glMatrixMode _GL_PROJECTION ' Set projection matrix - TRY comment this five rows and then run it. Black screen occur. For view just something then must be depth set to -1 (Z parameter in _glTranslateF)
_glLoadIdentity ' Reset matrix
_glBindTexture _GL_TEXTURE_2D, BoxTexture(1)
For yloop = 1 To 6
'The following line moves the origin of the coordinates to the given point on the screen. At first glance it's a bit confusing.
' On the x-axis: We move to the right by 1.4 units so that the pyramid is in the center of the screen. Then we multiply the xloop
'variable by 2.8 and add 1.4. (We multiply by 2.8 so the cubes are not on top of each other. 2.8 is approximately their width when
' rotated 45 degrees.) Finally, we subtract yloop*1.4. This will move them to the left depending on which row we are on. If we didn't
' move them, they would line up on the left side. (And they don't look like a pyramid.)
'On the y-axis: We subtract the variable yloop from six, otherwise the pyramid would be created upside down. Then we multiply the
'result by 2.4. Otherwise the cubes will be on top of each other on the Y axis. (2.4 is roughly equal to the height of the cube).
'Then we subtract 7 so the pyramid starts at the bottom of the screen and is built from the bottom up.
'On the z-axis: We move 20 units inward. So the pyramid just fits on the screen.
xloop = 1
Do Until xloop = yloop 'Dále máme vnořený cyklus s proměnnou xloop. Je použitý pro pozici krychlí na ose x. Jejich počet závisí na tom, ve kterém řádku se nacházejí. Pokud se nacházíme v horním řádku vykreslíme jednu, ve druhém dvě, atd.
_glLoadIdentity
'// Pozice krychle na obrazovce
'We choose the color of the box (light). Note that we use glColor3fv(). - I NOT BECAUSE IT WORK NOT CORRECT.
' This function selects all three values (red, green, blue) at once to set the color. In this case, we find it in
' the boxcol field with index yloop-1. This ensures a different color for each row of the pyramid. If we used xloop-1 we would get the same colors for each column.
' _glColor3fv hard uncompatible statement or i dont know how use it. He read 3 color values once from array, defined in c as [5] [3] (5 rows, 3 color values (R,G,B) on 1 row. All outputs was bad
' it try load color array as Topcol(3,5), then as Topcol(5,3), then as Topcol(15) then as _MEM (single = 4 * 15) - all that return black out (black screen) or white screen or program crashed, and if
' are colors created, are different than awaited colors. In end i use _glColor3f, because this..... so this.... i dont know how correct use it, ALSO if original C program call it here as TopCol [y-1]
' without second parameter...
' _glBindTexture _GL_TEXTURE_2D, BoxTexture(1) ' for case you load second texture, you can try use it as box lid
_glCallList (Box) ';// Vykreslení
xloop = xloop + 1
'_glBindTexture _GL_TEXTURE_2D, BoxTexture(0) 'if you use 2 textures, set previous for box back
Loop
Next
If _Exit Then
' DeleteTexture t 'if program end, first free texture from memory, then exit from GL and return to main loop
KillAllTextures
_glClear _GL_COLOR_BUFFER_BIT
ExitSignal = Not 0
Exit Sub
End If
End Sub
Sub BuildLists 'this sub build 1 box + 1 lid and save it as glList
'glVoid BuildLists
Box = _glGenLists(2)
'We will create the first sheet. We have already taken up space for two sheets and know that the box points to the beginning of the prepared memory. We will use the glNewList() command.
'The first box parameter says that we want to store the sheet in the memory it points to.
'The second GL_COMPILE parameter says that we want to pre-create the sheet in memory so that it doesn't have to be generated and recomputed every time it's rendered. GL_COMPILE is the same as programming.
'If you write a program and load it into your compiler, you have to compile it every time you want to run it. But if it is compiled into an .exe file, all that needs to be done to run it is
'mouse click on this .exe file and run it. Without compilation of course. Whatever OpenGL compiles into the display list can be used without any further recomputation. Rendering speeds up.
Top = Box + 1 '
_glNewList Top, _GL_COMPILE 'compile display list - lid
'With the glEndList() command, we announce that we are ending the creation of the list. Anything between glNewList() and glEndList()
'is part of the display list, and vice versa, if there is anything before or after it no longer belongs to it. To find out where to store
'the second display sheet, we take the value of the one already created and add one to it (we said at the beginning of the function that
'we are making 2 display sheets, so it's fine).
End Sub
Sub GL_Init
If GL_InitInfo = 0 Then
_glViewport 0, 0, _Width, _Height
GL_InitInfo = 1
End If
End Sub
'The following three lines turn on quick and dirty lighting. Light0 is predefined on most video cards, so it avoids inconvenience
' when setting the lights. After light0 we set the lighting. If your card does not support light0, you will see a black monitor - you need to turn off the lights. The last line adds color
' to texture mapping. If we do not turn on material coloring, the texture will always have the original color. glColor3f(r,g,b) will have no effect (in the render function.
'
_glEnable _GL_LIGHT0 'enable basic light
_glEnable _GL_LIGHTING 'enable lights
_glEnable _GL_COLOR_MATERIAL 'enable materials coloring
'Finally, we'll set perspective corrections to make the image look better. Returning true tells the program that the initialization was successful.
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST 'best perspective projection
If GL_InitInfo = 0 Then
BoxTexture(1) = LoadTexture("bedna.jpg", 1)
' BoxTexture(0) = LoadTexture("czflag.jpg", 1) 'try load here next texture for box lid (then uncomment _glbindTexture in _GL SUB)
BuildLists 'create display lists
End If
End Sub
Sub DeleteTexture (nr As Long)
For P = LBound(GLL) To UBound(GLL)
If GLL(P).PointerGL = nr Then
Dim DEL As Long
DEL = GLL(P).PointerGL
_glDeleteTextures 1, _Offset(DEL)
Exit Sub
End If
Next
End Sub
Sub KillAllTextures
For P = LBound(GLL) To UBound(GLL)
If GLL(P).PointerGL > 0 Then
DeleteTexture P
GLL(P).PointerGL = 0
End If
Next P
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
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)
Dim m As _MEM
m = _MemImage(texinv&)
Dim n As _MEM
n = _MemImage(ni&)
Select Case Filter
Case -1
'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, 4, _Width(ni&), _Height(ni&), _GL_RGB, _GL_UNSIGNED_BYTE, _Offset(Texture)
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR_MIPMAP_NEAREST 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR ' IF IS USED _GL_LINEAR_MIMAP_NEAREST here, program crash. Is it correct? -?-
'
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
Texture:
EDIT:
No one helped, I helped myself. Interestingly. The solution always comes to me only after I turn off the computer.
The source code of the same program is attached. This time it already uses the statement, I asked about - _glColor3fv. The solution can be seen on lines 141 to 143 and also 152 - 154. If someone can think of a more elegant solution, I'd be happy to learn.
Code: (Select All)
_Title "Display List demo"
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
Type GL_Loader ' array for loading textures
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 ' is need for OpenGL init
Dim Shared ExitSignal As _Byte ' is need for correct OpenGL exit when program end
Dim Shared BoxCol(5) As RGB 'for cube colors
Restore BXC
For Row = 1 To 5
For Column = 1 To 3
Read Value
Select Case Column
Case 1: BoxCol(Row).R = Value
Case 2: BoxCol(Row).G = Value
Case 3: BoxCol(Row).B = Value
End Select
Next
Next
'colors for cube
BXC:
Data 1.0,0.0,0.0
Data 1.0,0.5,0.0
Data 1.0,1.0,0.0
Data 0.0,1.0,0.0
Data 0.0,1.0,1.0
Dim Shared TopCol(5) As RGB
Restore TPC
For Row = 1 To 5
For Column = 1 To 3
Read Value
Select Case Column
Case 1: TopCol(Row).R = Value
Case 2: TopCol(Row).G = Value
Case 3: TopCol(Row).B = Value
End Select
Next
Next
'colors for lid
TPC: '
Data 0.5,0.0,0.0
Data 0.5,0.25,0.0
Data 0.5,0.5,0.0
Data 0.0,0.5,0.0
Data 0.0,0.5,0.5
Dim Shared As _Unsigned Long Box, Top
Dim Shared BoxTexture(1) As _Unsigned Long
Dim Shared As Single Yrot, Xrot
Screen _NewImage(1024, 768, 32)
Print "What you see on the screen is just 1 cube copyed as more cubes and colored and textured with _glGenLists, _glNewList and _glCallList. Use arrows."
Do
i& = _KeyHit
Select Case i&
Case 20480 'arrow up
Xrot = Xrot + .4
Case 18432 'arrow down
Xrot = Xrot - .4
Case 19200 'arrow left
Yrot = Yrot - .4
Case 19712 'arrow right
Yrot = Yrot + .4
End Select
If ExitSignal Then System
_Limit 50
Loop
Sub _GL ()
' Static Xrot, Yrot
Init2
GL_Init
_glClear _GL_COLOR_BUFFER_BIT And _GL_DEPTH_BUFFER_BIT 'Clear screen and depth buffer
_glMatrixMode _GL_PROJECTION ' Set projection matrix - TRY comment this five rows and then run it. Black screen occur. For view just something then must be depth set to -1 (Z parameter in _glTranslateF)
_glLoadIdentity ' Reset matrix
_glBindTexture _GL_TEXTURE_2D, BoxTexture(1)
For yloop = 1 To 6
'The following line moves the origin of the coordinates to the given point on the screen. At first glance it's a bit confusing.
' On the x-axis: We move to the right by 1.4 units so that the pyramid is in the center of the screen. Then we multiply the xloop
'variable by 2.8 and add 1.4. (We multiply by 2.8 so the cubes are not on top of each other. 2.8 is approximately their width when
' rotated 45 degrees.) Finally, we subtract yloop*1.4. This will move them to the left depending on which row we are on. If we didn't
' move them, they would line up on the left side. (And they don't look like a pyramid.)
'On the y-axis: We subtract the variable yloop from six, otherwise the pyramid would be created upside down. Then we multiply the
'result by 2.4. Otherwise the cubes will be on top of each other on the Y axis. (2.4 is roughly equal to the height of the cube).
'Then we subtract 7 so the pyramid starts at the bottom of the screen and is built from the bottom up.
'On the z-axis: We move 20 units inward. So the pyramid just fits on the screen.
xloop = 1
Do Until xloop = yloop
_glLoadIdentity
'cube position on the screen
'We choose the color of the box (light). Note that we use glColor3fv(). - I NOT BECAUSE IT WORK NOT CORRECT.
' This function selects all three values (red, green, blue) at once to set the color. In this case, we find it in
' the boxcol field with index yloop-1. This ensures a different color for each row of the pyramid. If we used xloop-1 we would get the same colors for each column.
'my solution for _glColor3fv (need 3 records at once)
ReDim Test(2) As Single
Test(0) = BoxCol(yloop - 1).R: Test(1) = BoxCol(yloop - 1).G: Test(2) = BoxCol(yloop - 1).B 'extract just 3 values, need for coloring
_glColor3fv _Offset(Test()) ' used in C original learn example
' _glColor3f BoxCol(yloop - 1).R, BoxCol(yloop - 1).G, BoxCol(yloop - 1).B 'used in previous case
_glCallList (Top) 'draw it
' _glColor3f TopCol(yloop - 1).R, TopCol(yloop - 1).G, TopCol(yloop - 1).B 'used in previous case
' _glBindTexture _GL_TEXTURE_2D, BoxTexture(1) ' for case you load second texture, you can try use it as box lid
_glCallList (Box) ';// Vykreslení
xloop = xloop + 1
'_glBindTexture _GL_TEXTURE_2D, BoxTexture(0) 'if you use 2 textures, set previous for box back
Loop
Next
If _Exit Then
' DeleteTexture t 'if program end, first free texture from memory, then exit from GL and return to main loop
KillAllTextures
_glClear _GL_COLOR_BUFFER_BIT
ExitSignal = Not 0
Exit Sub
End If
End Sub
Sub BuildLists 'this sub build 1 box + 1 lid and save it as glList
'glVoid BuildLists
Box = _glGenLists(2)
'We will create the first sheet. We have already taken up space for two sheets and know that the box points to the beginning of the prepared memory. We will use the glNewList() command.
'The first box parameter says that we want to store the sheet in the memory it points to.
'The second GL_COMPILE parameter says that we want to pre-create the sheet in memory so that it doesn't have to be generated and recomputed every time it's rendered. GL_COMPILE is the same as programming.
'If you write a program and load it into your compiler, you have to compile it every time you want to run it. But if it is compiled into an .exe file, all that needs to be done to run it is
'mouse click on this .exe file and run it. Without compilation of course. Whatever OpenGL compiles into the display list can be used without any further recomputation. Rendering speeds up.
Top = Box + 1 '
_glNewList Top, _GL_COMPILE 'compile display list - lid
'With the glEndList() command, we announce that we are ending the creation of the list. Anything between glNewList() and glEndList()
'is part of the display list, and vice versa, if there is anything before or after it no longer belongs to it. To find out where to store
'the second display sheet, we take the value of the one already created and add one to it (we said at the beginning of the function that
'we are making 2 display sheets, so it's fine).
End Sub
Sub GL_Init
If GL_InitInfo = 0 Then
_glViewport 0, 0, _Width, _Height
GL_InitInfo = 1
End If
End Sub
'The following three lines turn on quick and dirty lighting. Light0 is predefined on most video cards, so it avoids inconvenience
' when setting the lights. After light0 we set the lighting. If your card does not support light0, you will see a black monitor - you need to turn off the lights. The last line adds color
' to texture mapping. If we do not turn on material coloring, the texture will always have the original color. glColor3f(r,g,b) will have no effect (in the render function.
'
_glEnable _GL_LIGHT0 'enable basic light
_glEnable _GL_LIGHTING 'enable lights
_glEnable _GL_COLOR_MATERIAL 'enable materials coloring
'Finally, we'll set perspective corrections to make the image look better. Returning true tells the program that the initialization was successful.
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST 'best perspective projection
If GL_InitInfo = 0 Then
BoxTexture(1) = LoadTexture("bedna.jpg", 1)
' BoxTexture(0) = LoadTexture("czflag.jpg", 1) 'try load here next texture for box lid (then uncomment _glbindTexture in _GL SUB)
BuildLists 'create display lists
End If
End Sub
Sub DeleteTexture (nr As Long)
For P = LBound(GLL) To UBound(GLL)
If GLL(P).PointerGL = nr Then
Dim DEL As Long
DEL = GLL(P).PointerGL
_glDeleteTextures 1, _Offset(DEL)
Exit Sub
End If
Next
End Sub
Sub KillAllTextures
For P = LBound(GLL) To UBound(GLL)
If GLL(P).PointerGL > 0 Then
DeleteTexture P
GLL(P).PointerGL = 0
End If
Next P
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
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)
Dim m As _MEM
m = _MemImage(texinv&)
Dim n As _MEM
n = _MemImage(ni&)
Select Case Filter
Case -1
'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, 4, _Width(ni&), _Height(ni&), _GL_RGB, _GL_UNSIGNED_BYTE, _Offset(Texture)
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR_MIPMAP_NEAREST 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR ' IF IS USED _GL_LINEAR_MIMAP_NEAREST here, program crash. Is it correct? -?-
'
04-08-2023, 08:40 PM (This post was last modified: 04-14-2023, 02:56 PM by Petr.)
The example and demonstration of the fog created by the _glFog command follows on from an earlier example of a rotating cube with a single texture over the entire surface (answer 11 in this thread)
Code: (Select All)
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
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
Dim Shared ExitSignal As _Byte, Blend As _Byte
'--------------------------------------------------
Dim Shared LightAmbient(3) As Single
LightAmbient(0) = 0.5
LightAmbient(1) = 0.5
LightAmbient(2) = 0.5
LightAmbient(3) = .1
Dim Shared LightDifuse(3) As Single
LightDifuse(0) = 1
LightDifuse(1) = 1
LightDifuse(2) = 1
LightDifuse(3) = 1
Dim Shared LightPosition(3) As Single
LightPosition(0) = 0
LightPosition(1) = 0
LightPosition(2) = 2
LightPosition(3) = 1
Dim Shared Textures(2) As Long, SetTexture, Light, Xrot, Yrot, Zdepth
Dim Shared Fog, FogLevel, FogQuality
FogLevel = 0.30
Dim Shared FogColor(3)
FogColor(0) = 0.5: FogColor(1) = 0.5: FogColor(2) = 0.5: FogColor(3) = 1
_Title "Fog"
Screen _NewImage(1024, 768, 32)
Fog = 1
SetTexture = 0
Light = -1
Xrot = .2
Yrot = .3
Zdepth = -5
_DisplayOrder _GLRender , _Software 'so PRINT comments is visible on the OpenGL screen
Do
i$ = InKey$
Select Case UCase$(i$)
Case "L"
If LightTimer < Timer Then
Light = Light * -1
LightTimer = Timer + 1
End If
Case "F"
SetTexture = SetTexture + 1
If SetTexture > 2 Then SetTexture = 0
Case "S" 'rotation in X axis
Xrot = Xrot + .3
Case "X"
Xrot = Xrot - .3
Case "C"
Yrot = Yrot - .3
Case "D"
Yrot = Yrot + .3
Case "G"
Zdepth = Zdepth + .1
Case "B"
Zdepth = Zdepth - .1
Case "K" 'fog level +
FogLevel = FogLevel + .01
Case "M" ' fog level -
FogLevel = FogLevel - .01
Case "P"
Fog = Fog + 1: If Fog > 3 Then Fog = 0
Case "I"
FogQuality = FogQuality + 1
If FogQuality > 2 Then FogQuality = 0
End Select
If ExitSignal Then System
_Limit 40
Loop
Sub _GL ()
Init2
Static xr, yr, zrot
Locate 2
' _glClearColor 0.5, 0.5, 0.5, 1
Color , _RGB32(127, 127, 127)
Print "P for fog type "
Print "K increase fog, M decrease fog"
Print "Try keys L: Light on/off"
Print "Set texture filtering: F"
Print "Rotation speed in X axis: S, X"
Print "Rotation speed in Y axis: C, D"
Print "Set Depth: G, B"
'navic
_glMatrixMode _GL_PROJECTION ' Set projection matrix - TRY comment this five rows and then run it. Black screen occur. For view just something then must be depth set to -1 (Z parameter in _glTranslateF)
_gluPerspective 90.0F, _Width / _Height, 0.1F, 100.0F ' Perspective calculation
_glMatrixMode _GL_MODELVIEW ' set modelview matrix
'-----
_glClear _GL_COLOR_BUFFER_BIT And _GL_DEPTH_BUFFER_BIT 'Clear screen and depth buffer
_glLoadIdentity 'matrix reset
_glTranslatef 0.0F, 0.0F, Zdepth 'Shift to depth - without projection matrix settings if Z is -5 just black screen occur!
_glRotatef xr, 1.0F, 0.0F, 0.0F 'rotation in axis X
_glRotatef yr, 0.0F, 1.0F, 0.0F ' Y
_glRotatef zrot, 0.0F, 0.0F, 1.0F ' Z
_glBindTexture _GL_TEXTURE_2D, Textures(SetTexture) 'set texture - in this case 1 texture for whole cube, 1 texture with 3 types of filtering
If _Exit Then
For t = 0 To 2
DeleteTexture t 'if program end, first free texture from memory, then exit from GL and return to main loop
Next t
_glClear _GL_COLOR_BUFFER_BIT
ExitSignal = Not 0
Exit Sub
End If
End Sub
Sub GL_Init
If GL_InitInfo = 0 Then
GL_InitInfo = 1
End If
End Sub
Sub Init2
If GL_InitInfo = 0 Then
Textures(0) = LoadTexture("container.jpg", 2) 'function load texture from valid file and return OpenGL Handle for this texture,
Textures(1) = LoadTexture("container.jpg", 1)
Textures(2) = LoadTexture("container.jpg", 0)
GL_InitInfo = 1
_glClearColor 0.5, 0.5, 0.5, 1
_glFogfv _GL_FOG_COLOR, _Offset(FogColor()) 'fog color
_glFogf _GL_FOG_DENSITY, FogLevel 'fog density
_glHint _GL_FOG_HINT, _GL_DONT_CARE 'middle fog quality
' End If
_glViewport 0, 0, _DesktopWidth, _DesktopHeight ' visible area is fullscreen
_glMatrixMode _GL_PROJECTION '
_glLoadIdentity '
_gluPerspective 45.0F, _Width / _Height, 0.1F, 100.0F 'set camera, other statement for full 3D is _gluLookAt
_glMatrixMode _GL_MODELVIEW '
_glLoadIdentity ' reset all axis to basic settings (0,0,0 = X, Y, Z in middle)
End If
_glEnable _GL_TEXTURE_2D ' enable texture mapping
_glShadeModel _GL_SMOOTH '
_glClearColor 0.5, 0.5F, 0.5F, 1.0F ' background color is the same as fog color
_glClearDepth 1.0F ' depth buffer settings
_glEnable _GL_DEPTH_TEST ' enable depth buffer testing
_glDepthFunc _GL_LEQUAL ' depth buffer testing type
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST
Select Case FogQuality
Case 0
_glHint _GL_FOG_HINT, _GL_FASTEST
Case 1
_glHint _GL_FOG_HINT, _GL_DONT_CARE
Case 2
_glHint _GL_FOG_HINT, _GL_NICEST
End Select
Select Case Fog ' select fog filtering type selected with "g" from keyboard (fog modes)
Case 1
_glFogi _GL_FOG_MODE, _GL_EXP ' fog mode basic fog level
_glFogfv _GL_FOG_COLOR, _Offset(FogColor()) ' fog color
Case 2
_glFogi _GL_FOG_MODE, _GL_EXP2 ' fog mode middle fog level
_glFogfv _GL_FOG_COLOR, _Offset(FogColor()) ' fog color
Case 3
_glFogi _GL_FOG_MODE, _GL_LINEAR ' best fog level
_glFogfv _GL_FOG_COLOR, _Offset(FogColor()) '
End Select
_glFogf _GL_FOG_DENSITY, FogLevel ' fog density
If Fog > 0 Then
_glHint _GL_FOG_HINT, _GL_DONT_CARE ' fog Quality
_glFogf _GL_FOG_START, 1.0F ' fog begin in depth - axis z
_glFogf _GL_FOG_END, 5.0F ' fog end in depth - axis z
_glEnable _GL_FOG ' enable fog
Else
_glDisable _GL_FOG ' if g = 0 then is none fog, this disable it
End If
'dodatek pro lighting
_glLightfv _GL_LIGHT1, _GL_AMBIENT, _Offset(LightAmbient!()) 'ambient light
_glLightfv _GL_LIGHT1, _GL_DIFFUSE, _Offset(LightDiffuse!()) 'diffuse light
_glLightfv _GL_LIGHT1, _GL_POSITION, _Offset(LightPosition!()) 'light position settings
_glEnable _GL_LIGHT1 ' enable light
' Else
If Light = -1 Then
_glDisable _GL_LIGHTING 'disable light
Else
_glEnable _GL_LIGHTING
End If
_glClear _GL_COLOR_BUFFER_BIT
_glClear _GL_DEPTH_BUFFER_BIT 'clear screen ad depth buffer
_glLoadIdentity ' matrix reset
'//////////////////////////////////////////////////////////////////
_glColor4f 0.5F, 0.5F, 0.5F, 1.0F ' set full brightness and 50% alpha
_glBlendFunc _GL_SRC_ALPHA, _GL_ONE ' Blending = this two are need for alphablending after pressing "a"
'#################################
End Sub
Sub DeleteTexture (nr As Long)
For P = LBound(GLL) To UBound(GLL)
If GLL(P).PointerGL = nr Then
Dim DEL As Long
DEL = GLL(P).PointerGL
_glDeleteTextures 1, _Offset(DEL)
Exit Sub
End If
Next
End Sub
Function LoadTexture (image As String, Filter As _Unsigned _Byte)
D = _Dest
S = _Source
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
Dim Texture As 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)
Dim m As _MEM
m = _MemImage(texinv&)
Dim n As _MEM
n = _MemImage(ni&)
Select Case Filter
Case -1
'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, 4, 16, 16, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, _Offset(Texture) 'need own memory block (n - MEM) in combination with m - MEM program crash... why? ? ? ? ? ?
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR_MIPMAP_NEAREST 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR ' IF IS USED _GL_LINEAR_MIMAP_NEAREST here, texture is white. Is it correct? -?- just God know...
'
04-09-2023, 07:12 PM (This post was last modified: 04-14-2023, 02:57 PM by Petr.)
I finally broke down and above all understood how the little piece of _glLists works. It is important to note that when creating displaylists it is not enough to just place a texture on an object. It is also necessary to set the graphic position to the place where the next DisplayList will start to be rendered (using the glTranslatef command) - look to sub BuildFont.
This is not the program that didn't work for me, but a different one with the same command. And here was the breakthrough. I tried to comment everything in the program, there were a few things that gave me trouble (because I'm working with OpenGL only now, because there are many things with a question mark regarding implantation in QB64, for example calling the sub with the transfer of the field from QB64 to OpenGL caused me compilation error and it took me an hour to figure out why the compiler doesn't like it).
Like this. Its my bug, if I did it more often I would know, right? God Save QB64!
ZIP file contains: source code (mnrvovrfc will surely appreciate) and two textures. EXE file is not included. The letter sizes in the file names match
Code: (Select All)
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 "_glLists and 2D & 3D in one"
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
Dim Shared ExitSignal As _Byte, Blend As _Byte
'---------------------------------------------------
image$ = "font.gif"
Dim Shared Img(255) As Long
Dim Shared Textures(255) As Long
Dim Shared Baze, PreInit
Dim Shared Diamond As Long
Screen _NewImage(1024, 768, 32)
Do
_Limit 20
Loop
Sub _GL
Static cnt1, cnt2
Init2 'load images and create displaylists and textures
'drawing
_glClear _GL_COLOR_BUFFER_BIT And _GL_DEPTH_BUFFER_BIT 'clear screen and depth buffer
_glLoadIdentity 'matrix reset
'We'll select the texture created from bumps.bmp, move it five units inward, and rotate it by 45 on the Z axis. This clockwise rotation will give the appearance of a diamond instead of two squares.
_glMatrixMode _GL_PROJECTION ' Set projection matrix - TRY comment this five rows and then run it. Black screen occur. For view just something then must be depth set to -1 (Z parameter in _glTranslateF)
_glLoadIdentity ' Reset matrix
'We will perform another rotation on the X and Y axes, which is dependent on the variable cnt1*30. It has the effect of rotating the object around, just as a diamond rotates in one place.
_glRotatef cnt1 * 30.0F, 1.0F, 1.0F, 0.0F ' Rotation in axis X and Y
'Since we want it to appear solid, we'll turn off blending and set the color to white. We will render a texture-mapped quadrilateral.
_glDisable _GL_BLEND 'disable blending
_glColor3f 1.0F, 1.0F, 1.0F 'white color
'Next, we rotate it by 90 degrees on the X and Y axes. We draw a quadrilateral again. This new one intersects the first drawn in the middle and is perpendicular to it (90 degrees). Nice symmetrical shape..
_glRotatef 90.0F, 1.0F, 1.0F, 0.0F 'rotation in axcis X and Y up to 90 degrees
_glBegin _GL_QUADS 'quad drawing
_glTexCoord2d 0.0F, 0.0F
_glVertex2f -1.0F, 1.0F
_glTexCoord2d 1.0F, 0.0F
_glVertex2f 1.0F, 1.0F
_glTexCoord2d 1.0F, 1.0F
_glVertex2f 1.0F, -1.0F
_glTexCoord2d 0.0F, 1.0F
_glVertex2f -1.0F, -1.0F
_glEnd 'quad end
'Let's turn on the blending and start writing the text.
glPrint (240 + (200 * Cos(cnt2 + cnt1) / 5)), 2, "Giuseppe D'Agata", 0 'first author this program
_glColor3f 1.0F, 1.0F, 1.0F 'white color
glPrint (242 + (200 * Cos(cnt2 + cnt1) / 5)), 2, "Giuseppe D'Agata", 0
cnt1 = cnt1 + 0.01
cnt2 = cnt2 + 0.0081
End Sub
Sub Init2
If GL_InitInfo = 0 Then
LoadCharactersFromImage "font.gif", 16, 16, Img&()
GL_InitInfo = 1
For MakeTexture = 0 To 255
Textures(MakeTexture) = LoadTexture_Array(Img&(MakeTexture), 2)
Next
BuildFont
Dim d(0) As Long
d(0) = _LoadImage("diam.png", 32)
Diamond = LoadTexture_Array(d(0), 1) 'this is how get around it so that don't have to add a loader from a file like in previous programs
_FreeImage d(0)
' u nej init GL
Exit Sub
End If
Sub BuildFont
' Static Baze
Baze = _glGenLists(255) ' 256 display lists
For i& = 0 To 255
_glNewList Baze + i&, _GL_COMPILE
_glBindTexture _GL_TEXTURE_2D, Textures(i&)
_glBegin _GL_QUADS
a = -1: b = 0 'if is texture bad set, characters are then viewed more than 1x. (try rewrite b to 1)
c = 16
_glTexCoord2f a, b: _glVertex2i 0, c ' 0,15 levy horni <--- _glVertex2i use standard coordinates as in QB64
' dest source
'in case you want to map textures directly from one file, without them being pre-loaded as in this program, the procedure is as follows:
'1) you load the entire texture as one texture, let it be converted to a texture.
'2) then the _glTexCoord2f coordinates are calculated as: width of the image / number of pixels that are mapped to the rectangle - so in this case it is 16/256
'(the width of the image with letters is 256, the width of the letter is 16)
_glTexCoord2f b, b: _glVertex2i c, c '15,15 pravy horni 'glTexCoord2f cte takto: chces namapovat 16 pixelu z obrazku o width = 256 pixelu, tedy: 16/256 = 0.625
_glTexCoord2f b, a: _glVertex2i c, 0 '15, 0 pravy dolni
_glTexCoord2f a, a: _glVertex2i 0, 0 '0, 0 levy dolni
_glEnd
_glTranslatef 16, 0, 0 'shift to the place from where the next displaylist will be painted!
'you are here in RELATIVE coordinate system, therefore _glTranslatef here is for setting place from where is next display list draw. If you comment it, all characters comming to the same place.
_glEndList
Next i&
End Sub
Sub KillFont
_glDeleteLists Baze, 256
End Sub
Sub glPrint (Xpos, Ypos, S As String, set As _Unsigned _Byte)
If set > 0 Then set = 1 Else set = 0
Sub LoadCharactersFromImage (filename As String, xstep As Integer, ystep As Integer, img() As Long) 'standard QB64 - load small 16x16 icons from image font.gif and place it to img() array as images
If _FileExists(filename$) Then
I& = _LoadImage(filename$, 32)
If I& < -1 Then 'is supported image format
For y = 0 To _Height(I&) - ystep Step ystep
For x = 0 To _Width(I&) - xstep Step xstep
img&(imi) = _NewImage(xstep, ystep, 32)
_PutImage (0, 0)-(xstep, ystep), I&, img&(imi), (x, y)-(x + xstep, y + ystep)
imi = imi + 1
Next x
Next y
Else Print "This image file "; filename$; "is not in suported format.": System
End If
Else
Print "Error: File "; filename$; "not found.": System
End If
End Sub
Function LoadTexture_Array& (image As Long, filter) 'create textures from images
D = _Dest
S = _Source
texinv& = _NewImage(_Width(image&), _Height(image&), 32)
_PutImage (0, _Height(image&))-(_Width(image&), 0), image&, texinv&
ni& = _CopyImage(texinv&, 32)
Dim Texture As 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)
Dim m As _MEM
m = _MemImage(texinv&)
Dim n As _MEM
n = _MemImage(ni&)
Select Case filter
Case -1
'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, 4, 16, 16, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, _Offset(Texture) 'need own memory block (n - MEM) in combination with m - MEM program crash... why? ? ? ? ? ?
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR_MIPMAP_NEAREST 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR ' IF IS USED _GL_LINEAR_MIMAP_NEAREST here, texture is white. Is it correct? -?- just God know...
'
_glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGB, _Width(ni&), _Height(ni&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, n.OFFSET
saveit:
U = UBound(GLL)
GLL(U).PointerGL = Texture
GLL(U).TextureName = "ARRAY!"
GLL(U).Filtering = filter
ReDim _Preserve GLL(U + 1) As GL_Loader
_MemFree m
LoadTexture_Array& = Texture
_Dest D
_Source S
End Function
Otherwise make a search and replace in the program before compiling it, changing "png" to "PNG" because the included PNG file has its file extension part in uppercase.
Failure to comply after running executable file causes crash in line 235 which doesn't help explain what is happening. This produced two runtime error dialog boxes on my system, the second one said "Invalid handle at Line 0" which might be a bug with Tinydialogs, or somewhere along the line using OpenGL statements breaks things elsewhere in QB64PE.
04-12-2023, 08:05 PM (This post was last modified: 04-12-2023, 08:06 PM by Petr.)
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.
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)
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
_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
_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
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
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
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
(i have brain error from it - knowledge out of range) But what an amazing thing, these are Display Lists. That would be really hard to solve with Maptriangle, I really can't imagine that. It's - if I convert it to 2D - it's basically the same as if you upload images to memory and then you just insert them and the program is fast. This in OpenGL does the same with models (already textured) and then you actually just take copies of those bodies and put them on the scene. I'm now trying to get as far with OpenGL as possible (as far as I can) and then start mixing it with MEMSOUND. It's just going to be a massacre. I've also been toying with the idea of trying to convert from the OpenGL 3DWorld demo to _MapTriangle3D, what do you think? 
![[Image: bedna.jpg]](https://i.ibb.co/sJ156HD/bedna.jpg)
![[Image: OGL11.png]](https://i.ibb.co/kBdskqr/OGL11.png)
![[Image: container.jpg]](https://i.ibb.co/D1FcCb8/container.jpg)
![[Image: OGL16.png]](https://i.ibb.co/s13t03h/OGL16.png)
quadrics.zip (Size: 1.97 MB / Downloads: 45)
