03-31-2023, 06:24 PM (This post was last modified: 03-31-2023, 06:25 PM by Petr.)
So let's throw it into space, what do you say? So here we have a 3D cube in 3D space, textured with the logo of our beloved programming language. Try commenting out some parts and then running it to see the impact to program.
Code: (Select All)
Type GL_Loader
PointerGL As Long
TextureName As String
End Type
ReDim Shared GLL(0) As GL_Loader, t As Long
Dim Shared GL_InitInfo As _Byte
Dim Shared ExitSignal As _Byte
If t = 0 Then t = LoadTexture("Phoenix.png") 'function load texture from valid file and return OpenGL Handle for this texture,
' if handle exists, return it and do not next.
Init2
_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 matice
_gluPerspective 90.0F, _Width / _Height, 0.1F, 100.0F ' Perspective calculation
_glMatrixMode _GL_MODELVIEW ' set modelview matrix
_glLoadIdentity
_glTranslatef 0.0F, 0.0F, -5F 'Shift to depth - without projection matrix settings if Z is -5 just black screen occur!
_glRotatef Xrot, 1.0F, 0.0F, 0.0F 'rotation in axis X
_glRotatef Yrot, 0.0F, 1.0F, 0.0F ' Y
_glRotatef Zrot, 0.0F, 0.0F, 1.0F ' Z
_glBindTexture _GL_TEXTURE_2D, t 'set texture - in this case 1 texture for whole cube
If _Exit Then
DeleteTexture t 'if program end, first free texture from memory, then exit from GL and return to main loop
_glClear _GL_COLOR_BUFFER_BIT
ExitSignal = Not 0
Exit Sub
End If
End Sub
Sub GL_Init
If GL_InitInfo = 0 Then
' _glViewport 0, 0, _Width, _Height
GL_InitInfo = 1
End If
End Sub
Sub Init2
_glEnable _GL_TEXTURE_2D 'allow texture maping
_glEnable _GL_DEPTH_TEST ' Allow depth testing - try comment it and the run program. Object is then very deformed.
_glDepthFunc _GL_LEQUAL ' Depth testing type
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST ' best perspective projection
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)
If GL_InitInfo = 0 Then GL_Init
If _FileExists(image) Then
TT = 0
Do Until TT = UBound(GLL)
If GLL(TT).TextureName = image$ Then
LoadTexture = GLL(TT).PointerGL 'prevent memory leak loading next and next texture again and angain...
Exit Function
End If
TT = TT + 1
Loop
_PutImage (0, _Height(tex&) - 1)-(_Width(tex&) - 1, 0), tex&, texinv&
_FreeImage tex&
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&)
_glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGB, _Width(texinv&), _Height(texinv&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, m.OFFSET
03-31-2023, 06:59 PM (This post was last modified: 04-14-2023, 02:24 PM by Petr.)
The following is a demonstration of how to texture a cube with different textures from different sides. Notice the ever-repeating _glTexCoord2f, followed by _glVertex3f... over and over again. That's literally says - use field! This way it's better for understanding, but in practice I would rather create a data file with the coordinates and then compile the whole thing in a loop using only these two commands.
Try applying a texture with transparency to one position, it's quite interesting. Don't forget that even in this case you can mix color as in the previous example.
Sorry, my fail, this source use none blending, therefore texture with transparency is displayed as texture without transparency. Added zip file, contains textures and source code.
Do not forgot to change texture file names!
Code: (Select All)
Type GL_Loader
PointerGL As Long
TextureName As String
End Type
ReDim Shared GLL(0) As GL_Loader, t As Long
Dim Shared GL_InitInfo As _Byte
Dim Shared ExitSignal As _Byte
t1 = LoadTexture("Phoenix.png") 'function load texture from valid file and return OpenGL Handle for this texture,
t2 = LoadTexture("X.png")
t3 = LoadTexture("cat.gif")
t4 = LoadTexture("banan.gif")
t5 = LoadTexture("dum03.jpg")
t6 = LoadTexture("new sob.gif")
' if handle exists, return it and do not next.
Init2
_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 matice
_gluPerspective 90.0F, _Width / _Height, 0.1F, 100.0F ' Perspective calculation
_glMatrixMode _GL_MODELVIEW ' set modelview matrix
_glLoadIdentity
_glTranslatef 0.0F, 0.0F, -5F 'Shift to depth - without projection matrix settings if Z is -5 just black screen occur!
_glRotatef Xrot, 1.0F, 0.0F, 0.0F 'rotation in axis X
_glRotatef Yrot, 0.0F, 1.0F, 0.0F ' Y
_glRotatef Zrot, 0.0F, 0.0F, 1.0F ' Z
_glBindTexture _GL_TEXTURE_2D, t1 'set texture - in this case phoenix logo to this wall
If _Exit Then
DeleteTexture t 'if program end, first free texture from memory, then exit from GL and return to main loop
_glClear _GL_COLOR_BUFFER_BIT
ExitSignal = Not 0
Exit Sub
End If
End Sub
Sub GL_Init
If GL_InitInfo = 0 Then
' _glViewport 0, 0, _Width, _Height
GL_InitInfo = 1
End If
End Sub
Sub Init2
_glEnable _GL_TEXTURE_2D 'allow texture maping
_glEnable _GL_DEPTH_TEST ' Allow depth testing - try comment it and the run program. Object is then very deformed.
_glDepthFunc _GL_LEQUAL ' Depth testing type
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST ' best perspective projection
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)
If GL_InitInfo = 0 Then GL_Init
If _FileExists(image) Then
TT = 0
Do Until TT = UBound(GLL)
If GLL(TT).TextureName = image$ Then
LoadTexture = GLL(TT).PointerGL 'prevent memory leak loading next and next texture again and angain...
Exit Function
End If
TT = TT + 1
Loop
_PutImage (0, _Height(tex&) - 1)-(_Width(tex&) - 1, 0), tex&, texinv&
_FreeImage tex&
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&)
_glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGB, _Width(texinv&), _Height(texinv&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, m.OFFSET
04-01-2023, 12:56 PM (This post was last modified: 04-14-2023, 02:27 PM by Petr.
Edit Reason: added BYVAL to library declaration in program begin!
)
So I'm getting into the dark areas of OpenGL. The reason is - strange behavior.
Check out this program. This is lighting. The problem here is with gluBuild2DMipmaps. This is a type of texture filtering, when using with _GL_TEXTURE_MIN_FILTER in the _glTexParameteri command, the program either dies in a white screen, or the texture is not created and the object is then all white. There will be more and more such problems. I tried everything possible just to SOMEHOW get it running. Therefore, do not take this program as an example.
The library definition should be correct, but - it is possible that it is not.
Change the texture name on lines 82 to 84, I also changed the texture loader so that it is possible to load multiple textures with the same name, but in a way that takes into account the type of filter used, so a texture of the same name using the same filter is not loaded more than once.
Any insights, modifications, corrections, your modifications, everything is very welcome. Try making adjustments to the LightAmbient, LightDifuse and LightPosition fields, all your adjustments should affect the way the rotating cube is lit.
Perhaps one of you will find an effective way to solve the problem described above better.
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
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
SetTexture = 0
Light = -1
Xrot = .2
Yrot = .3
Zdepth = -5
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
End Select
If ExitSignal Then System
_Limit 40
Loop
Sub _GL ()
Static xr, yr, zrot
Locate 2
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"
Textures(0) = LoadTexture("5b.jpg", 2) 'function load texture from valid file and return OpenGL Handle for this texture,
Textures(1) = LoadTexture("5b.jpg", 1)
Textures(2) = LoadTexture("5b.jpg", 0)
Init2
_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 matice
_gluPerspective 90.0F, _Width / _Height, 0.1F, 100.0F ' Perspective calculation
_glMatrixMode _GL_MODELVIEW ' set modelview matrix
_glLoadIdentity
_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
DeleteTexture t 'if program end, first free texture from memory, then exit from GL and return to main loop
_glClear _GL_COLOR_BUFFER_BIT
ExitSignal = Not 0
Exit Sub
End If
End Sub
Sub GL_Init
If GL_InitInfo = 0 Then
_glViewport 0, 0, _Width, _Height
GL_InitInfo = 1
End If
End Sub
Sub Init2
_glEnable _GL_TEXTURE_2D 'allow texture maping
_glShadeModel _GL_SMOOTH ' smooth
_glClearDepth 1.0F ' depth buffer settings
_glEnable _GL_DEPTH_TEST ' Allow depth testing - try comment it and the run program. Object is then very deformed.
_glDepthFunc _GL_LEQUAL ' Depth testing type
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST ' best perspective projection
If Light = -1 Then
_glDisable _GL_LIGHTING 'disable light
Else
_glEnable _GL_LIGHTING
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
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) '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-01-2023, 01:19 PM (This post was last modified: 04-14-2023, 02:41 PM by Petr.
Edit Reason: add BYVAL to library declaration!
)
Just a little modification in the INIT2 sub and we have a sample of transparency: (blending)
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
SetTexture = 0
Light = -1
Xrot = .2
Yrot = .3
Zdepth = -5
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"
Blend = -1
Case "M"
Blend = 1
End Select
If ExitSignal Then System
_Limit 40
Loop
Sub _GL ()
Static xr, yr, zrot
Locate 2
Print "K enable blending, M disable blending"
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"
Textures(0) = LoadTexture("img.jpg", 2) 'function load texture from valid file and return OpenGL Handle for this texture,
Textures(1) = LoadTexture("img.jpg", 1)
Textures(2) = LoadTexture("img.jpg", 0)
Init2
_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 matice
_gluPerspective 90.0F, _Width / _Height, 0.1F, 100.0F ' Perspective calculation
_glMatrixMode _GL_MODELVIEW ' set modelview matrix
_glLoadIdentity
_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
DeleteTexture t 'if program end, first free texture from memory, then exit from GL and return to main loop
_glClear _GL_COLOR_BUFFER_BIT
ExitSignal = Not 0
Exit Sub
End If
End Sub
Sub GL_Init
If GL_InitInfo = 0 Then
_glViewport 0, 0, _Width, _Height
GL_InitInfo = 1
End If
End Sub
Sub Init2
_glEnable _GL_TEXTURE_2D 'allow texture maping
_glShadeModel _GL_SMOOTH ' smooth
_glClearDepth 1.0F ' depth buffer settings
_glEnable _GL_DEPTH_TEST ' Allow depth testing - try comment it and the run program. Object is then very deformed.
_glDepthFunc _GL_LEQUAL ' Depth testing type
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST ' best perspective projection
If Light = -1 Then
_glDisable _GL_LIGHTING 'disable light
Else
_glEnable _GL_LIGHTING
End If
'dodatek pro Blending
_glColor4f 1.0F, 1.0F, 1.0F, 0.5F ';// Plný jas, 50% alfa
_glBlendFunc _GL_SRC_ALPHA, _GL_ONE ');// Funkce blendingu pro průsvitnost založená na hodnotě alfa
If Blend = -1 Then
_glEnable _GL_BLEND ');// Zapne blending
_glDisable _GL_DEPTH_TEST ');// Vypne hloubkové testování
Else
_glDisable _GL_BLEND ');// Vypne blending
_glEnable _GL_DEPTH_TEST ');// Zapne hloubkové testování
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
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) '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...
'
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
For using texturing MIPMAP (parameter 2 for LOADTEXTURE function) use texture, which has both sides dividible by 2 and maximal side lenght is 128 pixels. Or my texture here:
congratulations! this is a very good demo for how OPEN_GL works! I like how it works. Translucency also works very well. For this, as far as I can see, you don't need to put the pictures in the drawing order. When using _MAPTRIANGLE, if a transparent texture is used, the furthest ones must always be drawn first. I see opengl does this automatically. It looks complicated and there's a lot of code, but I think it's worth dealing with. Could you possibly write comparisons? You know opengl very well. _MAPTRIANGLE / OPEN_GL, advantages and disadvantages? Further success !
04-01-2023, 06:56 PM (This post was last modified: 04-14-2023, 02:44 PM by Petr.)
Tired of the dice? Do you feel like you're in the construction industry yet in this thread? Always cube in this thread? With the dice forever and never otherwise?
So here is something nice and actually also useful. The stars rotate around the center and fall in the middle of the screen (first program). What is useful about it? Rotate a 2D texture so that the user cannot see its side. If it wasn't, to use the W and S keys to tilt the scene, you'd see the stars as a single pixel object. However, thanks to the tilting, they always remain tilted towards the viewer.
Use the A and D keys to zoom in and out, and use the T key to turn the twinkle effect on and off.
The second program follows. It is a modification of the previous program, it creates a different, also nice effect, and I will not put it here on the photo, so you can try it too.
Both this source code need attached JPG file as texture (other images returns not so nice effects) it is free downloaded image.
Source Code A:
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
_Title "Stars in space"
Screen _NewImage(1024, 768, 32)
Const num = 50
Type Stars
As _Unsigned _Byte R, G, B
As Double Dist
As Single Angle
End Type
Dim Shared Star(num) As Stars
Dim Shared Zoom, Tilt, Twinkle
Zoom = -15
Tilt = 90F
Twinkle = 0
Do
i$ = InKey$
Select Case UCase$(i$)
Case "T"
If TwinkleTimer < Timer Then
Twinkle = Not Twinkle
LightTimer = Timer + .5
End If
Case "W"
Tilt = Tilt - 0.5
Case "S"
Tilt = Tilt + 0.5
Case "A"
Zoom = Zoom - .2
Case "D"
Zoom = Zoom + .2
End Select
If ExitSignal Then System
_Limit 50
Loop
Sub _GL ()
Static L
Texture = LoadTexture("Star.jpg", 0)
_PrintString (20, 20), "Use: A/D for zoom, W/S for shift, T for Twinkle effect."
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 matice
_gluPerspective 45.0F, _Width / _Height, 0.1F, 100.0F ' Perspective calculation
_glMatrixMode _GL_MODELVIEW ' set modelview matrix
_glBindTexture _GL_TEXTURE_2D, Texture
For L = 1 To num
_glLoadIdentity
_glTranslatef 0.0, 0.0, Zoom 'shift to srreen by zoom
_glRotatef Tilt, 1.0F, 0.0F, 0.0F 'tilted view
'ted pohneme hvezdou
_glRotatef Star(L).Angle, 0.0F, 1.0F, 0.0F 'rotation by angle this star
_glTranslatef Star(L).Dist, 0.0F, 0.0F 'shift forward in X axis
'rotate it back for case you see to it from side (this process can be used in 3D World for roating 2D characters to player - as in first Wolfenstein3D)
_glRotatef -Star(L).Angle, 0.0F, 1.0F, 0.0F 'rotating back
_glRotatef -Tilt, 1.0F, 0.0F, 0.0F 'tilt back - first we turn around on each star, perform an action and then turn back, because otherwise it will very easily happen that the X axis will become the Z axis and so on.
If Twinkle Then 'if is enabled twinkle effect, use also color previous star
_glColor4ub Star(L - 1).R, Star(L - 1).G, Star(L - 1).B, 255 'this color function has value from to 255, it is R,G,B,A
_glBegin _GL_QUADS
_glTexCoord2f 0.0F, 0.0F: _glVertex3f -1.0F, -1.0F, 0.0F
_glTexCoord2f 1.0F, 0.0F: _glVertex3f 1.0F, -1.0F, 0.0F
_glTexCoord2f 1.0F, 1.0F: _glVertex3f 1.0F, 1.0F, 0.0F
_glTexCoord2f 0.0F, 1.0F: _glVertex3f -1.0F, 1.0F, 0.0F
_glEnd
End If
'Now we will draw the main star. The only difference from the previous code is that this star is rotated around the z-axis and has a different color (see indexes)
'We rotate the star by increasing the value of the spin variable. Then we change the angle of each star by loop/num. This means that more distant stars rotate faster.
'Finally, we reduce the distance of the star from the center, so it looks like they are being sucked into the center.
spin = spin + 0.01F 'rotation of the stars
Star(L).Angle = Star(L).Angle + (L / num) 'Star angle increase
Star(L).Dist = Star(L).Dist - 0.01F 'Change the distance of the star from the center
'We check if the star has reached the center. If it does, it gets a new color and is moved 5 units from the center, so it can start its journey again as a new star.
If Star(L).Dist < 0.0F Then 'star is in middle
Star(L).Dist = Star(L).Dist + 5.0F 'new position
Star(L).R = Rnd * 255 'new color
Star(L).G = Rnd * 255 'new color
Star(L).B = Rnd * 255 'new color
End If
Next
If _Exit Then
DeleteTexture t 'if program end, first free texture from memory, then exit from GL and return to main loop
_glClear _GL_COLOR_BUFFER_BIT
ExitSignal = Not 0
Exit Sub
End If
End Sub
Sub GL_Init
If GL_InitInfo = 0 Then
_glViewport 0, 0, _Width, _Height
GL_InitInfo = 1
End If
End Sub
Sub Init2
_glEnable _GL_TEXTURE_2D 'allow texture maping
_glClearColor 0.0, 0.0, 0.0, 0.5 'Black background
_glClearDepth 1.0F ' depth buffer settings
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST ' best perspective projection
_glBlendFunc _GL_SRC_ALPHA, _GL_ONE 'blending type for transparency
_glEnable _GL_BLEND 'enable blending
If GL_InitInfo = 0 Then
For L = 1 To num
Star(L).Angle = 360 / num * L
Star(L).Dist = (L / num) * 5
Star(L).R = 1 + Rnd * 255
Star(L).G = 1 + Rnd * 255
Star(L).B = 1 + Rnd * 255
Next L
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
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
Source code B: (better effects )
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
_Title "Stars in space"
Screen _NewImage(1024, 768, 32)
Const num = 50
Type Stars
As _Unsigned _Byte R, G, B
As Double Dist
As Single Angle
End Type
Dim Shared Star(num) As Stars
Dim Shared Zoom, Tilt, Twinkle
Zoom = -15
Tilt = 90F
Twinkle = 0
'pod timto je puvodni--
Do
i$ = InKey$
Select Case UCase$(i$)
Case "T"
If TwinkleTimer < Timer Then
Twinkle = Not Twinkle
LightTimer = Timer + .5
End If
Case "W"
Tilt = Tilt - 0.5
Case "S"
Tilt = Tilt + 0.5
Case "A"
Zoom = Zoom - .2
Case "D"
Zoom = Zoom + .2
End Select
If ExitSignal Then System
_Limit 50
Loop
Sub _GL ()
Static L
Texture = LoadTexture("Star.jpg", 0)
_PrintString (20, 20), "Use: A/D for zoom, W/S for shift, T for Twinkle effect."
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 matice
_gluPerspective 45.0F, _Width / _Height, 0.1F, 100.0F ' Perspective calculation
_glMatrixMode _GL_MODELVIEW ' set modelview matrix
_glBindTexture _GL_TEXTURE_2D, Texture
For L = 1 To num
_glLoadIdentity
_glTranslatef 0.0, 0.0, Zoom 'shift to srreen by zoom
_glRotatef Tilt, 1.0F, 0.0F, 0.0F 'tilted view
'ted pohneme hvezdou
_glRotatef Star(L).Angle, 0.0F, 1.0F, 0.0F 'rotation by angle this star
_glTranslatef Star(L).Dist, 0.0F, 0.0F 'shift forward in X axis
'rotate it back for case you see to it from side (this process can be used in 3D World for roating 2D characters to player - as in first Wolfenstein3D)
_glRotatef -Star(L).Angle, 0.0F, 1.0F, 0.0F 'rotating back
_glRotatef -Tilt, 1.0F, 0.0F, 0.0F 'tilt back - first we turn around on each star, perform an action and then turn back, because otherwise it will very easily happen that the X axis will become the Z axis and so on.
If Twinkle Then 'if is enabled twinkle effect, use also color previous star
_glColor4ub Star(L - 1).R, Star(L - 1).G, Star(L - 1).B, 255 'this color function has value from to 255, it is R,G,B,A
_glBegin _GL_QUADS
_glTexCoord2f 0.0F, 0.0F: _glVertex3f -1.0F, -1.0F, 0.0F
_glTexCoord2f 1.0F, 0.0F: _glVertex3f 1.0F, -1.0F, 0.0F
_glTexCoord2f 1.0F, 1.0F: _glVertex3f 1.0F, 1.0F, 0.0F
_glTexCoord2f 0.0F, 1.0F: _glVertex3f -1.0F, 1.0F, 0.0F
_glEnd
End If
'Now we will draw the main star. The only difference from the previous code is that this star is rotated around the z-axis and has a different color (see indexes)
'We rotate the star by increasing the value of the spin variable. Then we change the angle of each star by loop/num. This means that more distant stars rotate faster.
'Finally, we reduce the distance of the star from the center, so it looks like they are being sucked into the center.
spin = spin + 0.001F 'rotation of the stars
Star(L).Angle = Star(L).Angle + (L / num) 'Star angle increase
Star(L).Dist = Star(L).Dist - spin '0.01F 'Change the distance of the star from the center
'We check if the star has reached the center. If it does, it gets a new color and is moved 5 units from the center, so it can start its journey again as a new star.
If Star(L).Dist < 0.0F Then 'star is in middle
Star(L).Dist = Star(L).Dist + 5.0F 'new position
Star(L).R = Rnd * 255 'new color
Star(L).G = Rnd * 255 'new color
Star(L).B = Rnd * 255 'new color
End If
Next
If _Exit Then
DeleteTexture t 'if program end, first free texture from memory, then exit from GL and return to main loop
_glClear _GL_COLOR_BUFFER_BIT
ExitSignal = Not 0
Exit Sub
End If
End Sub
Sub GL_Init
If GL_InitInfo = 0 Then
_glViewport 0, 0, _Width, _Height
GL_InitInfo = 1
End If
End Sub
Sub Init2
_glEnable _GL_TEXTURE_2D 'allow texture maping
_glClearColor 0.0, 0.0, 0.0, 0.5 'Black background
_glClearDepth 1.0F ' depth buffer settings
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST ' best perspective projection
_glBlendFunc _GL_SRC_ALPHA, _GL_ONE ');// Typ blendingu pro průhlednost
_glEnable _GL_BLEND ');// Zapne blending
If GL_InitInfo = 0 Then
For L = 1 To num
Star(L).Angle = 360 / num * L
Star(L).Dist = (L / num) * 5
Star(L).R = 1 + Rnd * 255
Star(L).G = 1 + Rnd * 255
Star(L).B = 1 + Rnd * 255
Next L
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
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? -?-
'
Hi @MasterGy. Thank you for the kind words, it's always a pleasure. I've worked with OpenGL a bit in the past, but at the time it wasn't that well tuned in QB64 - and I was inexperienced, so the program often crashed with a white screen. Then I left it for a while, I started working on with Maptriangle3D. It is necessary to admit that Ashish (AshishKingdom) helped me a lot when I was working with OpenGL, he is much further in this area than I am. In some cases, it is necessary to add a helper library in C language to OpenGL, for example for quadrics. I don't know if this is still necessary today, but in QB64 1.3 in 2017 it was necessary. Damn, time flies, it's scary.
I basically gave openGL another chance now, at the time when I started, I bypassed the MEM commands with respect from a long distance, today we are already talking. Sometimes.
To the point. Take a look at the previous program for yourself. How would you like to do this with _MapTriangle? Like this. with _MapTriangle you make transparency, you make sphere, cube, 2D shapes, cone with it... yeah, you do. It is very similar to OpenGL, mainly the coordinate system. Because I know you're very capable, I think it would catapult you into the elite. I would sometimes wave at you from below.
But when working with OpenGL, it is really necessary to be very careful about setting the matrices, it is easy to forget ONE command - the rest is fine - and there is nothing on the monitor. Also note that some QB64PE commands such as SLEEP will cause the program to die immediately. This is because OpenGL simply does not allow for the data stream to suddenly be interrupted in the middle of its work. Next, when working with OpenGL, it is possible to queue parts of the program that are not part of OpenGL into the main loop. For example - look at the complexity of initializing OpenGL. You have to check if what was supposed to happen only the first time, another pass has already taken place to prevent it. If you look at the source codes, there is always something like If INIT then EXIT SUB or something like that. These are the QB64 specs. A huge benefit in QB64PE is the help table that describes which data type in OpenGL corresponds to which data type in C and in QB64. This is a nice help when writing helper dynamic libraries that need to be defined for some Glut functions.
04-02-2023, 06:36 PM (This post was last modified: 04-14-2023, 02:47 PM by Petr.
Edit Reason: Archive ZIP updated - now contains BAS file and all file names are lowercase
)
So here we have something interesting.
3D world using OpenGL. Since QB64PE already has _MouseMovement features fixed, it was really easy to add mouse movement.
The program requires files in the attachment in ZIP format. Freely available images are stored in it, which are used here as textures and, above all, the world.txt file. I have slightly modified it, so when you open it in the editor you will see the inscription NUMPOLLIES in it, it is important, followed by the number 36. This number indicates the number of triangles in the file, if you are going to make a modification, add three lines of numbers each time and increase the number 36 by 1!
Each line contains:
Vertex X, Vertex Y, Vertex Z for a 3D triangle, then X and Y for a 2D texture. My modification is that for every sixth line you can put the name of the image file in quotes after those numbers and it will then be used on the following triangle as wallpaper. That's why I write that you should put it on every sixth row, so that the texture is not different in each half of the square
The program has no collision detection, so you can walk through walls. I would probably solve the collision detection with an additional field where, when loading the triangle vertices in 2D, I would write down where the wall leads to, so that it really works, it is then necessary to shoot this 2D map in the same way as the image is shot during movement.
It can also be controlled from the keyboard with arrows and the Q and A buttons, or arrows + mouse, with the B button you can turn transparency on or off
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 ' 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
'World3D coordinates array
Type Triangle
TextureX As Single
TextureY As Single
VertexX As Single
VertexY As Single
VertexZ As Single
End Type
'World3D texture array
Type Texture_T
FileName As String ' texture file name
Filter As _Byte ' used texture filtering
GL_Pointer As _Unsigned Long ' GL pointer (handle) for texture
End Type
ReDim Shared Triangles(0) As Triangle
ReDim Shared TriTextures(0) As Texture_T
Dim Shared Xpos, Zpos, Yrot, LookUpDown, WalkBias, Blend
_Title "World 3D"
LoadWorld "world.txt", Triangles(), TriTextures() 'just read TXT file and save coordinates to array Triangles and texture file names to array TriTextures for us
'next step then is in _GL SUB - it call Init2 and there are all textures loaded to RAM
Const piover180 = 0.0174532925F 'the same function as _D2R or 3.14/180
Screen _NewImage(1024, 768, 32)
Print "Welcome back in 2D world :) Press Alt + F4 to end!"
_MouseHide
Do
i& = _KeyHit
While _MouseInput
LookUpDown = LookUpDown + _MouseMovementY / 5 'Look up/down with mouse, angle is not locked!
Heading = Heading - _MouseMovementX / 5: Yrot = Heading 'rotation left/right using mouse
$if win then
_MouseMove _Width / 2, _Height / 2 'lock mouse on the middle on the screen - causes problems in Linux
$end if
Wend
Select Case i&
Case 20480 'arrow up
Xpos = Xpos + Sin(Heading * piover180) * 0.05F
Zpos = Zpos + Cos(Heading * piover180) * 0.05F
If WalkBiasAngle >= 359.0F Then
WalkBiasAngle = 0.0F
Else
WalkBiasAngle = WalkBiasAngle + 10
End If
WalkBias = Sin(WalkBiasAngle * piover180) / 20.0F
Case 18432 'arrow down
Xpos = Xpos - Sin(Heading * piover180) * 0.05F
Zpos = Zpos - Cos(Heading * piover180) * 0.05F
If WalkBiasAngle <= 1.0F Then
WalkBiasAngle = 359.0F
Else
WalkBiasAngle = WalkBiasAngle - 10
End If
WalkBias = Sin(WalkBiasAngle * piover180) / 20.0F
Case 19200 'arrow left
Heading = Heading + 1
Yrot = Heading
Case 19712 'arrow right
Heading = Heading - 1
Yrot = Heading
Case 81, 113 'Q - look up
LookUpDown = LookUpDown - 1
Case 65, 97 'A - look down
LookUpDown = LookUpDown + 1
Case 66, 98 'B
Blend = Not Blend
End Select '
If ExitSignal Then System
_Limit 50
Loop
Sub _GL ()
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
_gluPerspective 45.0F, _Width / _Height, 0.1F, 100.0F ' Perspective calculation
_glMatrixMode _GL_MODELVIEW ' set modelview matrix
texture = TriTextures(0).GL_Pointer
Xtrans = -Xpos 'for walking in X axis
Ztrans = -Zpos 'for walking in Z axis
Ytrans = -WalkBias - 0.25F 'simulation steps
SceneRotY = 360.0F - Yrot 'angle direction of view
_glRotatef LookUpDown, 1.0F, 0.0F, 0.0F 'rotation i X axis - view up and down
_glRotatef SceneRotY, 0.0F, 1.0F, 0.0F 'rotation in Y axis - rotation to left / right
_glTranslatef Xtrans, Ytrans, Ztrans ' move to position (shift) in scene
Triangles = UBound(Triangles) - 3 'total triangles used in txt file
TriTextures_i = -1
For L = 0 To Triangles Step 3 'step 3 - because triangle = 3 vertexes
If L Mod 6 = 0 Then ' 6 is 6 vertexes for 2 triangle (1 quad)
If TriTextures_i + 1 < UBound(TriTextures) Then 'if in texture array index is not UBOUND
If TriTextures(TriTextures_i + 1).GL_Pointer > 0 Then 'if tritexture array contains next valid texture
TriTextures_i = TriTextures_i + 1 ' increase index
texture = TriTextures(TriTextures_i).GL_Pointer ' insert next texture
End If
End If
End If
_glBindTexture _GL_TEXTURE_2D, texture 'tohle bude ve smycce vzdy po sesti bodech (6 bodu = 2 trojuhelniky)
_glBegin _GL_TRIANGLES
_glNormal3f 0.0F, 0.0F, 1.0F 'for light
X_m = Triangles(L).VertexX
Y_m = Triangles(L).VertexY
Z_m = Triangles(L).VertexZ
U_m = Triangles(L).TextureX
V_m = Triangles(L).TextureY
_glTexCoord2f U_m, V_m ' place texture first vertex
_glVertex3f X_m, Y_m, Z_m ' place triangle first vertex
X_m = Triangles(L + 2).VertexX
Y_m = Triangles(L + 2).VertexY
Z_m = Triangles(L + 2).VertexZ
U_m = Triangles(L + 2).TextureX
V_m = Triangles(L + 2).TextureY
_glTexCoord2f U_m, V_m ' place texture third vertex
_glVertex3f X_m, Y_m, Z_m ' place triangle third vertex
_glEnd
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 GL_Init
If GL_InitInfo = 0 Then
_glViewport 0, 0, _Width, _Height
GL_InitInfo = 1
End If
End Sub
If Blend Then
_glEnable _GL_BLEND
Else
_glDisable _GL_BLEND
End If
If GL_InitInfo = 0 Then
For L = 0 To UBound(TriTextures)
If Len(TriTextures(L).FileName) Then t = LoadTexture(TriTextures(L).FileName, 1)
TriTextures(L).GL_Pointer = t
TriTextures(L).Filter = 1
Next L
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
Sub LoadWorld (txtFile As String, Triangles() As Triangle, TriTextures() As Texture_T)
file$ = "world.txt"
If _FileExists(file$) Then
ReDim Num(4) As Single
ff = FreeFile
Open file$ For Input As ff
While Not EOF(ff)
radek = radek + 1
Line Input #ff, t$
t$ = t$ + " " ' add space to end line for right detection all numbers in the row
i = InStr(1, t$, "NUMPOLLIES")
If i Then
Print "id: NUMPOLLIES found"
separator = InStr(i + 1, t$, " ")
NumOfTriangles = Val(Mid$(t$, separator, Len(t$) - separator))
Print "Triangles:"; NumOfTriangles
ReDim Triangles(NumOfTriangles * 3) As Triangle
ReDim TriTextures(NumOfTriangles) As Texture_T
i = 0
GoTo NextRow
End If
If InStr(1, t$, "/") = 0 Then 'row contains none C comment
If Len(_Trim$(t$)) Then ' row is not empty
n$ = ""
For r = 1 To Len(t$)
ch = Asc(t$, r) '34 jsou uvozovky
Select Case ch
Case 48 To 57, 45, 46 '0 to 9 . -
num$ = num$ + Chr$(ch)
Case 32
If Len(num$) Then 'kdyz num$ obsahuje ciselnou hodnotu a dalsi znak je mezera
' Print num$
' Sleep
Num(num_i) = Val(num$)
num$ = ""
If num_i = 4 Then
num_i = 0 '0 to 4 for 5 number on 1 row
Else
num_i = num_i + 1
End If
End If
Case 34 'narazil na uvozovky
next34 = InStr(r + 1, t$, Chr$(34))
' Print r, next34
TextureName$ = Mid$(t$, r + 1, next34 - r - 1) 'vraci jmeno textury bez uvozovek
Exit For
End Select
Next r 'loop for 1 row
Triangles(Tri_i).TextureX = Num(3) 'records in text file: Xvertex, Yvertex, Zvertex, TextureX, TextureY, "texturefilename" (if is changed)
Triangles(Tri_i).TextureY = Num(4)
Triangles(Tri_i).VertexX = Num(0)
Triangles(Tri_i).VertexY = Num(1)
Triangles(Tri_i).VertexZ = Num(2)
Tri_i = Tri_i + 1
'Print radek, Tri_i
'Sleep
If Len(TextureName$) Then
' Print TextureName$
TriTextures(TriTex_i).FileName = TextureName$
TriTex_i = TriTex_i + 1
TextureName$ = ""
End If
ReDim Num(4) As Single 'clear array for read next values
Else
GoTo NextRow 'if row is empty, read next row from file
End If
Else
GoTo NextRow ' if row contains C comment separated with // (or just /), read next row from file
End If
NextRow:
Wend
Else
Print "File world.txt not found.": End
End If
Close ff
End Sub
04-02-2023, 09:03 PM (This post was last modified: 04-14-2023, 02:49 PM by Petr.)
I know there are already a few similar things out there, with commands other than OpenGL, but here's the OpenGL version. Waving flag.
Change the texture file name on row 153.
Code: (Select All)
_Title "3D Flag in OpenGL"
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
'look to init2 sub - changes in _gl_polygon_mode
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
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 Points(45, 45, 3), Texture~&
Dim Shared As Single Xrot, Yrot, Zrot, Wiggle_count, Hold
' The next two cycles initialize our grid. In order to get the correct index, we have to divide the control
' transformation of the loop by five (ie 45/9=5). I subtract 4.4 from each coordinate to center the wave at the
' origin of the coordinates. The same effect can be achieved with the help of displacement, but I prefer this method.
' The points (x, y, 2) value is made up of the sine value. The sin() function needs radians, so we take the
' value in degrees, which is our x/5 multiplied by forty, and recalculate it using the formula (radians=2*PI*degrees/360). - or we can using _D2R
x = 0
Do Until x > 44
Do Until y > 44
Points(x, y, 0) = ((x / 5.0F) - 4.5F)
Points(x, y, 1) = ((y / 5.0F) - 4.5F)
Points(x, y, 2) = (Sin((((x / 5.0F) * 40.0F) / 360.0F) * _Pi * 2.0F))
y = y + 1
Loop
x = x + 1
y = 0
Loop
Screen _NewImage(1024, 768, 32)
Do
If ExitSignal Then System
_Limit 50
Loop
Sub _GL ()
Static X, Y, float_x, float_y, float_xb, float_yb, wiggle_count
Init2
GL_Init
_glClear _GL_COLOR_BUFFER_BIT And _GL_DEPTH_BUFFER_BIT 'Clear screen and depth buffer
_glLoadIdentity '();// Reset matice
_glTranslatef 0.0F, 0.0F, -12.0F ' shift to depth to screen
_glRotatef Xrot, 1.0F, 0.0F, 0.0F 'rotation on X axis
_glRotatef Yrot, 0.0F, 1.0F, 0.0F 'rotation on Y axis
_glRotatef Zrot, 0.0F, 0.0F, 1.0F 'rotation on Z axis
_glBindTexture _GL_TEXTURE_2D, Texture~& ' set texture
_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 45.0F, _Width / _Height, 0.1F, 100.0F ' Perspective calculation
'-----------------------------------
'Note that the squares are drawn clockwise. This means that the front surface you see will be filled and the back will be a wireframe.
'If we were to draw the squares counterclockwise, the wireframe would be on the front side.
_glBegin _GL_QUADS
X = 0
Y = 0
Do Until X > 43
Do Until Y > 43
float_x = X / 44.0F
float_y = Y / 44.0F
float_xb = (X + 1) / 44.0F
float_yb = (Y + 1) / 44.0F
'set points
_glTexCoord2f float_x, float_y
_glVertex3f Points(X, Y, 0), Points(X, Y, 1), Points(X, Y, 2)
_glTexCoord2f float_x, float_yb
_glVertex3f Points(X, Y + 1, 0), Points(X, Y + 1, 1), Points(X, Y + 1, 2)
_glTexCoord2f float_xb, float_yb
_glVertex3f Points(X + 1, Y + 1, 0), Points(X + 1, Y + 1, 1), Points(X + 1, Y + 1, 2)
_glTexCoord2f float_xb, float_y
_glVertex3f Points(X + 1, Y, 0), Points(X + 1, Y, 1), Points(X + 1, Y, 2)
Y = Y + 1
Loop
X = X + 1
Y = 0
Loop
_glEnd
X = 0
Y = 0
' With even rendering in order, we move the coordinates in the field to the neighboring coordinates and thus also move the wave a little next to it.
' We gradually store the entire first column (outer cycle) in an auxiliary variable. We then move the wave a bit by simply assigning each element
' to its neighbor, and finally assign the stored edge value to the opposite end of the image. This creates the impression that when one wave
' disappears, a new one immediately begins to appear, but programmatically it is the end of the old one :-) In simple terms, we have only one wave, which
' moves to the beginning after leaving the image. Finally, we reset the wiggle_count to zero to keep the animation running.
If wiggle_count = 2 Then
Do Until Y > 44
X = 0
Hold = Points(0, Y, 2)
Do Until X > 43
Points(X, Y, 2) = Points(X + 1, Y, 2)
X = X + 1
Loop
Points(44, Y, 2) = Hold
Y = Y + 1
Loop
wiggle_count = 0
End If
wiggle_count = wiggle_count + 1
If _Exit Then
DeleteTexture Texture~& 'if program end, first free texture from memory, then exit from GL and return to main loop
_glClear _GL_COLOR_BUFFER_BIT
ExitSignal = Not 0
Exit Sub
End If
End Sub
Sub GL_Init
If GL_InitInfo = 0 Then
_glViewport 0, 0, _Width, _Height
GL_InitInfo = 1
End If
End Sub
_glPolygonMode _GL_BACK, _GL_FILL 'Front side filled with polygons
_glPolygonMode _GL_FRONT, _GL_LINE 'Back side filled with grid
' GL_FILL determines the classic drawing of polygons, GL_LINES draws only edge lines, with GL_POINTS only the top points could be seen.
' Which side of the polygon is the front and which is the back cannot be clearly determined, just rotate it and it's the other way around.
' That is why the convention arose that polygons whose vertices were entered counter-clockwise during rendering are inverted.
If GL_InitInfo = 0 Then
Texture~& = LoadTexture("vlajka.png", 1)
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
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? -?-
_FreeImage tex&
_MemFree n
'_FreeImage ni&
GoTo saveit
End Select
(04-02-2023, 06:36 PM)Petr Wrote: So here we have something interesting.
3D world using OpenGL. Since QB64PE already has _MouseMovement features fixed, it was really easy to add mouse movement.
:
:
The program has no collision detection, so you can walk through walls. I would probably solve the collision detection with an additional field where, when loading the triangle vertices in 2D, I would write down where the wall leads to, so that it really works, it is then necessary to shoot this 2D map in the same way as the image is shot during movement.
It can also be controlled from the keyboard with arrows and the Q and A buttons, or arrows + mouse, with the B button you can turn transparency on or off
Cool program, but there are a couple of things.
It would be nice to save the source code file along with the ZIP. Someone is going to become grated at having to copy source code from this site to paste into the QB64 IDE or a text editor because he/she thinks it should have been packed with the image files. It doesn't bother me, although I found it odd the ZIP contained no source code.
To Linux users: make sure the filenames on disk are in all lowercase letters or none of the wallpapers will load!
Otherwise if you use Linux you will have to edit the "world.txt" to match the letter-case of each filename. So decide what you want to do with that.
When using the mouse (touchpad in my case) for anything the screen warps briefly and then the program crashes into the Linux terminal with an "xcb" error. The keyboard could be used safely to pan around.
![[Image: star.jpg]](https://i.ibb.co/2dJPFTg/star.jpg)
![[Image: OGL8.png]](https://i.ibb.co/wMBD3PJ/OGL8.png)
![[Image: OGL9.png]](https://i.ibb.co/r4gJjp4/OGL9.png)
![[Image: OGL10.png]](https://i.ibb.co/TvVKKjM/OGL10.png)
