NeHe Lesson 19: Particle Engine Using Triangle Strips

[José Roca]

 
This example illustrates how to program a simple but nice looking particle engine.

It is an adaptation of NeHe Lesson 19: http://nehe.gamedev.net/data/lessons/lesson.asp?lesson=19

Code Select Expand


' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "GLU.INC"
#INCLUDE "GDIPLUS.INC"
#INCLUDE "GDIPUTILS.INC"

$WindowCaption = "NeHe Lesson 19"

%GL_WINDOWWIDTH  = 640         ' Window width
%GL_WINDOWHEIGHT = 480         ' Window height
%GL_BITSPERPEL   = 16          ' Color resolution in bits per pixel
%GL_DEPTHBITS    = 16          ' Depth of the depth (z-axis) buffer

%MAX_PARTICLES = 1000   ' Number of particles to create

TYPE particles
  active AS LONG    ' Active (Yes/No)
  life AS SINGLE    ' Particle life
  fade AS SINGLE    ' Fade speed
  r AS SINGLE       ' Red value
  g AS SINGLE       ' Green value
  b AS SINGLE       ' Blue value
  x AS SINGLE       ' X Position
  y AS SINGLE       ' Y Position
  z AS SINGLE       ' Z Position
  xi AS SINGLE      ' X Direction
  yi AS SINGLE      ' Y Direction
  zi AS SINGLE      ' Z Direction
  xg AS SINGLE      ' X Gravity
  yg AS SINGLE      ' Y Gravity
  zg AS SINGLE      ' Z Gravity
END TYPE

GLOBAL hDC AS LONG             ' Device context handle
GLOBAL TextureHandle AS DWORD  ' Texture handle
GLOBAL rainbow AS LONG         ' Rainbow mode?
GLOBAL slowdown AS SINGLE      ' Slow down particles
GLOBAL xspeed AS SINGLE        ' Base x speed (to allow keyboard direction of tail)
GLOBAL yspeed AS SINGLE        ' Base y speed (to allow keyboard direction of tail)
GLOBAL zoom AS SINGLE          ' Used to zoom out
GLOBAL clr AS DWORD            ' Current color selection
GLOBAL delay AS DWORD          ' Rainbow effec delay
GLOBAL sp AS LONG
GLOBAL particle() AS particles
GLOBAL colors() AS SINGLE

' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   LOCAL hr AS LONG
   LOCAL strTextureData AS STRING
   LOCAL TextureWidth, TextureHeight AS LONG
   LOCAL i AS LONG

   slowdown = 2.0!
   zoom = -40.0!

   DIM   particle (%MAX_PARTICLES - 1) AS particles   ' Particle array (room for particle info)
   DIM   colors (11, 2) AS SINGLE

   colors ( 0, 0) = 1.0!  : colors ( 0, 1) = 0.5!  : colors ( 0, 2) = 0.5!
   colors ( 1, 0) = 1.0!  : colors ( 1, 1) = 0.75! : colors ( 1, 2) = 0.5!
   colors ( 2, 0) = 1.0!  : colors ( 2, 1) = 1.0!  : colors ( 2, 2) = 0.5!
   colors ( 3, 0) = 0.75! : colors ( 3, 1) = 1.0!  : colors ( 3, 2) = 0.5!
   colors ( 4, 0) = 0.5!  : colors ( 4, 1) = 1.0!  : colors ( 4, 2) = 0.5!
   colors ( 5, 0) = 0.5!  : colors ( 5, 1) = 1.0!  : colors ( 5, 2) = 0.75!
   colors ( 6, 0) = 0.5!  : colors ( 6, 1) = 1.0!  : colors ( 6, 2) = 1.0!
   colors ( 7, 0) = 0.5!  : colors ( 7, 1) = 0.75! : colors ( 7, 2) = 1.0!
   colors ( 8, 0) = 0.5!  : colors ( 8, 1) = 0.5!  : colors ( 8, 2) = 1.0!
   colors ( 9, 0) = 0.75! : colors ( 9, 1) = 0.5!  : colors ( 9, 2) = 1.0!
   colors (10, 0) = 1.0!  : colors (10, 1) = 0.5!  : colors (10, 2) = 1.0!
   colors (11, 0) = 1.0!  : colors (11, 1) = 0.5! :  colors (11, 2) = 0.75!

   ' Load bitmap texture from disk
   hr = GdiPlusLoadTexture("particle.bmp", TextureWidth, TextureHeight, strTextureData, %TRUE)

   ' Assign handle
   glGenTextures 1, TextureHandle

   ' Create linear filtered texture
   glBindTexture %GL_TEXTURE_2D, TextureHandle
   glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MAG_FILTER, %GL_LINEAR
   glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MIN_FILTER, %GL_LINEAR
   glTexImage2D %GL_TEXTURE_2D, 0, 3, TextureWidth, TextureHeight, 0, _
                %GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData)

   ' Select smooth shading
   glShadeModel %GL_SMOOTH
   ' Specify clear values for the color buffers
   glClearColor 0.0!, 0.0!, 0.0!, 0.0!
   ' Disable depth testing
   glDisable %GL_DEPTH_TEST
   ' Enable blending
   glEnable %GL_BLEND
   ' Type of blending to perform
   glBlendFunc %GL_SRC_ALPHA, %GL_ONE
' Really nice perspective calculations
   glHint %GL_PERSPECTIVE_CORRECTION_HINT, %GL_NICEST
   ' Really nice point smoothing
   glHint %GL_POINT_SMOOTH_HINT, %GL_NICEST
   ' Enable texture maping
   glEnable %GL_TEXTURE_2D
   ' Select texture
   glBindTexture %GL_TEXTURE_2D, TextureHandle

   ' Initializes all the particles
   FOR i = 0 TO %MAX_PARTICLES -1
      particle(i).active = %True                             ' Make all the particles active
      particle(i).life = 1.0!                                ' Give all the particles full life
      particle(i).fade = (RND * 100) / 1000.0! + 0.003!  ' Random fade speed
      particle(i).r = colors(i * (12 \ %MAX_PARTICLES), 0)   ' Select red rainbow color
      particle(i).g = colors(i * (12 \ %MAX_PARTICLES), 1)   ' Select red rainbow color
      particle(i).b = colors(i * (12 \ %MAX_PARTICLES), 2)   ' Select red rainbow color
      particle(i).xi = ((RND * 50) - 26.0!) * 10.0!      ' Random speed on x axis
      particle(i).yi = ((RND * 50) - 25.0!) * 10.0!      ' Random speed on y axis
      particle(i).zi = ((RND * 50) - 25.0!) * 10.0!      ' Random speed on z axis
      particle(i).xg = 0.0!                                  ' Set horizontal pull to zero
      particle(i).yg = -0.8!                                 ' Set vertical pull downward
      particle(i).zg = 0.0!                                  ' Set pull on z axis to zero
   NEXT

END SUB
' =======================================================================================

' =======================================================================================
' Resize the scene
' =======================================================================================
SUB ResizeScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   ' Prevent divide by zero making height equal one
   IF nHeight = 0 THEN nHeight = 1
   ' Reset the current viewport
   glViewport 0, 0, nWidth, nHeight
   ' Select the projection matrix
   glMatrixMode %GL_PROJECTION
   ' Reset the projection matrix
   glLoadIdentity
   ' Calculate the aspect ratio of the window
   gluPerspective 45.0!, nWidth / nHeight, 0.1!, 100.0!
   ' Select the model view matrix
   glMatrixMode %GL_MODELVIEW
   ' Reset the model view matrix
   glLoadIdentity

END SUB
' =======================================================================================

' =======================================================================================
' Draw the scene
' =======================================================================================
SUB DrawScene (BYVAL hwnd AS DWORD, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   LOCAL i AS LONG
   LOCAL sx, sy, sz AS SINGLE

   ' Clear the screen buffer
   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT
   ' Reset the view
   glLoadIdentity

   ' Loop through all the particles
   FOR i = 0 TO %MAX_PARTICLES - 1
      IF particle(i).active THEN           ' If the particle is active
         sx = particle(i).x                ' Grab our particle x position
         sy = particle(i).y                ' Grab our particle y position
         sz = particle(i).z + zoom         ' Particle z pos + zoom

         ' draw the particle using our rgb values, fade the particle based on it's life
         glColor4f particle(i).r, particle(i).g, particle(i).b, particle(i).life
         glBegin %GL_TRIANGLE_STRIP                                ' build quad from a triangle strip
            glTexCoord2d 1, 1 : glVertex3f sx + 0.5!, sy + 0.5!, sz  ' Top right
            glTexCoord2d 0, 1 : glVertex3f sx - 0.5!, sy + 0.5!, sz  ' Top left
            glTexCoord2d 1, 0 : glVertex3f sx + 0.5!, sy - 0.5!, sz  ' Bottom right
            glTexCoord2d 0, 0 : glVertex3f sx - 0.5!, sy - 0.5!, sz  ' Bottom left
         glEnd                                                     ' Done building triangle strip

         particle(i).x = particle(i).x + particle(i).xi / (slowdown * 1000)  ' Move on the x axis by x speed
         particle(i).y = particle(i).y + particle(i).yi / (slowdown * 1000)  ' Move on the y axis by y speed
         particle(i).z = particle(i).z + particle(i).zi / (slowdown * 1000)  ' Move on the z axis by z speed

         particle(i).xi = particle(i).xi + particle(i).xg          ' Take pull on x axis into account
         particle(i).yi = particle(i).yi + particle(i).yg          ' Take pull on y axis into account
         particle(i).zi = particle(i).zi + particle(i).zg          ' Take pull on z axis into account
         particle(i).life = particle(i).life - particle(i).fade    ' Reduce particles life by 'fade'

         IF particle(i).life < 0.0! THEN                           ' If particle is burned out
            particle(i).life = 1.0!                                ' Give it new life
            particle(i).fade = (RND * 100) / 1000.0! + 0.003!  ' Random fade value
            particle(i).x = 0.0!                                   ' Center on x axis
            particle(i).y = 0.0!                                   ' Center on y axis
            particle(i).z = 0.0!                                   ' Center on z axis
            particle(i).xi = xspeed + ((RND * 60) - 32.0!)     ' X axis speed and direction
            particle(i).yi = yspeed + ((RND * 60) - 30.0!)     ' Y axis speed and direction
            particle(i).zi = ((RND * 60) - 30.0!)              ' Z axis speed and direction
            particle(i).r = colors(clr, 0)                         ' Select red from color table
            particle(i).g = colors(clr, 1)                         ' Select green from color table
            particle(i).b = colors(clr, 2)                         ' Select blue from color table
         END IF
      END IF
   NEXT

   IF (rainbow AND (delay > 25)) THEN
      sp = %TRUE                 ' Set flag telling us space is pressed
      delay = 0                  ' Reset the rainbow color cycling delay
      clr = clr + 1              ' Change the particle color
      IF clr > 11 THEN clr = 0   ' If color is too high, reset it
   END IF

END SUB
' =======================================================================================

' =======================================================================================
' Cleanup
' =======================================================================================
SUB Cleanup (BYVAL hwnd AS DWORD)

   ' Delete the texture
   IF TextureHandle THEN glDeleteTextures(1, TextureHandle)

END SUB
' =======================================================================================

' =======================================================================================
' Processes keystrokes
' Parameters:
' * hwnd = Window hande
' * vKeyCode = Virtual key code
' * bKeyDown = %TRUE if key is pressed; %FALSE if it is released
' =======================================================================================
SUB ProcessKeystrokes (BYVAL hwnd AS DWORD, BYVAL vKeyCode AS LONG, BYVAL bKeyDown AS LONG)

   STATIC rp AS LONG

   SELECT CASE AS LONG vKeyCode

      CASE %VK_ESCAPE
         ' Quit if Esc key pressed
         SendMessage hwnd, %WM_CLOSE, 0, 0

      CASE %VK_SUBTRACT
         IF ISTRUE bKeyDown AND slowdown < 4.0! THEN slowdown = slowdown - 0.01!

      CASE %VK_RETURN
         IF ISTRUE bKeyDown AND ISFALSE rp THEN
            rp = %TRUE
            rainbow = NOT rainbow
         END IF
         IF ISFALSE bKeyDown THEN rp = %FALSE

      ' Space or rainbow mode
      CASE %VK_SPACE
         IF (ISTRUE bKeyDown AND ISFALSE sp) OR (rainbow AND (delay > 25)) THEN
            rainbow = %FALSE           ' Disable rainbow mode
            sp = %TRUE                 ' Set flag telling us space is pressed
            delay = 0                  ' Reset the rainbow color cycling delay
            clr = clr + 1              ' Change the particle color
            IF clr > 11 THEN clr = 0   ' If color is too high, reset it
         END IF
         IF ISFALSE bKeyDown THEN sp = %FALSE

      CASE %VK_PGUP
         IF ISTRUE bKeyDown THEN zoom = zoom - 0.1!

      CASE %VK_PGDN
         IF ISTRUE bKeyDown THEN zoom = zoom + 0.1!

      CASE %VK_UP
         IF ISTRUE bKeyDown AND yspeed < 200 THEN yspeed = yspeed + 1.0!

      CASE %VK_DOWN
         IF ISTRUE bKeyDown AND yspeed > - 200 THEN yspeed = yspeed - 1.0!

      CASE %VK_RIGHT
         IF ISTRUE bKeyDown AND xspeed < 200 THEN xspeed = xspeed + 1.0!

      CASE %VK_LEFT
         IF ISTRUE bKeyDown AND xspeed > -200 THEN xspeed = xspeed - 1.0!

   END SELECT

END SUB
' =======================================================================================

' =======================================================================================
' Main
' =======================================================================================
FUNCTION WINMAIN (BYVAL hInstance AS DWORD, BYVAL hPrevInstance AS DWORD, BYVAL lpszCmdLine AS ASCIIZ PTR, BYVAL nCmdShow AS LONG) AS LONG

   LOCAL  hwnd        AS DWORD
   LOCAL  wcex        AS WNDCLASSEX
   LOCAL  szClassName AS ASCIIZ * 256
   LOCAL  szCaption   AS ASCIIZ * 256
   LOCAL  msg         AS tagMSG
   LOCAL  rc          AS RECT
   LOCAL  bDone       AS LONG
   LOCAL  nLeft       AS LONG
   LOCAL  nTop        AS LONG
   LOCAL  nWidth      AS LONG
   LOCAL  nHeight     AS LONG
   LOCAL  dwStyle     AS DWORD
   LOCAL  dwStyleEx   AS DWORD
   STATIC vKeyCode    AS LONG
   STATIC bKeyDown    AS LONG
   LOCAL  t           AS DOUBLE
   LOCAL  t0          AS DOUBLE
   LOCAL  fps         AS DOUBLE
   LOCAL  nFrames     AS LONG
   LOCAL  dm          AS DEVMODE
   LOCAL  bFullScreen AS LONG
   LOCAL  lResult     AS LONG

   ' Register the window class
   szClassName        = "PBOPENGL"
   wcex.cbSize        = SIZEOF(wcex)
   wcex.style         = %CS_HREDRAW OR %CS_VREDRAW OR %CS_OWNDC
   wcex.lpfnWndProc   = CODEPTR(WndProc)
   wcex.cbClsExtra    = 0
   wcex.cbWndExtra    = 0
   wcex.hInstance     = hInstance
   wcex.hCursor       = LoadCursor (%NULL, BYVAL %IDC_ARROW)
   wcex.hbrBackground = %NULL
   wcex.lpszMenuName  = %NULL
   wcex.lpszClassName = VARPTR(szClassName)
   wcex.hIcon         = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Sample, if resource icon: LoadIcon(hInst, "APPICON")
   wcex.hIconSm       = LoadIcon (%NULL, BYVAL %IDI_APPLICATION) ' Remember to set small icon too..
   RegisterClassEx wcex

' Ask the user which screen mode he prefers
lResult = MessageBox(%NULL, "Would you like to run in fullscreen mode?", _
             "Start fullScreen?", %MB_YESNOCANCEL OR %MB_ICONQUESTION)
   SELECT CASE lResult
      CASE %IDCANCEL : EXIT FUNCTION
      CASE %IDYES    : bFullScreen = %TRUE
      CASE %IDNO     : bFullScreen = %FALSE
   END SELECT

   ' Window size
   nWidth  = %GL_WINDOWWIDTH
   nHeight = %GL_WINDOWHEIGHT

   IF bFullScreen THEN
      ' Change display settings
      dm.dmSize       = SIZEOF(dm)
      dm.dmPelsWidth  = nWidth
      dm.dmPelsHeight = nHeight
      dm.dmBitsPerPel = %GL_BITSPERPEL
      dm.dmFields     = %DM_BITSPERPEL OR %DM_PELSWIDTH OR %DM_PELSHEIGHT
      IF ChangeDisplaySettings(dm, %CDS_FULLSCREEN) = 0 THEN ShowCursor %FALSE
   END IF

   ' Window caption
   szCaption = $WindowCaption

   ' Window styles
   IF ISFALSE bFullScreen THEN
      dwStyle = %WS_OVERLAPPEDWINDOW
      dwStyleEx = %WS_EX_APPWINDOW OR %WS_EX_WINDOWEDGE
   ELSE
      dwStyle = %WS_POPUP
      dwStyleEx = %WS_EX_APPWINDOW
   END IF

   ' Create the window
   hwnd = CreateWindowEx( _
            dwStyleEx, _                      ' extended styles
            szClassName, _                    ' window class name
            szCaption, _                      ' window caption
            dwStyle, _                        ' window style
            nLeft, _                          ' initial x position
            nTop, _                           ' initial y position
            nWidth, _                         ' initial x size
            nHeight, _                        ' initial y size
            %NULL, _                          ' parent window handle
            0, _                              ' window menu handle
            hInstance, _                      ' program instance handle
            BYVAL %NULL)                      ' creation parameters

   ' Retrieve the coordinates of the window's client area
   GetClientRect hwnd, rc
   ' Initialize the new OpenGl window
   SetupScene hwnd, rc.nRight - rc.nLeft, rc.nBottom - rc.nTop

   ' Show the window
   ShowWindow hwnd, nCmdShow
   UpdateWindow hwnd

   DO UNTIL bDone

      ' Windows message pump
      DO WHILE PeekMessage(msg, %NULL, 0, 0, %PM_REMOVE)
         IF msg.message = %WM_QUIT THEN
            bDone = %TRUE
         ELSE
            IF msg.message = %WM_KEYDOWN THEN
               vKeyCode = msg.wParam
               bKeyDown = %TRUE
            ELSEIF msg.message = %WM_KEYUP THEN
               vKeyCode = msg.wParam
               bKeyDown = %FALSE
            END IF
            TranslateMessage msg
            DispatchMessage msg
         END IF
      LOOP

      IF ISFALSE bFullScreen THEN
         ' Get time and mouse position
         t = INT(TIMER)
         ' Calculate and display FPS (frames per second)
         IF t > t0 OR nFrames = 0 THEN
            fps = nFrames \ (t - t0)
            wsprintf szCaption, $WindowCaption & " (%i FPS)", BYVAL fps
            SetWindowText hwnd, szCaption
            t0 = t
            nFrames = 0
         END IF
         nFrames = nFrames + 1
      END IF

      ' Draw the scene
      DrawScene hwnd, nWidth, nHeight
      ' Exchange the front and back buffers
      SwapBuffers hDC

      ' Process the keystrokes
      IF vKeyCode THEN
         ProcessKeystrokes hwnd, vKeyCode, bKeyDown
         vKeyCode = 0
      END IF

   LOOP

   ' Retore defaults
   IF bFullScreen THEN
      ChangeDisplaySettings BYVAL %NULL, 0
      ShowCursor %TRUE
   END IF

   FUNCTION = msg.wParam

END FUNCTION
' =======================================================================================

' =======================================================================================
' Main window procedure
' =======================================================================================
FUNCTION WndProc (BYVAL hwnd AS DWORD, BYVAL wMsg AS DWORD, BYVAL wParam AS DWORD, BYVAL lParam AS LONG) AS LONG

   LOCAL  pf           AS LONG
   LOCAL  pfd          AS PIXELFORMATDESCRIPTOR
   STATIC hRC          AS LONG

   SELECT CASE wMsg

      CASE %WM_SYSCOMMAND

         ' Disable the Windows screensaver
         IF (wParam AND &HFFF0) = %SC_SCREENSAVE THEN EXIT FUNCTION

         ' Close the window
         IF (wParam AND &HFFF0) = %SC_CLOSE THEN
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

      CASE %WM_CREATE

         ' Retrieve the device context handle
         hDC = GetDC(hwnd)

         ' Fill the PIXELFORMATDESCRIPTOR structure
         pfd.nSize           = SIZEOF(PIXELFORMATDESCRIPTOR)   ' Size of the structure
         pfd.nVersion        = 1                               ' Version number
         pfd.dwFlags         = %PFD_DRAW_TO_WINDOW _           ' Format must support window
                               OR %PFD_SUPPORT_OPENGL _        ' Format must support OpenGL
                               OR %PFD_DOUBLEBUFFER            ' Format must support double buffering
         pfd.iPixelType      = %PFD_TYPE_RGBA                  ' Request an RGBA format
         pfd.cColorBits      = %GL_BITSPERPEL                  ' Number of color bitplanes in each color buffer
         pfd.cRedBits        = 0                               ' Number of red bitplanes in each RGBA color buffer.
         pfd.cRedShift       = 0                               ' Shift count for red bitplanes in each RGBA color buffer.
         pfd.cGreenBits      = 0                               ' Number of green bitplanes in each RGBA color buffer.
         pfd.cGreenShift     = 0                               ' Shift count for green bitplanes in each RGBA color buffer.
         pfd.cBlueBits       = 0                               ' Number of blue bitplanes in each RGBA color buffer.
         pfd.cBlueShift      = 0                               ' Shift count for blue bitplanes in each RGBA color buffer.
         pfd.cAlphaBits      = 0                               ' Number of alpha bitplanes in each RGBA color buffer
         pfd.cAlphaShift     = 0                               ' Shift count for alpha bitplanes in each RGBA color buffer.
         pfd.cAccumBits      = 0                               ' Total number of bitplanes in the accumulation buffer.
         pfd.cAccumRedBits   = 0                               ' Number of red bitplanes in the accumulation buffer.
         pfd.cAccumGreenBits = 0                               ' Number of gree bitplanes in the accumulation buffer.
         pfd.cAccumBlueBits  = 0                               ' Number of blue bitplanes in the accumulation buffer.
         pfd.cAccumAlphaBits = 0                               ' Number of alpha bitplanes in the accumulation buffer.
         pfd.cDepthBits      = %GL_DEPTHBITS                   ' Depth of the depth (z-axis) buffer.
         pfd.cStencilBits    = 0                               ' Depth of the stencil buffer.
         pfd.cAuxBuffers     = 0                               ' Number of auxiliary buffers.
         pfd.iLayerType      = %PFD_MAIN_PLANE                 ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.
         pfd.bReserved       = 0                               ' Number of overlay and underlay planes.
         pfd.dwLayerMask     = 0                               ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.
         pfd.dwVisibleMask   = 0                               ' Transparent color or index of an underlay plane.
         pfd.dwDamageMask    = 0                               ' Ignored. Earlier implementations of OpenGL used this member, but it is no longer used.

         ' Find a matching pixel format
         pf = ChoosePixelFormat(hDC, pfd)
         IF ISFALSE pf THEN
            MessageBox hwnd, "Can't find a suitable pixel format", _
                       "Error", %MB_OK OR %MB_ICONEXCLAMATION
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' Set the pixel format
         IF ISFALSE SetPixelFormat(hDC, pf, pfd) THEN
            MessageBox hwnd, "Can't set the pixel format", _
                       "Error", %MB_OK OR %MB_ICONEXCLAMATION
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' Create a new OpenGL rendering context
         hRC = wglCreateContext(hDC)
         IF ISFALSE hRC THEN
            MessageBox hwnd, "Can't create an OpenGL rendering context", _
                       "Error", %MB_OK OR %MB_ICONEXCLAMATION
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         ' Make it current
         IF ISFALSE wglMakeCurrent(hDC,hRC) THEN
            MessageBox hwnd, "Can't activate the OpenGL rendering context", _
                       "Error", %MB_OK OR %MB_ICONEXCLAMATION
            SendMessage hwnd, %WM_CLOSE, 0, 0
            EXIT FUNCTION
         END IF

         EXIT FUNCTION

      CASE %WM_DESTROY
         ' Clear resources
         Cleanup hwnd
         ' Release the device and rendering contexts
         wglMakeCurrent hDC, 0
         ' Make the rendering context no longer current
         wglDeleteContext hRC
         ' Release the device context
         ReleaseDC hwnd, hDC
         ' Post an WM_QUIT message
         PostQuitMessage 0
         EXIT FUNCTION

      CASE %WM_SIZE
         ResizeScene hwnd, LO(WORD, lParam), HI(WORD, lParam)
         EXIT FUNCTION

   END SELECT

   ' Call the default window procedure to process unhandled messages
   FUNCTION = DefWindowProc(hwnd, wMsg, wParam, lParam)

END FUNCTION
' =======================================================================================


[José Roca]

This example illustrates how to program a simple but nice looking particle engine.

It is an adaptation of NeHe Lesson 19: http://nehe.gamedev.net/data/lessons/lesson.asp?lesson=19

Code Select Expand


' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE "SDL.INC"
#INCLUDE "GLU.INC"
#INCLUDE "GDIPUTILS.INC"

$WindowCaption = "NeHe Lesson 19"

%MAX_PARTICLES = 1000   ' Number of particles to create

TYPE particles
  active AS LONG    ' Active (Yes/No)
  life AS SINGLE    ' Particle life
  fade AS SINGLE    ' Fade speed
  r AS SINGLE       ' Red value
  g AS SINGLE       ' Green value
  b AS SINGLE       ' Blue value
  x AS SINGLE       ' X Position
  y AS SINGLE       ' Y Position
  z AS SINGLE       ' Z Position
  xi AS SINGLE      ' X Direction
  yi AS SINGLE      ' Y Direction
  zi AS SINGLE      ' Z Direction
  xg AS SINGLE      ' X Gravity
  yg AS SINGLE      ' Y Gravity
  zg AS SINGLE      ' Z Gravity
END TYPE

GLOBAL hDC AS LONG             ' Device context handle
GLOBAL TextureHandle AS DWORD  ' Texture handle
GLOBAL rainbow AS LONG         ' Rainbow mode?
GLOBAL slowdown AS SINGLE      ' Slow down particles
GLOBAL xspeed AS SINGLE        ' Base x speed (to allow keyboard direction of tail)
GLOBAL yspeed AS SINGLE        ' Base y speed (to allow keyboard direction of tail)
GLOBAL zoom AS SINGLE          ' Used to zoom out
GLOBAL clr AS DWORD            ' Current color selection
GLOBAL delay AS DWORD          ' Rainbow effec delay
GLOBAL sp AS LONG
GLOBAL particle() AS particles
GLOBAL colors() AS SINGLE

' =======================================================================================
' All the setup goes here
' =======================================================================================
SUB SetupScene ()

   LOCAL hr AS LONG
   LOCAL strTextureData AS STRING
   LOCAL TextureWidth, TextureHeight AS LONG
   LOCAL i AS LONG

   slowdown = 2.0!
   zoom = -40.0!

   DIM   particle (%MAX_PARTICLES - 1) AS particles   ' Particle array (room for particle info)
   DIM   colors (11, 2) AS SINGLE

   colors ( 0, 0) = 1.0!  : colors ( 0, 1) = 0.5!  : colors ( 0, 2) = 0.5!
   colors ( 1, 0) = 1.0!  : colors ( 1, 1) = 0.75! : colors ( 1, 2) = 0.5!
   colors ( 2, 0) = 1.0!  : colors ( 2, 1) = 1.0!  : colors ( 2, 2) = 0.5!
   colors ( 3, 0) = 0.75! : colors ( 3, 1) = 1.0!  : colors ( 3, 2) = 0.5!
   colors ( 4, 0) = 0.5!  : colors ( 4, 1) = 1.0!  : colors ( 4, 2) = 0.5!
   colors ( 5, 0) = 0.5!  : colors ( 5, 1) = 1.0!  : colors ( 5, 2) = 0.75!
   colors ( 6, 0) = 0.5!  : colors ( 6, 1) = 1.0!  : colors ( 6, 2) = 1.0!
   colors ( 7, 0) = 0.5!  : colors ( 7, 1) = 0.75! : colors ( 7, 2) = 1.0!
   colors ( 8, 0) = 0.5!  : colors ( 8, 1) = 0.5!  : colors ( 8, 2) = 1.0!
   colors ( 9, 0) = 0.75! : colors ( 9, 1) = 0.5!  : colors ( 9, 2) = 1.0!
   colors (10, 0) = 1.0!  : colors (10, 1) = 0.5!  : colors (10, 2) = 1.0!
   colors (11, 0) = 1.0!  : colors (11, 1) = 0.5! :  colors (11, 2) = 0.75!

   ' Load bitmap texture from disk
   hr = GdiPlusLoadTexture("particle.bmp", TextureWidth, TextureHeight, strTextureData, %TRUE)

   ' Assign handle
   glGenTextures 1, TextureHandle

   ' Create linear filtered texture
   glBindTexture %GL_TEXTURE_2D, TextureHandle
   glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MAG_FILTER, %GL_LINEAR
   glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MIN_FILTER, %GL_LINEAR
   glTexImage2D %GL_TEXTURE_2D, 0, 3, TextureWidth, TextureHeight, 0, _
                %GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData)

   ' Select smooth shading
   glShadeModel %GL_SMOOTH
   ' Specify clear values for the color buffers
   glClearColor 0.0!, 0.0!, 0.0!, 0.0!
   ' Disable depth testing
   glDisable %GL_DEPTH_TEST
   ' Enable blending
   glEnable %GL_BLEND
   ' Type of blending to perform
   glBlendFunc %GL_SRC_ALPHA, %GL_ONE
' Really nice perspective calculations
   glHint %GL_PERSPECTIVE_CORRECTION_HINT, %GL_NICEST
   ' Really nice point smoothing
   glHint %GL_POINT_SMOOTH_HINT, %GL_NICEST
   ' Enable texture maping
   glEnable %GL_TEXTURE_2D
   ' Select texture
   glBindTexture %GL_TEXTURE_2D, TextureHandle

   ' Initializes all the particles
   FOR i = 0 TO %MAX_PARTICLES -1
      particle(i).active = %True                             ' Make all the particles active
      particle(i).life = 1.0!                                ' Give all the particles full life
      particle(i).fade = (RND * 100) / 1000.0! + 0.003!  ' Random fade speed
      particle(i).r = colors(i * (12 \ %MAX_PARTICLES), 0)   ' Select red rainbow color
      particle(i).g = colors(i * (12 \ %MAX_PARTICLES), 1)   ' Select red rainbow color
      particle(i).b = colors(i * (12 \ %MAX_PARTICLES), 2)   ' Select red rainbow color
      particle(i).xi = ((RND * 50) - 26.0!) * 10.0!      ' Random speed on x axis
      particle(i).yi = ((RND * 50) - 25.0!) * 10.0!      ' Random speed on y axis
      particle(i).zi = ((RND * 50) - 25.0!) * 10.0!      ' Random speed on z axis
      particle(i).xg = 0.0!                                  ' Set horizontal pull to zero
      particle(i).yg = -0.8!                                 ' Set vertical pull downward
      particle(i).zg = 0.0!                                  ' Set pull on z axis to zero
   NEXT

END SUB
' =======================================================================================

' =======================================================================================
' Draw the scene
' =======================================================================================
SUB DrawScene (BYVAL nWidth AS LONG, BYVAL nHeight AS LONG)

   LOCAL i AS LONG
   LOCAL sx, sy, sz AS SINGLE

   ' Clear the screen buffer
   glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT

   ' Select and setup the projection matrix
   glMatrixMode %GL_PROJECTION
   glLoadIdentity

   ' Prevent divide by zero making height equal one
   IF nHeight = 0 THEN nHeight = 1

   ' Calculate the aspect ratio of the window
   gluPerspective 45.0!, nWidth/nHeight, 1.0!, 100.0!

   ' Select and setup the modelview matrix
   glMatrixMode %GL_MODELVIEW
   glLoadIdentity

   ' Loop through all the particles
   FOR i = 0 TO %MAX_PARTICLES - 1
      IF particle(i).active THEN           ' If the particle is active
         sx = particle(i).x                ' Grab our particle x position
         sy = particle(i).y                ' Grab our particle y position
         sz = particle(i).z + zoom         ' Particle z pos + zoom

         ' draw the particle using our rgb values, fade the particle based on it's life
         glColor4f particle(i).r, particle(i).g, particle(i).b, particle(i).life
         glBegin %GL_TRIANGLE_STRIP                                ' build quad from a triangle strip
            glTexCoord2d 1, 1 : glVertex3f sx + 0.5!, sy + 0.5!, sz  ' Top right
            glTexCoord2d 0, 1 : glVertex3f sx - 0.5!, sy + 0.5!, sz  ' Top left
            glTexCoord2d 1, 0 : glVertex3f sx + 0.5!, sy - 0.5!, sz  ' Bottom right
            glTexCoord2d 0, 0 : glVertex3f sx - 0.5!, sy - 0.5!, sz  ' Bottom left
         glEnd                                                     ' Done building triangle strip

         particle(i).x = particle(i).x + particle(i).xi / (slowdown * 1000)  ' Move on the x axis by x speed
         particle(i).y = particle(i).y + particle(i).yi / (slowdown * 1000)  ' Move on the y axis by y speed
         particle(i).z = particle(i).z + particle(i).zi / (slowdown * 1000)  ' Move on the z axis by z speed

         particle(i).xi = particle(i).xi + particle(i).xg          ' Take pull on x axis into account
         particle(i).yi = particle(i).yi + particle(i).yg          ' Take pull on y axis into account
         particle(i).zi = particle(i).zi + particle(i).zg          ' Take pull on z axis into account
         particle(i).life = particle(i).life - particle(i).fade    ' Reduce particles life by 'fade'

         IF particle(i).life < 0.0! THEN                           ' If particle is burned out
            particle(i).life = 1.0!                                ' Give it new life
            particle(i).fade = (RND * 100) / 1000.0! + 0.003!  ' Random fade value
            particle(i).x = 0.0!                                   ' Center on x axis
            particle(i).y = 0.0!                                   ' Center on y axis
            particle(i).z = 0.0!                                   ' Center on z axis
            particle(i).xi = xspeed + ((RND * 60) - 32.0!)     ' X axis speed and direction
            particle(i).yi = yspeed + ((RND * 60) - 30.0!)     ' Y axis speed and direction
            particle(i).zi = ((RND * 60) - 30.0!)              ' Z axis speed and direction
            particle(i).r = colors(clr, 0)                         ' Select red from color table
            particle(i).g = colors(clr, 1)                         ' Select green from color table
            particle(i).b = colors(clr, 2)                         ' Select blue from color table
         END IF
      END IF
   NEXT

   IF (rainbow AND (delay > 25)) THEN
      sp = %TRUE                 ' Set flag telling us space is pressed
      delay = 0                  ' Reset the rainbow color cycling delay
      clr = clr + 1              ' Change the particle color
      IF clr > 11 THEN clr = 0   ' If color is too high, reset it
   END IF

   ' // Swap buffers
   SDL_GL_SwapBuffers

END SUB
' =======================================================================================

' =======================================================================================
' Main
' =======================================================================================
FUNCTION PBMAIN () AS LONG

   LOCAL pscreen AS SDL_Surface PTR
   LOCAL nWidth, nHeight, bpp AS LONG
   LOCAL lResult, bFullScreen AS LONG
   LOCAL szCaption AS ASCIIZ * 256
   LOCAL dwFlags AS DWORD
   LOCAL t, t0, fps AS DOUBLE
   LOCAL nFrames AS LONG
   LOCAL rp AS LONG

   szCaption = $WindowCaption   ' Window caption

' Ask the user which screen mode he prefers
lResult = MessageBox(%NULL, "Would you like to run in fullscreen mode?", _
             "Start fullScreen?", %MB_YESNOCANCEL OR %MB_ICONQUESTION)
   SELECT CASE lResult
      CASE %IDCANCEL : EXIT FUNCTION
      CASE %IDYES    : bFullScreen = %TRUE
      CASE %IDNO     : bFullScreen = %FALSE
   END SELECT

   ' // Initialize SDL's subsystems - in this case, only video.
   IF SDL_Init(%SDL_INIT_VIDEO) < 0 THEN
      MSGBOX "Unable to init SDL: " & SDL_GetError()
      EXIT FUNCTION
   END IF

   ' // Attempt to create a 640x480 window
   nWidth = 640 : nHeight = 480 : bpp = 16
   IF bFullScreen THEN
      dwFlags = %SDL_OPENGL OR %SDL_FULLSCREEN
   ELSE
      dwFlags = %SDL_OPENGL
   END IF
   pscreen = SDL_SetVideoMode(nWidth, nHeight, bpp, dwFlags)
   SDL_WM_SetCaption szCaption, ""

   ' // If we fail, return error.
   IF pscreen = %NULL THEN
      SDL_Quit
      MSGBOX "Unable to set the video mode: " & SDL_GetError()
      EXIT FUNCTION
   END IF

   ' // Set up the scene
   SetupScene

   ' Enable keyboard repeat
   SDL_EnableKeyRepeat %SDL_DEFAULT_REPEAT_DELAY, %SDL_DEFAULT_REPEAT_INTERVAL

   ' // Main loop
   LOCAL done AS LONG
   LOCAL uevent AS SDL_Event
   WHILE done = %FALSE

      ' // Poll for events, and handle the ones we care about.
      WHILE SDL_PollEvent(VARPTR(uevent))
         SELECT CASE uevent.type
            CASE %SDL_KEYDOWN
               SELECT CASE uevent.key.keysym.sym
                  CASE %SDLK_MINUS
                     IF slowdown < 4.0! THEN slowdown = slowdown - 0.01!
                  CASE %SDLK_RETURN
                     IF ISFALSE rp THEN
                        rp = %TRUE
                        rainbow = NOT rainbow
                     END IF
                  ' Space or rainbow mode
                  CASE %SDLK_SPACE
                     IF (ISFALSE sp) OR (rainbow AND (delay > 25)) THEN
                        rainbow = %FALSE           ' Disable rainbow mode
                        sp = %TRUE                 ' Set flag telling us space is pressed
                        delay = 0                  ' Reset the rainbow color cycling delay
                        clr = clr + 1              ' Change the particle color
                        IF clr > 11 THEN clr = 0   ' If color is too high, reset it
                     END IF
                  CASE %SDLK_PAGEUP
                     zoom = zoom - 0.1!
                  CASE %SDLK_PAGEDOWN
                     zoom = zoom + 0.1!
                  CASE %SDLK_UP
                     IF yspeed < 200 THEN yspeed = yspeed + 1.0!
                  CASE %SDLK_DOWN
                     IF yspeed > - 200 THEN yspeed = yspeed - 1.0!
                  CASE %SDLK_RIGHT
                     IF xspeed < 200 THEN xspeed = xspeed + 1.0!
                  CASE %SDLK_LEFT
                     IF xspeed > -200 THEN xspeed = xspeed - 1.0!
               END SELECT
            CASE %SDL_KEYUP
               ' // Quit if escape is pressed
               IF uevent.key.keysym.sym = %SDLK_ESCAPE THEN
                  done = %TRUE
                  EXIT LOOP
               END IF
               ' Reset flags
               rp = %FALSE
               sp = %FALSE
            CASE %SDL_QUIT
               done = %TRUE
               EXIT LOOP
         END SELECT
      WEND

      IF ISFALSE bFullScreen THEN
         ' Get time and mouse position
         t = INT(TIMER)
         ' Calculate and display FPS (frames per second)
         IF t > t0 OR nFrames = 0 THEN
            fps = nFrames \ (t - t0)
            wsprintf szCaption, $WindowCaption & " (%i FPS)", BYVAL fps
            SDL_WM_SetCaption szCaption, szCaption
            t0 = t
            nFrames = 0
         END IF
         nFrames = nFrames + 1
      END IF

      ' // Draw the scene
      DrawScene nWidth, nHeight

   WEND

   ' Delete the texture
   IF TextureHandle THEN glDeleteTextures(1, TextureHandle)

   ' Shut down SDL
   SDL_Quit

END FUNCTION
' =======================================================================================


[José Roca]

 
This example illustrates how to program a simple but nice looking particle engine.

It is an adaptation of NeHe Lesson 19: http://nehe.gamedev.net/data/lessons/lesson.asp?lesson=19

Code Select Expand


' SED_PBWIN - Use the PBWIN compiler
#COMPILE EXE
#DIM ALL
#INCLUDE ONCE "GLFW.INC"
#INCLUDE ONCE "GDIPUTILS.INC"

%MAX_PARTICLES = 1000   ' Number of particles to create

TYPE particles
  active AS LONG    ' Active (Yes/No)
  life AS SINGLE    ' Particle life
  fade AS SINGLE    ' Fade speed
  r AS SINGLE       ' Red value
  g AS SINGLE       ' Green value
  b AS SINGLE       ' Blue value
  x AS SINGLE       ' X Position
  y AS SINGLE       ' Y Position
  z AS SINGLE       ' Z Position
  xi AS SINGLE      ' X Direction
  yi AS SINGLE      ' Y Direction
  zi AS SINGLE      ' Z Direction
  xg AS SINGLE      ' X Gravity
  yg AS SINGLE      ' Y Gravity
  zg AS SINGLE      ' Z Gravity
END TYPE

' =======================================================================================
' Main
' =======================================================================================
FUNCTION PBMAIN () AS LONG

   LOCAL hr, nWidth, nHeight, running, frames, x, y AS LONG
   LOCAL t, t0, fps AS DOUBLE
   LOCAL szTitlestr AS ASCIIZ * 200
   LOCAL strTextureData AS STRING
   LOCAL TextureWidth, TextureHeight AS LONG
   DIM   TextureHandle AS DWORD
   LOCAL sx, sy, sz AS SINGLE

   LOCAL rainbow AS LONG      ' Rainbow mode?
   LOCAL sp AS LONG           ' Spacebar pressed?
   LOCAL rp AS LONG           ' Enter key pressed?
   LOCAL slowdown AS SINGLE   ' Slow down particles
   LOCAL xspeed AS SINGLE     ' Base x speed (to allow keyboard direction of tail)
   LOCAL yspeed AS SINGLE     ' Base y speed (to allow keyboard direction of tail)
   LOCAL zoom AS SINGLE       ' Used to zoom out
   LOCAL i AS LONG            ' Loop variable
   LOCAL clr AS DWORD         ' Current color selection
   LOCAL delay AS DWORD       ' Rainbow effec delay

   slowdown = 2.0!
   zoom = -40.0!

   DIM   particle (%MAX_PARTICLES - 1) AS particles   ' Particle array (room for particle info)
   DIM   colors (11, 2) AS SINGLE

   colors ( 0, 0) = 1.0!  : colors ( 0, 1) = 0.5!  : colors ( 0, 2) = 0.5!
   colors ( 1, 0) = 1.0!  : colors ( 1, 1) = 0.75! : colors ( 1, 2) = 0.5!
   colors ( 2, 0) = 1.0!  : colors ( 2, 1) = 1.0!  : colors ( 2, 2) = 0.5!
   colors ( 3, 0) = 0.75! : colors ( 3, 1) = 1.0!  : colors ( 3, 2) = 0.5!
   colors ( 4, 0) = 0.5!  : colors ( 4, 1) = 1.0!  : colors ( 4, 2) = 0.5!
   colors ( 5, 0) = 0.5!  : colors ( 5, 1) = 1.0!  : colors ( 5, 2) = 0.75!
   colors ( 6, 0) = 0.5!  : colors ( 6, 1) = 1.0!  : colors ( 6, 2) = 1.0!
   colors ( 7, 0) = 0.5!  : colors ( 7, 1) = 0.75! : colors ( 7, 2) = 1.0!
   colors ( 8, 0) = 0.5!  : colors ( 8, 1) = 0.5!  : colors ( 8, 2) = 1.0!
   colors ( 9, 0) = 0.75! : colors ( 9, 1) = 0.5!  : colors ( 9, 2) = 1.0!
   colors (10, 0) = 1.0!  : colors (10, 1) = 0.5!  : colors (10, 2) = 1.0!
   colors (11, 0) = 1.0!  : colors (11, 1) = 0.5! :  colors (11, 2) = 0.75!

   ' Initialize GLFW
   glfwInit

   ' Open OpenGL window
   IF ISFALSE glfwOpenWindow(640, 480, 0, 0, 0, 0, 16, 0, %GLFW_WINDOW) THEN
      glfwTerminate
      EXIT FUNCTION
   END IF

   ' Load bitmap texture from disk
   hr = GdiPlusLoadTexture("particle.bmp", TextureWidth, TextureHeight, strTextureData, %TRUE)

   ' Assign handle
   glGenTextures 1, TextureHandle

   ' Create linear filtered texture
   glBindTexture %GL_TEXTURE_2D, TextureHandle
   glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MAG_FILTER, %GL_LINEAR
   glTexParameteri %GL_TEXTURE_2D, %GL_TEXTURE_MIN_FILTER, %GL_LINEAR
   glTexImage2D %GL_TEXTURE_2D, 0, 3, TextureWidth, TextureHeight, 0, _
                %GL_RGBA, %GL_UNSIGNED_BYTE, BYVAL STRPTR(strTextureData)

   ' Select smooth shading
   glShadeModel %GL_SMOOTH
   ' Specify clear values for the color buffers
   glClearColor 0.0!, 0.0!, 0.0!, 0.0!
   ' Disable depth testing
   glDisable %GL_DEPTH_TEST
   ' Enable blending
   glEnable %GL_BLEND
   ' Type of blending to perform
   glBlendFunc %GL_SRC_ALPHA, %GL_ONE
' Really nice perspective calculations
   glHint %GL_PERSPECTIVE_CORRECTION_HINT, %GL_NICEST
   ' Really nice point smoothing
   glHint %GL_POINT_SMOOTH_HINT, %GL_NICEST
   ' Enable texture maping
   glEnable %GL_TEXTURE_2D
   ' Select texture
   glBindTexture %GL_TEXTURE_2D, TextureHandle

   ' Initializes all the particles
   FOR i = 0 TO %MAX_PARTICLES -1
      particle(i).active = %True                             ' Make all the particles active
      particle(i).life = 1.0!                                ' Give all the particles full life
      particle(i).fade = (RND * 100) / 1000.0! + 0.003!  ' Random fade speed
      particle(i).r = colors(i * (12 \ %MAX_PARTICLES), 0)   ' Select red rainbow color
      particle(i).g = colors(i * (12 \ %MAX_PARTICLES), 1)   ' Select red rainbow color
      particle(i).b = colors(i * (12 \ %MAX_PARTICLES), 2)   ' Select red rainbow color
      particle(i).xi = ((RND * 50) - 26.0!) * 10.0!      ' Random speed on x axis
      particle(i).yi = ((RND * 50) - 25.0!) * 10.0!      ' Random speed on y axis
      particle(i).zi = ((RND * 50) - 25.0!) * 10.0!      ' Random speed on z axis
      particle(i).xg = 0.0!                                  ' Set horizontal pull to zero
      particle(i).yg = -0.8!                                 ' Set vertical pull downward
      particle(i).zg = 0.0!                                  ' Set pull on z axis to zero
   NEXT

   ' Enable sticky keys
   glfwEnable %GLFW_STICKY_KEYS

   ' Disable vertical sync (on cards that support it)
   glfwSwapInterval 0

   ' Main loop
   running = %TRUE
   frames = 0
   t0 = glfwGetTime

   DO WHILE running

      ' Get time and mouse position
      t = glfwGetTime
      glfwGetMousePos x, y
      ' Calculate and display FPS (frames per second)
      IF t - t0 > 1.0! OR frames = 0 THEN
         fps = frames / (t-t0)
         wsprintf szTitlestr, "NEHE Lesson 19 (%i FPS)", BYVAL fps
         glfwSetWindowTitle szTitlestr
         t0 = t
         frames = 0
      END IF
      frames = frames + 1

      '  Get window size (may be different than the requested size)
      glfwGetWindowSize nWidth, nHeight
      IF nHeight <= 0 THEN nHeight = 1

      ' Set viewport
      glViewport 0, 0, nWidth, nHeight

      ' Clear the screen and the depth buffers
      glClear %GL_COLOR_BUFFER_BIT OR %GL_DEPTH_BUFFER_BIT

      ' Select and setup the projection matrix
      glMatrixMode %GL_PROJECTION
      glLoadIdentity

      ' Calculate the aspect ratio of the window
      gluPerspective 45.0!, nWidth/nHeight, 0.1!, 100.0!

      ' Select the modelview matrix
      glMatrixMode %GL_MODELVIEW
      glLoadIdentity

      ' Loop through all the particles
      FOR i = 0 TO %MAX_PARTICLES - 1
         IF particle(i).active THEN           ' If the particle is active
            sx = particle(i).x                ' Grab our particle x position
            sy = particle(i).y                ' Grab our particle y position
            sz = particle(i).z + zoom         ' Particle z pos + zoom

            ' draw the particle using our rgb values, fade the particle based on it's life
            glColor4f particle(i).r, particle(i).g, particle(i).b, particle(i).life
            glBegin %GL_TRIANGLE_STRIP                                ' build quad from a triangle strip
               glTexCoord2d 1, 1 : glVertex3f sx + 0.5!, sy + 0.5!, sz  ' Top right
               glTexCoord2d 0, 1 : glVertex3f sx - 0.5!, sy + 0.5!, sz  ' Top left
               glTexCoord2d 1, 0 : glVertex3f sx + 0.5!, sy - 0.5!, sz  ' Bottom right
               glTexCoord2d 0, 0 : glVertex3f sx - 0.5!, sy - 0.5!, sz  ' Bottom left
            glEnd                                                     ' Done building triangle strip

            particle(i).x = particle(i).x + particle(i).xi / (slowdown * 1000)  ' Move on the x axis by x speed
            particle(i).y = particle(i).y + particle(i).yi / (slowdown * 1000)  ' Move on the y axis by y speed
            particle(i).z = particle(i).z + particle(i).zi / (slowdown * 1000)  ' Move on the z axis by z speed

            particle(i).xi = particle(i).xi + particle(i).xg          ' Take pull on x axis into account
            particle(i).yi = particle(i).yi + particle(i).yg          ' Take pull on y axis into account
            particle(i).zi = particle(i).zi + particle(i).zg          ' Take pull on z axis into account
            particle(i).life = particle(i).life - particle(i).fade    ' Reduce particles life by 'fade'

            IF particle(i).life < 0.0! THEN                           ' If particle is burned out
               particle(i).life = 1.0!                                ' Give it new life
               particle(i).fade = (RND * 100) / 1000.0! + 0.003!  ' Random fade value
               particle(i).x = 0.0!                                   ' Center on x axis
               particle(i).y = 0.0!                                   ' Center on y axis
               particle(i).z = 0.0!                                   ' Center on z axis
               particle(i).xi = xspeed + ((RND * 60) - 32.0!)     ' X axis speed and direction
               particle(i).yi = yspeed + ((RND * 60) - 30.0!)     ' Y axis speed and direction
               particle(i).zi = ((RND * 60) - 30.0!)              ' Z axis speed and direction
               particle(i).r = colors(clr, 0)                         ' Select red from color table
               particle(i).g = colors(clr, 1)                         ' Select green from color table
               particle(i).b = colors(clr, 2)                         ' Select blue from color table
            END IF
         END IF
      NEXT

      ' Swap buffers
      glfwSwapBuffers

      ' Speed up particles
      IF glfwGetKey(%GLFW_KEY_KP_ADD) = %GLFW_PRESS AND slowdown > 1.0! THEN slowdown = slowdown - 0.01!

      ' Slow down particles
      IF glfwGetKey(%GLFW_KEY_KP_SUBTRACT) = %GLFW_PRESS AND slowdown < 4.0! THEN slowdown = slowdown + 0.01!

      ' Zoom in
      IF glfwGetKey(%GLFW_KEY_PAGEUP) THEN zoom = zoom + 0.1!

      ' Zoom out
      IF glfwGetKey(%GLFW_KEY_PAGEDOWN) THEN zoom = zoom - 0.1!

      ' Enter key
      IF glfwGetKey(%GLFW_KEY_ENTER) = %GLFW_PRESS AND ISFALSE rp THEN
         rp = %TRUE
         rainbow = NOT rainbow
      END IF
      IF glfwGetKey(%GLFW_KEY_ENTER) <> %GLFW_PRESS THEN rp = %FALSE

      ' Space or rainbow mode
      IF (glfwGetKey(32) = %GLFW_PRESS AND ISFALSE sp) OR (rainbow AND (delay > 25)) THEN
         IF glfwGetKey(32) = %GLFW_PRESS THEN rainbow = %FALSE   ' Disable rainbow mode
         sp = %TRUE                 ' Set flag telling us space is pressed
         delay = 0                  ' Reset the rainbow color cycling delay
         clr = clr + 1              ' Change the particle color
         IF clr > 11 THEN clr = 0   ' If color is too high, reset it
      END IF
      IF glfwGetKey(32) <> %GLFW_PRESS THEN sp = %FALSE

      ' If up arrow and y speed is less than 200 increase upward speed
      IF glfwGetKey(%GLFW_KEY_UP) = %GLFW_PRESS AND yspeed < 200 THEN yspeed = yspeed + 1.0!
      ' If down arrow and y speed is greater than -200 increase downward speed
      IF glfwGetKey(%GLFW_KEY_DOWN) = %GLFW_PRESS AND yspeed > -200 THEN yspeed = yspeed - 1.0!
      ' If right arrow and x speed is less than 200 increase speed to the right
      IF glfwGetKey(%GLFW_KEY_RIGHT) = %GLFW_PRESS AND xspeed < 200 THEN xspeed = xspeed + 1.0!
      ' If left arrow and x speed is greater than -200 increase speed to the left
      IF glfwGetKey(%GLFW_KEY_LEFT) = %GLFW_PRESS AND xspeed > - 200 THEN xspeed = xspeed - 1.0!

      ' Check if the ESC key was pressed or the window was closed
      running = NOT glfwGetKey(%GLFW_KEY_ESC) AND glfwGetWindowParam(%GLFW_OPENED)

   LOOP

   ' Delete the texture
   glDeleteTextures 1, TextureHandle

   ' Close OpenGL window and terminate GLFW
   glfwTerminate

END FUNCTION
' =======================================================================================