$TYPECHECK ON $INCLUDE $INCLUDE dim debug as qdebug '----------------------------------------------- 'sample HeNe #19,'' This code was created by Jeff Molofee '99 '' ported by JohnK '----------------------------------------------- DECLARE SUB drawGLScene DECLARE Sub MakeQuad DECLARE sub Form_Key_Press(keysym AS Word, KeyShift AS INTEGER) DECLARE sub ResetParticle( byval num as integer, byval clr as integer, byval xDir as single, byval yDir as single, byval zDir as single ) DECLARE sub initfx DECLARE sub sizeit DECLARE sub wipeoff '' Max number of particles CONST MAX_PARTICLES = 250 DEFINT rainbow = TRUE '' Toggle rainbow effect DEFSNG slowdown = -1.0 '' Slow Down Particles DEFSNG xspeed '' Base X Speed (To Allow Keyboard Direction Of Tail) DEFSNG yspeed '' Base Y Speed (To Allow Keyboard Direction Of Tail) DEFSNG zoom = -10.0 '' Used To Zoom Out DEFINT col = 0 '' Current Color Selection DEFINT delay '' Rainbow Effect Delay '' Create our particle structure type particle active as integer '' 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 '' Rainbow of colors DEFSNG colors(0 to 35) = { _ 1.0, 0.5, 0.5, _ 1.0, 0.75, 0.5, _ 1.0, 1.0, 0.5, _ 0.75, 1.0, 0.5, _ 0.5, 1.0, 0.5, _ 0.5, 1.0, 0.75, _ 0.5, 1.0, 1.0, _ 0.5, 0.75, 1.0, _ 0.5, 0.5, 1.0, _ 0.75, 0.5, 1.0, _ 1.0, 0.5, 1.0, _ 1.0, 0.5, 0.75} '' Our beloved array of particles dim particles(0 to MAX_PARTICLES-1) as particle 'create our wrapper DIM GL AS QGL DIM myTexture AS GLuint :myTexture = 0 DIM TheQuad as glInt create tmx as QTimer interval = 1 enabled = 0 onTimer = drawGLScene end create ' user interface create fx as QFORM caption = "RQGL Demo" top = 16 left = 26 width = 640 height = 480 onPaint = drawGLScene onResize = sizeit onClick = wipeoff onKeyDown = Form_Key_Press onShow = initfx end create ' main program fx.ShowModal end 'user procedures sub initfx DIM clr as integer DIM i as integer dim xi as single , yi as single , zi as single GL.Init(fx) '' Load The Bitmap, Check For Errors, If Bitmap's Not Found Quit myTexture = GL.CreateTextureFromFile("particle.bmp") IF myTexture = 0 THEN Showmessage "failed texture": fx.Close GL.Front = .1 GL.Back = 200 '' Enable smooth shading glShadeModel( GL_SMOOTH ) '' Set the background black glClearColor( 0.2, 0.2, 0.2, 0.0 ) '' Depth buffer setup glClearDepth( 1.0 ) '' Enables 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 Mapping glEnable( GL_TEXTURE_2D ) '' Select Our Texture ' glBindTexture( GL_TEXTURE_2D, myTexture ) '' Reset all the particles for i = 0 to MAX_PARTICLES-1 clr = ( i + 1 ) \ ( MAX_PARTICLES \ 12 ) xi = ( ( rnd * 50 ) - 26.0 ) * 10.0 yi = ( ( rnd * 50 ) - 25.0 ) * 10.0 zi = yi ResetParticle( i, clr, xi, yi, zi ) next i MakeQuad tmx.enabled = true end sub sub sizeit GL.Resize(fx.clientWidth, fx.clientHeight) glMatrixMode( GL_MODELVIEW ) '' Reset The View glLoadIdentity end sub sub wipeoff '' Clean up our textures glDeleteTextures( 1, myTexture) GL.Close fx.close end sub '' function to reset one particle to initial state '' NOTE: I added this function to replace doing the same thing in several '' places and to also make it easy to move the pressing of numpad keys '' 2, 4, 6, and 8 into handleKeyPress function. sub ResetParticle( byval num as integer, byval clr as integer, byval xDir as single, byval yDir as single, byval zDir as single ) '' Make the particels active particles(num).active = TRUE '' Give the particles life particles(num).life = 1.0 '' Random Fade Speed particles(num).fade = ( rnd * 100 ) / 1000.0 + 0.003 '' Select Red Rainbow Color particles(num).r = colors(clr * 3 + 0) '' Select Green Rainbow Color particles(num).g = colors(clr * 3 + 1) '' Select Blue Rainbow Color particles(num).b = colors(clr * 3+ 2) '' Set the position on the X axis particles(num).x = 0.0 '' Set the position on the Y axis particles(num).y = 0.0 '' Set the position on the Z axis particles(num).z = 0.0 '' Random Speed On X Axis particles(num).xi = xDir '' Random Speed On Y Axi particles(num).yi = yDir '' Random Speed On Z Axis particles(num).zi = zDir '' Set Horizontal Pull To Zero particles(num).xg = 0.0 '' Set Vertical Pull Downward particles(num).yg = -0.8 '' Set Pull On Z Axis To Zero particles(num).zg = 0.0 end sub '' function to handle key press events sub Form_Key_Press(keysym AS Word, KeyShift AS INTEGER) dim i as integer 'showmessage str$(keysym) select case keysym case 27 '' ESC key was pressed wipeoff case 112 '' F1 key toggles fullscreen mode IF GL.FullScreen = False THEN fx.BorderStyle = bsNone fx.top=0: fx.Left = 0 SizeIt GL.FullScreen = True ELSE fx.BorderStyle = bsSizeable fx.top=10: fx.Left = 10 GL.FullScreen = False END IF case 187 '' + speeds up the particles if ( slowdown > 1.0 ) then slowdown -= 0.1 case 189 '' - slows down the particles if ( slowdown < 4.0 ) then slowdown += 0.1 case 33 '' PageUp key was pressed '' this zooms into the scene zoom = zoom + 0.5 case 34 '' this zooms out of the scene zoom = zoom -0.5 case 38 '' up arrow increases the particles' y movement if ( yspeed < 200.0 ) then _ yspeed += 4 case 40 '' dn arrow decreases the particles' y movement if ( yspeed > -200.0 ) then _ yspeed -= 4 case 39 '' Right arrow key was pressed '' this increases the particles' x movement if ( xspeed < 200.0 ) then _ xspeed += 4 case 37 '' Left arrow key was pressed '' this decreases the particles' x movement if ( xspeed > -200.0 ) then _ xspeed -= 4 case 71 '' 'g' increase particles' y gravity for i = 0 to MAX_PARTICLES-1 if ( particles(i).yg < 1.5 ) then particles(i).yg = particles(i).yg +0.5 next i case 89 '' y decreases the particles' y gravity for i = 0 to MAX_PARTICLES-1 if ( particles(i).xg > -1.5 ) then particles(i).xg = particles(i).xg -0.5 next i case 88 '' x increases the particles' x gravity for i = 0 to MAX_PARTICLES-1 if ( particles(i).xg < 1.5 ) then particles(i).xg = particles(i).xg + 0.5 next i case 13 '' Return key was pressed '' this toggles the rainbow color effect rainbow = not rainbow delay = 5 case 32 '' Spacebar was pressed '' this turns off rainbow-ing and manually cycles through colors rainbow = FALSE delay = 0 col = ( col + 1 ) mod 12 end select IF KeyShift THEN '' Tab key was pressed '' this resets the particles and makes them re-explode for i = 0 to MAX_PARTICLES-1 DEFINT clr = ( i + 1 ) \ ( MAX_PARTICLES \ 12 ) DEFSNG xi, yi, zi xi = ( ( rnd * 50 ) - 26.0 ) * 10.0 yi = ( ( rnd * 50 ) - 25.0 ) * 10.0 zi = yi ResetParticle( i, clr, xi, yi, zi ) next i END IF end sub '' Here goes our drawing code SUB drawGLScene dim i as integer dim x as single , y as single , z as single dim xi as single , yi as single , zi as single '' Clear The Screen And The Depth Buffer glClear( GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT ) glLoadIdentity '' Modify each of the particles for i = 0 to MAX_PARTICLES-1 if ( particles(i).active ) then x = particles(i).x ' Grab Our Particle X Position y = particles(i).y ' Grab Our Particle Y Position z = particles(i).z + zoom ' Particle Z Position + Zoom '' Draw The Particle Using Our RGB Values, '' Fade The Particle Based On It's Life glColor4f( particles(i).r, _ particles(i).g, _ particles(i).b, _ particles(i).life ) glLoadIdentity glTranslatef(x, y, z) glCallList(theQuad) '' Move On The X Axis By X Speed particles(i).x = particles(i).x + particles(i).xi / ( slowdown * 1000 ) '' Move On The Y Axis By Y Speed particles(i).y = particles(i).y + particles(i).yi / ( slowdown * 1000 ) '' Move On The Z Axis By Z Speed particles(i).z = particles(i).z + particles(i).zi / ( slowdown * 1000 ) '' Take Pull On X Axis Into Account particles(i).xi = particles(i).xi + particles(i).xg '' Take Pull On Y Axis Into Account particles(i).yi = particles(i).yi + particles(i).yg '' Take Pull On Z Axis Into Account particles(i).zi = particles(i).zi + particles(i).zg '' Reduce Particles Life By 'Fade' particles(i).life = particles(i).life - particles(i).fade '' If the particle dies, revive it if ( particles(i).life < 0.0 ) then xi = xspeed + ( ( rnd * 60 ) - 32.0 ) yi = yspeed + ( ( rnd * 60 ) - 30.0 ) zi = ( ( rnd * 60 ) - 30.0 ) ResetParticle( i, col, xi, yi, zi ) end if end if next i '' Draw it to the screen GL.Flip '' Gather our frames per second fx.Caption = "Frame Rate = " + str$(GL.FrameRate) END SUB Sub MakeQuad TheQuad = glGenLists( 1 ) glNewList( TheQuad, GL_COMPILE) '' Build Quad From A Triangle Strip glBegin( GL_TRIANGLE_STRIP ) '' Top Right glTexCoord2d( 1, 1 ) glVertex3f( 0.5, + 0.5, -10 ) '' Top Left glTexCoord2d( 0, 1 ) glVertex3f( -0.5, + 0.5, -10 ) '' Bottom Right glTexCoord2d( 1, 0 ) glVertex3f( 0.5, - 0.5, -10 ) '' Bottom Left glTexCoord2d( 0, 0 ) glVertex3f( -0.5, - 0.5, -10 ) glEnd glEndList end sub