04-13-2023, 09:11 PM (This post was last modified: 04-13-2023, 09:13 PM by Petr.)
Due to the huge interest in this thread (according to the number of downloads in the previous post) - ZERO - I am highly motivated and so I come with another post:
OpenGL Particles
Here is an example of the ability to work with particles in OpenGL. Control with arrows and *, /, -, + and space keys. Something resembling a comet's tail can be simulated.
Texture is need.
Code: (Select All)
'castice - L19
' comment "-//-" = the same as previous comment
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 Particles (very fast remake) in QB64PE"
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 first, xspeed, yspeed, zoom, slowdown, drawloop, angle
Dim Shared Texture As Long
slowdown = 2.0F
zoom = -40.0F
Type struct
active As _Byte ' is this partice active?
life As Single ' particle life
fade As Single ' speed for particles age starnuti
r As Single ' colors: red
g As Single ' green
b As Single ' blue
x As Single ' position on X
y As Single ' position on Y
z As Single ' position on Z
xi As Single ' direction and speed in X
yi As Single ' direction and speed in Y
zi As Single ' direction and speed in Z
xg As Single 'gravity in X axis
yg As Single 'gravity in Y axis
zg As Single 'gravity in Z axis
End Type
Const MAX_PARTICLES = 2000
Dim Shared Particle(MAX_PARTICLES) As struct
Type Colors
r As Single
g As Single
b As Single
End Type
Dim Shared Colors(12) As Colors
For LoadColors = 1 To 12
Read Colors(LoadColors).r, Colors(LoadColors).g, Colors(LoadColors).b
Next LoadColors
Data 1.0,0.5,0.5,1.0,0.75,0.5,1.0,1.0,0.5,0.75,1.0,0.5
Data 0.5,1.0,0.5,0.5,1.0,0.75,0.5,1.0,1.0,0.5,0.75,1.0
Data 0.5,0.5,1.0,0.75,0.5,1.0,1.0,0.5,1.0,1.0,0.5,0.75
a = _Pi(2) / MAX_PARTICLES
drawloop2 = 1
Do Until drawloop2 = MAX_PARTICLES
Print "jo"
Randomize Timer
pp = Rnd * 50
If pp >= 25 Then P = -1 Else P = 1
Particle(drawloop2).x = 0.0F ' center to screen
Particle(drawloop2).y = 0.0F ' center to screen
Particle(drawloop2).z = 0.0F ' center to screen
Particle(drawloop2).xi = P * pp * 10.0F ' x axis random speed
Particle(drawloop2).yi = P * pp * 10.0F ' y axis random speed
Particle(drawloop2).zi = P * pp * 10.0F ' z axis random speed
drawloop2 = drawloop2 + 1
Loop
Screen _NewImage(1024, 768, 32)
Do While _KeyHit <> 27
i$ = InKey$
Select Case (UCase$(i$))
Case Chr$(32), "5"
Case "+"
If slowdown > 1.0F Then slowdown = slowdown - 0.1 ' particles speed up
Case "-"
If slowdown < 4.0F Then slowdown = slowdown + 0.1F ' particles speed down
Case "*"
zoom = zoom + 0.8F 'zoom +
Case "/"
zoom = zoom - 0.8F 'zoom -
Case Chr$(13)
If sp = 0 Then col = col + 1: If col > 12 Then col = 1
Case Chr$(0) + "H"
If yspeed < 200 Then yspeed = yspeed + 1.0F ' arrow up
Case Chr$(0) + "P"
If yspeed > -200 Then yspeed = yspeed - 1.0F ' arrow down
Case Chr$(0) + "M"
If xspeed < 200 Then xspeed = xspeed + 1.0F ' arrow right
Case Chr$(0) + "K"
If xspeed > -200 Then xspeed = xspeed - 1.0F ' arrow left
End Select
_Limit 120
Loop
Sub _GL
Static drawloop
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
'---
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR ' Filtering at shrinking
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR ' Filtering when zooming
x = Particle(drawloop).x ' x position
y = Particle(drawloop).y ' y position
z = Particle(drawloop).z + zoom ' z position + zoom
_glColor4f Particle(drawloop).r, Particle(drawloop).g, Particle(drawloop).b, Particle(drawloop).life 'coloring
_glBegin _GL_TRIANGLE_STRIP
_glTexCoord2d 1, 1: _glVertex3f x + 0.5F, y + 0.5F, z ' top right
_glTexCoord2d 0, 1: _glVertex3f x - 0.5F, y + 0.5F, z ' top left
_glTexCoord2d 1, 0: _glVertex3f x + 0.5F, y - 0.5F, z ' bottom right
_glTexCoord2d 0, 0: _glVertex3f x - 0.5F, y - 0.5F, z ' bottom left
_glEnd 'Ukoncí triangle strip
Particle(drawloop).xi = Particle(drawloop).xi + Particle(drawloop).xg ' Gravity on axis x
Particle(drawloop).yi = Particle(drawloop).yi + Particle(drawloop).yg ' - // - y
Particle(drawloop).zi = Particle(drawloop).zi + Particle(drawloop).zg ' -//- z
Particle(drawloop).life = Particle(drawloop).life - Particle(drawloop).fade 'speed for particle live
If Particle(drawloop).life < 0.0F Then 'if particle is dead (alpha is full, particle is unseen)
Particle(drawloop).life = 1.0F 'New life
Particle(drawloop).fade = Rnd / 1000.0F + 0.003F
Particle(drawloop).x = 0.0F ' X screen center
Particle(drawloop).y = 0.0F ' Y -//-
Particle(drawloop).z = 0.0F ' Z -//-
pp = Rnd * 10: If pp <= 4 Then P2 = 1 Else P2 = -1
Particle(drawloop).r = Colors(col).r ' color select from palette
Particle(drawloop).g = Colors(col).g ' -//-
Particle(drawloop).b = Colors(col).b ' -//-
End If
End If
drawloop = drawloop + 1
Loop
End Sub
Sub Init2
If GL_InitInfo = 0 Then
Texture& = LoadTexture("fireball.jpg", 0)
first = 1
For partloop = 1 To MAX_PARTICLES 'inicializing all particles
Particle(partloop).active = 1
Particle(partloop).life = 1.0F
Particle(partloop).fade = Rnd / 1000.0F + 0.003F ' live speed
polarity = Rnd * 10: If polarity <= 5 Then P = -1 Else P = 1 'aternative for C++ rand()%50
Particle(partloop).xi = P * Rnd - 26.0F * 10.0F ' speed and direction move on axis x
Particle(partloop).yi = P * Rnd - 25.0F * 10.0F ' -//- y
Particle(partloop).zi = P * Rnd - 25.0F * 10.0F ' -//- z
Particle(partloop).xg = 0.0F ' Gravity on axis x
Particle(partloop).yg = -0.8F ' Gravity on axis y
Particle(partloop).zg = 0.0F ' Gravity on axis z
Next partloop
GL_InitInfo = 1
_glEnable _GL_TEXTURE_2D
Exit Sub
End If
End Sub
Function LoadTexture (image As String, Filter As _Unsigned _Byte)
' If GL_InitInfo = 0 Then GL_Init
If _FileExists(image) Then
TT = 0
Do Until TT = UBound(GLL)
If GLL(TT).TextureName = image$ And GLL(TT).Filtering = Filter Then
LoadTexture = GLL(TT).PointerGL 'prevent memory leak loading next and next texture again and angain...
Exit Function
End If
TT = TT + 1
Loop
Dim Texture As _Unsigned Long
_glGenTextures 1, _Offset(Texture) 'generate our texture handle (reserve place in memory for new texture)
_glBindTexture _GL_TEXTURE_2D, Texture 'select our texture handle (set this texture for use)
gluBuild2DMipmaps _GL_TEXTURE_2D, 4, _Width(texinv&), _Height(texinv&), _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, _Offset(texinv&)
Dim m As _MEM
m = _MemImage(texinv&)
Select Case Filter
Case 3
'set our texture wrapping
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_S, _GL_REPEAT
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_T, _GL_REPEAT
Case 0
'set out texture filtering
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_NEAREST 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_NEAREST 'for scaling down
Case 1
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR 'for scaling down
Case 2 'works....not sure, if this output is correct
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR_MIPMAP_LINEAR 'for scaling down
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR '
' 'for scaling UP
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
(03-31-2023, 06:59 PM)Petr Wrote: 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.
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-13-2023, 09:11 PM)Petr Wrote: Due to the huge interest in this thread (according to the number of downloads in the previous post) - ZERO - I am highly motivated and so I come with another post:
Keep in mind this is a very small community, and the word gets out more often through Discord than from here directly, to the rest of the world. We're not reaching young people very well, while they're being told to program "only" in C++, Javascript and Python. So you can't be affected that well by the number of downloads of an attachment on this forum.
If you are really interested in better exposure for source code and whatever, you could join one of the BASIC groups on Reddit, for example. :O
You're sailing through an ocean without hunting whales which is a great undertaking, but it's not interesting to a lot of people who program in BASIC to use it as complex calculator, as expression parser for an obscure interpreted language or something else. Working with OpenGL isn't easy but you're demonstrating perseverance with it. :tu:
"Due to the huge interest in this thread (according to the number of downloads in the previous post) - ZERO - I am highly motivated and so I come with another post:"
Thank you for posting OpenGL examples. I am learning so much from your examples.
New to QB64pe? Visit the QB64 tutorial to get started. QB64 Tutorial
Quote: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 code that I take from post runs ok without anything of these problems about you talk.
I am using the images (one of them) posted by me in #32.
I miss the goal of loading the same image with 3 different Filter value because the image in output appears the same in the 3 filtering methods.
Pressing F in the program let me get the same graphic output.
What do you think about this? The new QB64pe versions have fixed something?
(04-14-2023, 03:10 AM)TerryRitchie Wrote: "Due to the huge interest in this thread (according to the number of downloads in the previous post) - ZERO - I am highly motivated and so I come with another post:"
Thank you for posting OpenGL examples. I am learning so much from your examples.
+1 I missed Quadrics, slipped in under my radar looks interesting.
Don't be discouraged, I follow your work, I think it's very useful! Difficult curriculum, complicated code, but the result is worth it!
The "fog" effect is very good.
I was thinking about whether it would be possible to somehow integrate the thing into a system for a 3D world.
For example:
(install points)
add_point p_index,x,y,z (p_index :0,1,2,3,4,5....)
(install triangles, with many parametrs)
add_triangle p_index1, p_index2, p_index3, t_index, transparency, fog....
After the integration/installation of 'points', 'textures', 'triangles', only the camera x,y,z,ang1,ang2 should be changed in the main cycle.
Thus, it could be used universally, as simply as the _MAPTRIANGLE command.
Thank you very much for your responses. I had no idea how many reactions my comment would generate. I will look at all the questions and answer them one by one. I have come now.
So...
Right at the beginning - to the questions of @TempodiBasic:
#32 - texturing the cube - so this post was updated and I added a zip file with the source code and the textures I used, the ones you refer to are not mine.
#35 - thanks for the heads up. There were two problems. One is that for MIPMAPPING to work you have to use a texture such that both sides are divisible by two and at the same time such that its longest side is at most 128 pixels long. It is information that I read recently - respectively - one source claims that it is ideal to upload any large texture, that large is better, it only insists on the condition that both sides are divisible by two, but does not indicate for which version of OpenGL they mean it, and another source again states , that textures up to 128x128 pixels should be selected. This will probably be true, because at larger sizes the program will hang (after eliminating the fatal problem number 2)
Fatal problem number 2, now eliminated everywhere. I forgot! in the library declaration, include the BYVAL declaration before the input parameters. That was why it just didn't work. Now it works as it should and I added BYVAL to all the source codes in the entire thread. I'm very sorry for this, I thought it was unnecessary, but recently I was clearly proven wrong.
When you run the program now, I added the wallpaper to the thread, with which I tried it again, so the first texturing - linear will return a very square wallpaper. The next one will be smoother. The two smooth ones look the same, I don't know where the problem is, I thought maybe my graphics card doesn't support it?
#34: TerryRitchie - my pleasure and sorry for the confusion.
#35: Mnrvovrfc: I agree with what you're saying.
#36: BPlus: You'd miss a lot But I still can't find the satellites I wrote with MapTriangle...
#37: MasterGy: Well, I'll try to do it. I already had the fog locked in the cube so it should work. At the same time, the fog can be any color and also one number indicates its density. Basically.... well, I already thought of it. As one goes into the fog, according to the SIN, its density will rise to its center (ABS(SIN) = 1) and decrease to zero again as it leaves the fog. I also have to try if there will be three quadrics that create a new shape (for example 2 spheres + cylinder = dumbbell) so that instead of three quadrics only one displaylist would be called... I'VE NEVER TRIED THIS. Heck yeah that's a challenge. I'll try it. I'm not saying it will work, but I have to try!
04-14-2023, 08:04 PM (This post was last modified: 04-14-2023, 08:04 PM by Petr.)
So let's take it step by step, let's keep it clear, shall we? Therefore, I will add the first change now, when there is another, I will add another, and so on.
So. @MasterGy, I found out that fog in OpenGL can only be turned off or on. I thought about it and realized that this is actually enough for me. But - not quite. First, a 2D program that explains the function of how to determine the intensity of the fog and whether we should actually turn it on or not. Do you know the CIRCLE command? There's a little genius thing in the help that just needed a little tweaking for OpenGL use.
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
Run this simple thing. A circle is drawn. Move the mouse to the middle. In the middle, the function returns 1 - this means that you are in the middle of the fog, so the fog will be thickest here. And on the edges you are somewhere around zero values.
How simple! You have a smooth onset of fog! Well, but if it will work in OpenGL?
I had to wrestle with it a bit, but I finally convinced OpenGL. So focus on lines 36 to 38, this is where you can set the color of the fog, then skip the _GL sub because initialization must be done first in the INIT2 sub on lines 242 and 244, notice line 243, it's moved to the main _GL loop just because to allow for a smooth onset and retreat of the fog. Then look in SUB _GL on lines 118 to 128, where the function I showed you a moment ago in 2D works for the 3D world.
And I ask: Who can guess what other clever uses in 3D the IsOnPos function offers us? Hmmmm?
After all, MUSIC. Imagine a radio placed in free space. The closer you are, the louder it will play. Amazing, huh?
Well, let's calm down a bit and imagine that the radio is placed in the room. And we have calculations.... echo according to the room, sound attenuation according to the walls... but it is enough to place it in a free space.
You have to be careful to set GL_FOG_START and GL_FOG_END correctly, or you will come out of the fog and the object in the distance will be seen as if there was no fog at all (the object must be in the range of GL_FOG_START to GL_FOG_END for this to not happen.
All files in attachment - this time is also world.txt file modified. Zip contains none EXE files, just source code, textures and txt file.
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
_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
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
'---- ---- ----
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
looks interesting.
