$TYPECHECK ON
$INCLUDE <RapidQ2.inc>
$INCLUDE <GL\QGL.inc>
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