04-14-2023, 09:22 PM (This post was last modified: 04-14-2023, 09:25 PM by Petr.)
For the sake of simplicity, I haven't tried to convert it to displaylists yet, I'll try that tomorrow, but I still tried to add the quadrics to the scene. It was very easy. First, I put the definition of the help3.h library at the top and uploaded this library to folder with QB64PE.EXE, on line 25 I created a new global variable QuadricTexture, in the Init2 sub on line 269 and 270 I called quadric initialization and loaded the texture, and then I went straight to painting in Sub _GL on line 206 to 219. Never forget that OpenGL always paints from where it last left off, so you must always return the coordinates to the pre-painting state when you finish painting. If you don't, you're in for absolute chaos. So that I don't have to upload everything again, just download this additional attachment to the previous attachment, it contains this source code and 1 texture for the quadric and also the H library.
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
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
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 QuadricTexture As Long
'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
_DisplayOrder _GLRender , _Software
_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
_MouseMove _Width / 2, _Height / 2
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
'----- fog -----
' X Z radius
TestFog = IsOnPos(Xpos, Zpos, 0, -6, 7)
If TestFog Then
_glFogf _GL_FOG_DENSITY, TestFog / 2 ' fog density - Maximal TestFog Value is 1, so maximal FOG level is 1/2 = 50 percent.
_glHint _GL_FOG_HINT, _GL_NICEST ' fog Quality
_glFogf _GL_FOG_START, -6.0F ' fog begin in depth - axis z 'both this values are calculated for CAMERA
_glFogf _GL_FOG_END, 6.0F ' fog end in depth - axis z
End If
'-----------------------
_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
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
'---------------------------------------------------------------------
'for quadrics:
_glBindTexture _GL_TEXTURE_2D, QuadricTexture&
'shift in scene to sphere position
_glTranslatef 2, 0, -7 ' move to position (shift) in scene
_glRotatef 180, 0, -1, -1
drawCylinder 0.15, 0.1, 0.7, 20, 20
_glTranslatef 0, 0, .8
drawSphere .3, 40, 40
'shift and rotate back
_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
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
'---- fog ----
_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
_glEnable _GL_FOG
'---- ---- ----
initQuadric
QuadricTexture = LoadTexture("0.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
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
Function IsOnPos (Walker_Xpos, Walker_Zpos, PointX, PointZ, radius)
xy& = ((Walker_Xpos - PointX) ^ 2) + ((Walker_Zpos - PointZ) ^ 2) 'Pythagorean theorem
If radius ^ 2 >= xy& Then IsOnPos = (radius ^ 2 - xy&) / radius ^ 2 Else IsOnPos = 0
End Function
04-15-2023, 03:08 PM (This post was last modified: 04-15-2023, 03:09 PM by Petr.)
Yesterday I wrote here about how to implant sound to one place.
Also, in one of the previous demos - the one with the stars - I wrote there that it brings a useful thing - shooting a 2D texture to the user. So I just had to write it.
I am attaching another attachment of the 3D world. What was there stays there, a new piece has been added - behind the camera, so after starting, turn 180 degrees and go look there. Also, turn your sound on before you go there. No detonations await you, but... you will hear it yourself. I changed the fog to Martian sand so now the blackout is red. I have to say it's a great move. One can have a lot of fun writing the coordinates of an object that isn't there after launch... and look... it's flying pretty over my head... like yeah. Such relief is simply great.
I haven't tried display sheets yet, their time is yet to come. I also used a different texture for each part of the quadrics to show how to go about it.
To the program. The changes took place in the LOADTEXTURE function - it is written there in the form of a comment. In OpenGL, transparency is turned off by default, so if you take a textured image, first set it to a transparent background color, and then make it a texture, you shouldn't be surprised that the background doesn't disappear after you texture it to surface. In order to make it disappear, you have to use blending, and how to do it with and practical example is in this program.
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
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
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 As Long QuadricTexture, Silver, Tree, BirdSnd
Dim Shared As Single BirdVol
BirdVol = 1
'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
_DisplayOrder _GLRender , _Software
_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
_MouseMove _Width / 2, _Height / 2
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
_SndStop BirdSnd
_SndClose BirdSnd
System
End If
_Limit 50
Loop
Sub _GL ()
Init2
GL_Init
'----- fog -----
' X Z radius
TestFog = IsOnPos(Xpos, Zpos, 0, -6, 7)
If TestFog Then
_glFogf _GL_FOG_DENSITY, TestFog / 2 ' fog density - Maximal TestFog Value is 1, so maximal FOG level is 1/2 = 50 percent.
_glHint _GL_FOG_HINT, _GL_NICEST ' fog Quality
_glFogf _GL_FOG_START, -6.0F ' fog begin in depth - axis z 'both this values are calculated for CAMERA
_glFogf _GL_FOG_END, 6.0F ' fog end in depth - axis z
End If
'-----------------------
_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
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
'---------------------------------------------------------------------
'for quadrics:
_glBindTexture _GL_TEXTURE_2D, QuadricTexture&
'shift in scene to sphere position
_glTranslatef 2, 0, -7 ' move to position (shift) in scene
_glRotatef 180, 0, -1, -1
drawCylinder 0.15, 0.1, 0.7, 20, 20
_glTranslatef 0, 0, .8
_glBindTexture _GL_TEXTURE_2D, Silver&
drawSphere .3, 40, 40
' ------------------------ TREE ADD ONS ---------------------
_glRotatef 180, 0, 1, 1 'We need to turn in the right direction, because now we are rotated after previously setting the direction of painting the cylinder
' - then we could easily have the Z axis become the X axis and so on... Yeah, the tree flew over my head too. That was news... :)
'next addons: make 2D quad textured as tree and rotate it to user
_glTranslatef -3, .05, 12.5 'shift to tree position
_glRotatef -SceneRotY, 0, 1, 0 'rotate this 2D texture - The textured rectangle with transparency rotates against the direction of the camera, making the tree appear to be truly 3D.
_glBindTexture _GL_TEXTURE_2D, Tree&
_glEnable _GL_BLEND 'Please be aware of the change. In order to set the transparent white background of the PHOTO of the tree,
_glBlendFunc _GL_SRC_ALPHA, _GL_ONE_MINUS_SRC_ALPHA ' blending type for transparency
'https://learn.microsoft.com/en-us/windows/win32/opengl/glblendfunc microsoft help really helped me a lot this time
' an adjustment was also made in the LOADTEXTURE function, check it out!
_glBegin _GL_QUADS
_glNormal3f 0.0F, 0.0F, 1.0F 'for light
'birds voice!
BirdVol = IsOnPos(Xpos, Zpos, -.9, 5.4, 3)
_SndVol BirdSnd&, BirdVol
'----------------------- TREE END -----------------------------------
'shift and rotate back
_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
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
'---- fog ----
_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
_glEnable _GL_FOG
'---- ---- ----
initQuadric
QuadricTexture = LoadTexture("0.png", 1)
Silver = LoadTexture("silver.png", 1)
Tree = LoadTexture("tree.png", 1)
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
If LCase$(image$) = "tree.png" Then _SetAlpha 0, _RGB32(200, 200, 200) To _RGB32(255, 255, 255), texinv& 'set white colors as transparent for BLENDING
' look also to row 381!
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? -?-
'
_glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGBA, _Width(ni&), _Height(ni&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, n.OFFSET
' NEW IS HERE _GL_RGBA and not _GL_RGB as in previous case!
_FreeImage tex&
_MemFree n
'_FreeImage ni&
GoTo saveit
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
Function IsOnPos (Walker_Xpos, Walker_Zpos, PointX, PointZ, radius)
xy& = ((Walker_Xpos - PointX) ^ 2) + ((Walker_Zpos - PointZ) ^ 2) 'Pythagorean theorem
If radius ^ 2 >= xy& Then IsOnPos = (radius ^ 2 - xy&) / radius ^ 2 Else IsOnPos = 0
End Function
ZIP file contains textures, txt file, mp3 file and bas source code.
(04-15-2023, 03:08 PM)Petr Wrote: Yesterday I wrote here about how to implant sound to one place.
Also, in one of the previous demos - the one with the stars - I wrote there that it brings a useful thing - shooting a 2D texture to the user. So I just had to write it.
I am attaching another attachment of the 3D world. What was there stays there, a new piece has been added - behind the camera, so after starting, turn 180 degrees and go look there. Also, turn your sound on before you go there. No detonations await you, but... you will hear it yourself. I changed the fog to Martian sand so now the blackout is red. I have to say it's a great move. One can have a lot of fun writing the coordinates of an object that isn't there after launch... and look... it's flying pretty over my head... like yeah. Such relief is simply great.
I haven't tried display sheets yet, their time is yet to come. I also used a different texture for each part of the quadrics to show how to go about it.
To the program. The changes took place in the LOADTEXTURE function - it is written there in the form of a comment. In OpenGL, transparency is turned off by default, so if you take a textured image, first set it to a transparent background color, and then make it a texture, you shouldn't be surprised that the background doesn't disappear after you texture it to surface. In order to make it disappear, you have to use blending, and how to do it with and practical example is in this program.
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
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
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 As Long QuadricTexture, Silver, Tree, BirdSnd
Dim Shared As Single BirdVol
BirdVol = 1
'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
_DisplayOrder _GLRender , _Software
_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
_MouseMove _Width / 2, _Height / 2
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
_SndStop BirdSnd
_SndClose BirdSnd
System
End If
_Limit 50
Loop
Sub _GL ()
Init2
GL_Init
'----- fog -----
' X Z radius
TestFog = IsOnPos(Xpos, Zpos, 0, -6, 7)
If TestFog Then
_glFogf _GL_FOG_DENSITY, TestFog / 2 ' fog density - Maximal TestFog Value is 1, so maximal FOG level is 1/2 = 50 percent.
_glHint _GL_FOG_HINT, _GL_NICEST ' fog Quality
_glFogf _GL_FOG_START, -6.0F ' fog begin in depth - axis z 'both this values are calculated for CAMERA
_glFogf _GL_FOG_END, 6.0F ' fog end in depth - axis z
End If
'-----------------------
_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
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
'---------------------------------------------------------------------
'for quadrics:
_glBindTexture _GL_TEXTURE_2D, QuadricTexture&
'shift in scene to sphere position
_glTranslatef 2, 0, -7 ' move to position (shift) in scene
_glRotatef 180, 0, -1, -1
drawCylinder 0.15, 0.1, 0.7, 20, 20
_glTranslatef 0, 0, .8
_glBindTexture _GL_TEXTURE_2D, Silver&
drawSphere .3, 40, 40
' ------------------------ TREE ADD ONS ---------------------
_glRotatef 180, 0, 1, 1 'We need to turn in the right direction, because now we are rotated after previously setting the direction of painting the cylinder
' - then we could easily have the Z axis become the X axis and so on... Yeah, the tree flew over my head too. That was news... :)
'next addons: make 2D quad textured as tree and rotate it to user
_glTranslatef -3, .05, 12.5 'shift to tree position
_glRotatef -SceneRotY, 0, 1, 0 'rotate this 2D texture - The textured rectangle with transparency rotates against the direction of the camera, making the tree appear to be truly 3D.
_glBindTexture _GL_TEXTURE_2D, Tree&
_glEnable _GL_BLEND 'Please be aware of the change. In order to set the transparent white background of the PHOTO of the tree,
_glBlendFunc _GL_SRC_ALPHA, _GL_ONE_MINUS_SRC_ALPHA ' blending type for transparency
'https://learn.microsoft.com/en-us/windows/win32/opengl/glblendfunc microsoft help really helped me a lot this time
' an adjustment was also made in the LOADTEXTURE function, check it out!
_glBegin _GL_QUADS
_glNormal3f 0.0F, 0.0F, 1.0F 'for light
'birds voice!
BirdVol = IsOnPos(Xpos, Zpos, -.9, 5.4, 3)
_SndVol BirdSnd&, BirdVol
'----------------------- TREE END -----------------------------------
'shift and rotate back
_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
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
'---- fog ----
_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
_glEnable _GL_FOG
'---- ---- ----
initQuadric
QuadricTexture = LoadTexture("0.png", 1)
Silver = LoadTexture("silver.png", 1)
Tree = LoadTexture("tree.png", 1)
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
If LCase$(image$) = "tree.png" Then _SetAlpha 0, _RGB32(200, 200, 200) To _RGB32(255, 255, 255), texinv& 'set white colors as transparent for BLENDING
' look also to row 381!
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? -?-
'
_glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGBA, _Width(ni&), _Height(ni&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, n.OFFSET
' NEW IS HERE _GL_RGBA and not _GL_RGB as in previous case!
_FreeImage tex&
_MemFree n
'_FreeImage ni&
GoTo saveit
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
Function IsOnPos (Walker_Xpos, Walker_Zpos, PointX, PointZ, radius)
xy& = ((Walker_Xpos - PointX) ^ 2) + ((Walker_Zpos - PointZ) ^ 2) 'Pythagorean theorem
If radius ^ 2 >= xy& Then IsOnPos = (radius ^ 2 - xy&) / radius ^ 2 Else IsOnPos = 0
End Function
ZIP file contains textures, txt file, mp3 file and bas source code.
Alt + F4 seems my only escape! pretty cool graphics though
04-15-2023, 09:05 PM (This post was last modified: 04-15-2023, 09:13 PM by Petr.)
As I promised - and this will be the last post regarding the 3D world for the time being - I will go a little further in OpenGL and add more things here again - I'm learning this myself and I have to say I'm enjoying -
so to the point. Those DisplayLists as I talked about. Ladies and gentlemen, that's how they work. Why are they so important? Imagine you are writing a game - you need, for example, a model of a mailbox, or a model of a car - just something that repeats itself often. After all, you won't be writing it from the beginning every time. So you make a subroutine, in this case it's a bench, you save it in the displaylist and then you just determine the place where the bench should be painted (you call the texture every time before you paint model to place) so - even though it's the same model, it can look like otherwise. I hereby declare that DisplayLists and Quadriks cooperate and work! See the SUB BuildLists for how I assembled the bench.
Finally, a warning. A tree (2D) that looks like 3D must be painted last, due to the type of blending used, otherwise it happens that some objects behind the tree are visible (those that were painted before the tree) and some are not (those that were painted after the tree). It is supposed to proceed in such a way that the objects with this blending should be rendered in order from the furthest to the nearest. Personally, I'd rather make a displaylist with a real 3D parody of a tree...
In the attachment is the source file and the new texture, download the previous attachment to have all the textures. If something is missing, write to me and I will add it.
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
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
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 As Long QuadricTexture, Silver, Tree, BirdSnd, Bench, Wood
Dim Shared As Single BirdVol
BirdVol = 1
'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
_DisplayOrder _GLRender , _Software
_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
_MouseMove _Width / 2, _Height / 2
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
_SndStop BirdSnd
_SndClose BirdSnd
System
End If
_Limit 50
Loop
Sub _GL ()
Init2
GL_Init
'----- fog -----
' X Z radius
TestFog = IsOnPos(Xpos, Zpos, 0, -6, 7)
If TestFog Then
_glFogf _GL_FOG_DENSITY, TestFog / 2 ' fog density - Maximal TestFog Value is 1, so maximal FOG level is 1/2 = 50 percent.
_glHint _GL_FOG_HINT, _GL_NICEST ' fog Quality
_glFogf _GL_FOG_START, -6.0F ' fog begin in depth - axis z 'both this values are calculated for CAMERA
_glFogf _GL_FOG_END, 6.0F ' fog end in depth - axis z
End If
'-----------------------
_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
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
'---------------------------------------------------------------------
'for quadrics:
_glBindTexture _GL_TEXTURE_2D, QuadricTexture&
'shift in scene to sphere position
_glTranslatef 2, 0, -7 ' move to position (shift) in scene
_glRotatef 180, 0, -1, -1
drawCylinder 0.15, 0.1, 0.7, 20, 20
_glTranslatef 0, 0, .8
_glBindTexture _GL_TEXTURE_2D, Silver&
drawSphere .3, 40, 40
_glRotatef 180, 0, 1, 1 'We need to turn in the right direction, because now we are rotated after previously setting the direction of painting the cylinder
' - then we could easily have the Z axis become the X axis and so on... Yeah, the tree flew over my head too. That was news... :)
_glTranslatef -3, .05, 12.5 'shift to tree position
'rotate back
_glTranslatef 2, -.75, 0
'shift to next position
_glBindTexture _GL_TEXTURE_2D, Wood 'new texture
'call texture
'place bench's
psiN = _Pi(2) / 4
For object = 0 To 4
'next addons: make 2D quad textured as tree and rotate it to user
_glTranslatef -4, .8, 0 'shift to tree position
_glRotatef -SceneRotY, 0, 1, 0 'rotate this 2D texture - The textured rectangle with transparency rotates against the direction of the camera, making the tree appear to be truly 3D.
' ------------------------ TREE ADD ONS --------------------- with blending type used in this part - for tree - must this program part be always as last, otherwise some objects are not viewed
_glBindTexture _GL_TEXTURE_2D, Tree&
_glEnable _GL_BLEND 'Please be aware of the change. In order to set the transparent white background of the PHOTO of the tree,
_glBlendFunc _GL_SRC_ALPHA, _GL_ONE_MINUS_SRC_ALPHA ' blending type for transparency
'https://learn.microsoft.com/en-us/windows/win32/opengl/glblendfunc microsoft help really helped me a lot this time
' an adjustment was also made in the LOADTEXTURE function, check it out!
_glBegin _GL_QUADS
_glNormal3f 0.0F, 0.0F, 1.0F 'for light
'birds voice!
BirdVol = IsOnPos(Xpos, Zpos, -.9, 5.4, 3)
_SndVol BirdSnd&, BirdVol
'----------------------- TREE END -----------------------------------
_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
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
'---- fog ----
_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
_glEnable _GL_FOG
'---- ---- ----
initQuadric
QuadricTexture = LoadTexture("0.png", 1)
Silver = LoadTexture("silver.png", 1)
Tree = LoadTexture("tree.png", 1)
Wood = LoadTexture("wood.png", 2)
BirdSnd& = _SndOpen("bird-voices-7716.mp3")
_SndLoop BirdSnd&
BuildLists
Exit Sub
End If
End Sub
Sub BuildLists 'build bench 3D model
Bench = _glGenLists(1)
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
If LCase$(image$) = "tree.png" Then _SetAlpha 0, _RGB32(200, 200, 200) To _RGB32(255, 255, 255), texinv& 'set white colors as transparent for BLENDING
' look also to row 381!
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? -?-
'
_glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGBA, _Width(ni&), _Height(ni&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, n.OFFSET
' NEW IS HERE _GL_RGBA and not _GL_RGB as in previous case!
_FreeImage tex&
_MemFree n
'_FreeImage ni&
GoTo saveit
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
Function IsOnPos (Walker_Xpos, Walker_Zpos, PointX, PointZ, radius)
xy& = ((Walker_Xpos - PointX) ^ 2) + ((Walker_Zpos - PointZ) ^ 2) 'Pythagorean theorem
If radius ^ 2 >= xy& Then IsOnPos = (radius ^ 2 - xy&) / radius ^ 2 Else IsOnPos = 0
End Function
By the way, those displaylists can also be used for animation. That tree. If you had multiple frames of a tree, individual frames of the tree animation could be timed onto its rectangle. This would make the scene more alive. Tree in program is static.
04-16-2023, 05:40 AM (This post was last modified: 04-16-2023, 08:20 AM by Petr.)
Thanks for reporting the problem, I figured it out. I'm glad you let me know, because that's when I figured out the problem - I was making displaylists the wrong way. So I took my daughter's computer first. Then I uploaded this program to it (QB64PE is already there, of course!), ran it, and was able to replicate the problem you describe. Here is the fix, look in the SUB BuildLists, REM disabled what was causing the problem. Interesting that my computer didn't mind. Now the benches are there, please try this source code. Thank you.
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
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
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 As Long QuadricTexture, Silver, Tree, BirdSnd, Bench, Wood
Dim Shared As Single BirdVol
BirdVol = 1
'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
_DisplayOrder _GLRender , _Software
_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
_MouseMove _Width / 2, _Height / 2
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
_SndStop BirdSnd
_SndClose BirdSnd
System
End If
_Limit 50
Loop
Sub _GL ()
Init2
GL_Init
'----- fog -----
' X Z radius
TestFog = IsOnPos(Xpos, Zpos, 0, -6, 7)
If TestFog Then
_glFogf _GL_FOG_DENSITY, TestFog / 2 ' fog density - Maximal TestFog Value is 1, so maximal FOG level is 1/2 = 50 percent.
_glHint _GL_FOG_HINT, _GL_NICEST ' fog Quality
_glFogf _GL_FOG_START, -6.0F ' fog begin in depth - axis z 'both this values are calculated for CAMERA
_glFogf _GL_FOG_END, 6.0F ' fog end in depth - axis z
End If
'-----------------------
_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
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
'---------------------------------------------------------------------
'for quadrics:
_glBindTexture _GL_TEXTURE_2D, QuadricTexture&
'shift in scene to sphere position
_glTranslatef 2, 0, -7 ' move to position (shift) in scene
_glRotatef 180, 0, -1, -1
drawCylinder 0.15, 0.1, 0.7, 20, 20
_glTranslatef 0, 0, .8
_glBindTexture _GL_TEXTURE_2D, Silver&
drawSphere .3, 40, 40
_glRotatef 180, 0, 1, 1 'We need to turn in the right direction, because now we are rotated after previously setting the direction of painting the cylinder
' - then we could easily have the Z axis become the X axis and so on... Yeah, the tree flew over my head too. That was news... :)
_glTranslatef -3, .05, 12.5 'shift to tree position
'rotate back
_glTranslatef 2, -.75, 0
'shift to next position
_glBindTexture _GL_TEXTURE_2D, Wood 'new texture
'call texture
'place bench's
psiN = _Pi(2) / 4
For object = 0 To 4
'next addons: make 2D quad textured as tree and rotate it to user
_glTranslatef -4, .8, 0 'shift to tree position
_glRotatef -SceneRotY, 0, 1, 0 'rotate this 2D texture - The textured rectangle with transparency rotates against the direction of the camera, making the tree appear to be truly 3D.
' ------------------------ TREE ADD ONS --------------------- with blending type used in this part - for tree - must this program part be always as last, otherwise some objects are not viewed
_glBindTexture _GL_TEXTURE_2D, Tree&
_glEnable _GL_BLEND 'Please be aware of the change. In order to set the transparent white background of the PHOTO of the tree,
_glBlendFunc _GL_SRC_ALPHA, _GL_ONE_MINUS_SRC_ALPHA ' blending type for transparency
'https://learn.microsoft.com/en-us/windows/win32/opengl/glblendfunc microsoft help really helped me a lot this time
' an adjustment was also made in the LOADTEXTURE function, check it out!
_glBegin _GL_QUADS
_glNormal3f 0.0F, 0.0F, 1.0F 'for light
'birds voice!
BirdVol = IsOnPos(Xpos, Zpos, -.9, 5.4, 3)
_SndVol BirdSnd&, BirdVol
'----------------------- TREE END -----------------------------------
_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
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
'---- fog ----
_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
_glEnable _GL_FOG
'---- ---- ----
initQuadric
QuadricTexture = LoadTexture("0.png", 1)
Silver = LoadTexture("silver.png", 1)
Tree = LoadTexture("tree.png", 1)
Wood = LoadTexture("wood.png", 1)
BirdSnd& = _SndOpen("bird-voices-7716.mp3")
_SndLoop BirdSnd&
BuildLists
Exit Sub
End If
End Sub
Sub BuildLists 'build bench 3D model
Bench = _glGenLists(1)
_glNewList Bench, _GL_COMPILE
'top two boards on the seat
glDrawCube 0.3, 0.01, 0.05
Rem _glEnd
_glTranslatef 0, 0, -0.11 'space between boards
glDrawCube 0.3, 0.01, 0.05
Rem _glEnd
_glTranslatef .25, -0.02, .05
glDrawCube 0.05, 0.012, 0.08 'left lower connecting board
Rem _glEnd
_glTranslatef -.5, 0, .0
glDrawCube 0.05, 0.012, 0.08 'right lower connecting board
Rem _glEnd
_glTranslatef 0, -.2, 0
_glRotatef 180, 0, 1, 1
drawCylinder 0.01, 0.01, .2, 4, 6 'right leg
Rem _glEnd
_glTranslatef -.5, 0, 0
drawCylinder 0.01, 0.01, .2, 4, 6 'left leg
_glRotatef -180, 0, 1, 1 'return rotation back
_glTranslatef 0, 0.22, 0 'return to start draw height
_glEnd
_glEndList
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
If LCase$(image$) = "tree.png" Then _SetAlpha 0, _RGB32(200, 200, 200) To _RGB32(255, 255, 255), texinv& 'set white colors as transparent for BLENDING
' look also to row 381!
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? -?-
'
_glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGBA, _Width(ni&), _Height(ni&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, n.OFFSET
' NEW IS HERE _GL_RGBA and not _GL_RGB as in previous case!
_FreeImage tex&
_MemFree n
'_FreeImage ni&
GoTo saveit
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
Function IsOnPos (Walker_Xpos, Walker_Zpos, PointX, PointZ, radius)
xy& = ((Walker_Xpos - PointX) ^ 2) + ((Walker_Zpos - PointZ) ^ 2) 'Pythagorean theorem
If radius ^ 2 >= xy& Then IsOnPos = (radius ^ 2 - xy&) / radius ^ 2 Else IsOnPos = 0
End Function
04-17-2023, 06:46 PM (This post was last modified: 04-17-2023, 06:48 PM by Petr.)
Hi BPlus, thanks for your comment. When I call the H file in the next program, I will modify its call according to your request. You are right, guys are very good at 3d, I'm still learning 3D.
So, now to today's program. Again, I am inspired by NeHe. This is another type of transparency - namely, using a mask. How would I explain it...
Imagine you have an image with a yellow background. In normal work in QB64 (not in OpenGL) you set _ClearColor &HFFFF0000, handle& and you're done. Then you can insert the image into the scene and the yellow background is not visible.
In OpenGL, one method - based on transparency - is demonstrated in the previous example on a tree texture in a 3D world. Its disadvantage is that it has to be done last and moreover from the depth towards the camera.
This program shows another way - using two textures. One texture is a normal color image and the other texture is a black and white mask based on that color texture.
The way it works in this program is that what is white will be fully transparent. What is black will be visible from the color texture. This method should be easier (if you remember in the middle of the program that you want to add something). Focus your attention on the parameters of the _glBlendFunc command, it just sets the transparency types and also to _glEnable _gl_Blend and _glDisable _gl_Blend - turns blending (which is transparency) on and 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
_Title "OpenGL Masking (hide image background when used as texture)"
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 Masking, Scene, Roll
Dim Shared Texture(5) As Long
Screen _NewImage(1024, 768, 32)
Do
i$ = InKey$
Select Case UCase$(i$)
Case "M": Masking = Not Masking
Case " ": Scene = Not Scene
End Select
_Limit 20
Loop
Sub _GL
Static Roll
Init2
_glMatrixMode _GL_PROJECTION '// Set projection matrix
_gluPerspective 45.0F, _Width / _Height, 0.1F, 100.0F ' This is GLUT statement, this is directly supported by QB64. Set up perspective projection matrix. First is angle for perspective, then is aspct, next is Z Near and Z Far
_glMatrixMode _GL_MODELVIEW ' Set Modelview matrix
_glClear _GL_COLOR_BUFFER_BIT
_glClear _GL_DEPTH_BUFFER_BIT 'clear screen and depth buffer
_glLoadIdentity 'matrix reset
_glTranslatef 0.0F, 0.0F, -2.0F 'shit do depth on the srceen
_glBindTexture _GL_TEXTURE_2D, Texture(0) 'select logo texture
If Masking Then 'is masking allowed?
_glBlendFunc _GL_DST_COLOR, _GL_ZERO ' Blend color image using zero (all, what is one (white) is transparent, all what is ZERO (black), is visible on the screen
End If
If Scene Then ' drawing second scene?
' We don't want the objects to be too big, so we move deeper into the screen. We will perform a rotation on the z axis by 0 degrees to 360 degrees according to the roll variable.
_glTranslatef 0.0F, 0.0F, -1.0F 'shit up to 1 to depth
_glRotatef Roll * 360, 0.0F, 0.0F, 1.0F 'rotation on Z axis
'If masking is on, we render the mask first and then the object. When off, only the object.
_glBlendFunc _GL_ONE, _GL_ONE 'for second color texture
_glBindTexture _GL_TEXTURE_2D, Texture(4) 'select second color texture
_glBegin _GL_QUADS 'start quad drawing
If Masking Then 'is masking enabled?
_glBindTexture _GL_TEXTURE_2D, Texture(1) 'select first mask texture
_glBegin _GL_QUADS 'start drawing quad
_glTexCoord2f Roll + 0.0F, 0.0F: _glVertex3f -1.1F, -1.1F, 0.0F
_glTexCoord2f Roll + 4.0F, 0.0F: _glVertex3f 1.1F, -1.1F, 0.0F
_glTexCoord2f Roll + 4.0F, 4.0F: _glVertex3f 1.1F, 1.1F, 0.0F
_glTexCoord2f Roll + 0.0F, 4.0F: _glVertex3f -1.1F, 1.1F, 0.0F
_glEnd 'end drawing
End If
'We will set the Blending the same as last time. We select the scene one texture and render it in the same place as the mask.
_glBlendFunc _GL_ONE, _GL_ONE 'for first color texture
_glBindTexture _GL_TEXTURE_2D, Texture(2) 'select first color texture
_glBegin _GL_QUADS 'start drawing quad
_glTexCoord2f Roll + 0.0F, 0.0F: _glVertex3f -1.1F, -1.1F, 0.0F
_glTexCoord2f Roll + 4.0F, 0.0F: _glVertex3f 1.1F, -1.1F, 0.0F
_glTexCoord2f Roll + 4.0F, 4.0F: _glVertex3f 1.1F, 1.1F, 0.0F
_glTexCoord2f Roll + 0.0F, 4.0F: _glVertex3f -1.1F, 1.1F, 0.0F
_glEnd 'end drawing quad
'In order for the scene to move dynamically, we need to increment the roll.
End If
Roll = Roll + 0.002 ' Inkrement roll
If Roll > 1.0 Then Roll = Roll - 1 'is bigger than 1?
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&)
Select Case Filter
Case 3
'set our texture wrapping
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_S, _GL_REPEAT
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_T, _GL_REPEAT
Case 0
'set out texture filtering
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_NEAREST 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_NEAREST 'for scaling down
Case 1
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR 'for scaling down
Case 2 'works....not sure, if this output is correct
gluBuild2DMipmaps _GL_TEXTURE_2D, 3, 16, 16, _GL_RGB, _GL_UNSIGNED_BYTE, _Offset(Texture)
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR_MIPMAP_LINEAR 'for scaling down
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_NEAREST
' 'for scaling UP
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
Press space for scene change, M for enable/disable masking. Need textures in attachement.
