### Author Topic: NeHe Lesson 19: Particle Engine Using Triangle Strips  (Read 4852 times)

0 Members and 1 Guest are viewing this topic.

#### José Roca

• Hero Member
• Posts: 2524
• User-Rate: +209/-0
• Gender:
##### NeHe Lesson 19: Particle Engine Using Triangle Strips
« on: July 25, 2008, 08:08:49 PM »

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]
`' 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 createTYPE 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 GravityEND TYPEGLOBAL hDC AS LONG             ' Device context handleGLOBAL TextureHandle AS DWORD  ' Texture handleGLOBAL rainbow AS LONG         ' Rainbow mode?GLOBAL slowdown AS SINGLE      ' Slow down particlesGLOBAL 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 outGLOBAL clr AS DWORD            ' Current color selectionGLOBAL delay AS DWORD          ' Rainbow effec delayGLOBAL sp AS LONGGLOBAL particle() AS particlesGLOBAL 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   NEXTEND 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   glLoadIdentityEND 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 IFEND 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 SELECTEND 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.wParamEND 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' =======================================================================================`

« Last Edit: August 07, 2011, 08:10:18 PM by José Roca »

#### José Roca

• Hero Member
• Posts: 2524
• User-Rate: +209/-0
• Gender:
##### Re: NeHe Lesson 19: Particle Engine Using Triangle Strips [SDL version]
« Reply #1 on: July 27, 2008, 08:27:17 PM »
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]
`' 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 createTYPE 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 GravityEND TYPEGLOBAL hDC AS LONG             ' Device context handleGLOBAL TextureHandle AS DWORD  ' Texture handleGLOBAL rainbow AS LONG         ' Rainbow mode?GLOBAL slowdown AS SINGLE      ' Slow down particlesGLOBAL 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 outGLOBAL clr AS DWORD            ' Current color selectionGLOBAL delay AS DWORD          ' Rainbow effec delayGLOBAL sp AS LONGGLOBAL particle() AS particlesGLOBAL 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   NEXTEND 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_SwapBuffersEND 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_QuitEND FUNCTION' =======================================================================================`
« Last Edit: August 07, 2011, 08:20:26 PM by José Roca »

#### José Roca

• Hero Member
• Posts: 2524
• User-Rate: +209/-0
• Gender:
##### Re: NeHe Lesson 19: Particle Engine Using Triangle Strips [GLFW Version]
« Reply #2 on: September 16, 2008, 01:52:13 AM »

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]
`' 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 createTYPE 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 GravityEND 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   glfwTerminateEND FUNCTION' =======================================================================================`
« Last Edit: August 07, 2011, 08:30:52 PM by José Roca »