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:
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.
Texture:
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
_glShadeModel _GL_SMOOTH
_glClearColor 0.0F, 0.0F, 0.0F, 0.0F ' black background
_glClearDepth 1.0F ' depth buffer setting
_glDisable _GL_DEPTH_TEST ' disable depth testing
_glEnable _GL_BLEND ' enable blending
_glBlendFunc _GL_SRC_ALPHA, _GL_ONE ' blendig type set
_glHint _GL_PERSPECTIVE_CORRECTION_HINT, _GL_NICEST ' Perspective
_glHint _GL_POINT_SMOOTH_HINT, _GL_NICEST ' point softness
_glEnable _GL_TEXTURE_2D ' enable texture mapping
_glClear _GL_COLOR_BUFFER_BIT
_glClear _GL_DEPTH_BUFFER_BIT ' clear screen and depth buffer (this and previous line)
'GLH_Select_Texture texture&
_glLoadIdentity ' Reset matice
_glBindTexture _GL_TEXTURE_2D, Texture&
drawloop = 0
Do Until drawloop = MAX_PARTICLES
If Particle(drawloop).active = 1 Then ' if is particle active
angle = angle + .01: If angle > 72 Then angle = 0
Particle(drawloop).yg = (Sin(angle) * 10)
Particle(drawloop).xg = (Cos(angle) * 10)
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).x = Particle(drawloop).x + Particle(drawloop).xi / (slowdown * 1000) ' move on axis X
Particle(drawloop).y = Particle(drawloop).y + Particle(drawloop).yi / (slowdown * 1000) ' - // - y
Particle(drawloop).z = Particle(drawloop).z + Particle(drawloop).zi / (slowdown * 1000) ' - // - z
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).xi = xspeed + (P2 * Rnd) - 32.0F ' New speed and direction
Particle(drawloop).yi = yspeed + (-P2 * Rnd) - 30.0F ' -//-
Particle(drawloop).zi = (P2 * Rnd) - 30.0F ' -//-
col = Int(Rnd * 7) + 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
Particle(partloop).r = Colors(Int(partloop * (12 / MAX_PARTICLES))).r ' red
Particle(partloop).g = Colors(Int(partloop * (12 / MAX_PARTICLES))).g ' gren
Particle(partloop).b = Colors(Int(partloop * (12 / MAX_PARTICLES))).b ' blue
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
tex& = _LoadImage(image$, 32)
_SetAlpha 0, _RGB32(255, 255, 0) To _RGB32(254, 255, 255), tex&
texinv& = _NewImage(_Width(tex&), _Height(tex&), 32)
_PutImage (0, _Height(tex&))-(_Width(tex&), 0), tex&, texinv&
Dim Texture As _Unsigned Long
_glGenTextures 1, _Offset(Texture) 'generate our texture handle (reserve place in memory for new texture)
_glBindTexture _GL_TEXTURE_2D, Texture 'select our texture handle (set this texture for use)
gluBuild2DMipmaps _GL_TEXTURE_2D, 4, _Width(texinv&), _Height(texinv&), _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, _Offset(texinv&)
Dim m As _MEM
m = _MemImage(texinv&)
Select Case Filter
Case 3
'set our texture wrapping
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_S, _GL_REPEAT
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_WRAP_T, _GL_REPEAT
Case 0
'set out texture filtering
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_NEAREST 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_NEAREST 'for scaling down
Case 1
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR 'for scaling up
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR 'for scaling down
Case 2 'works....not sure, if this output is correct
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MIN_FILTER, _GL_LINEAR_MIPMAP_LINEAR 'for scaling down
_glTexParameteri _GL_TEXTURE_2D, _GL_TEXTURE_MAG_FILTER, _GL_LINEAR '
' 'for scaling UP
End Select
_FreeImage tex&
_glTexImage2D _GL_TEXTURE_2D, 0, _GL_RGB, _Width(texinv&), _Height(texinv&), 0, _GL_BGRA_EXT, _GL_UNSIGNED_BYTE, m.OFFSET
saveit:
U = UBound(GLL)
GLL(U).PointerGL = Texture
GLL(U).TextureName = image
GLL(U).Filtering = Filter
ReDim _Preserve GLL(U + 1) As GL_Loader
_MemFree m
Else
Print "LoadTexture Error: "; image$; " - file not found."
End If
LoadTexture = Texture
End FunctionTexture: