Press the Arrows to move camera, Numpad +/- for ball speed, F2 for hook to ball, F3 for sound.
You can get the "Marble.bmp", "Spark.bmp", "Boden.bmp", "Wand.bmp", "Explode.wav" from the "lesson30.zip" here:
http://nehe.gamedev.net/data/lessons/le ... ?lesson=30
Code: Select all
;NeHe's Collision Detection Tutorial (Lesson 30)
;http://nehe.gamedev.net
;Credits: Nico Gruener, Dreglor, traumatic
;Author: hagibaba
;Date: 23 Feb 2007
;Note: up-to-date with PB v4.02 (Windows)
;Note: requires bitmaps in paths "Data/Marble.bmp", "Data/Spark.bmp",
;"Data/Boden.bmp", "Data/Wand.bmp"
;Note: requires a wave file in path "Data/Explode.wav"
;Section for standard constants, structures, macros and declarations
XIncludeFile "OpenGL.pbi" ;include the gl.h constants
;wingdi.h constants
#DM_BITSPERPEL=$40000
#DM_PELSWIDTH=$80000
#DM_PELSHEIGHT=$100000
;winuser.h constants
#ENUM_CURRENT_SETTINGS=-1
#CDS_TEST=2
#CDS_FULLSCREEN=4
#CDS_RESET=$40000000
#DISP_CHANGE_SUCCESSFUL=0
#SC_MONITORPOWER=$F170
Procedure.w LoWord(value.l) ;windef.h macro
ProcedureReturn (value & $FFFF)
EndProcedure
Procedure.w HiWord(value.l) ;windef.h macro
ProcedureReturn ((value >> 16) & $FFFF)
EndProcedure
Import "glu32.lib"
gluCylinder(*qobj,baseRadius.d,topRadius.d,height.d,slices.l,stacks.l) ;draws a cylinder
gluLookAt(eyex.d,eyey.d,eyez.d,centerx.d,centery.d,centerz.d,upx.d,upy.d,upz.d) ;defines a viewing transformation
gluPerspective(fovy.d,aspect.d,zNear.d,zFar.d) ;sets up a perspective projection matrix
gluSphere(*qobj,radius.d,slices.l,stacks.l) ;draws a sphere
EndImport
Import "opengl32.lib"
glClearDepth(depth.d) ;specifies the clear value for the depth buffer
glTranslated(x.d,y.d,z.d) ;moves the current matrix to the point specified
EndImport
;Start of Lesson 30
XIncludeFile "Collisions.pb" ;Include File For Collisions
Structure IMAGE ;Image Type - Contains Height, Width and Data
sizeX.l
sizeY.l
Data.l
EndStructure
Global hDC.l ;Private GDI Device Context
Global hRC.l ;Permanent Rendering Context
Global hWnd.l ;Holds Our Window Handle
Global hInstance.l ;Holds The Instance Of The Application
Global DMsaved.DEVMODE ;Saves The Previous Screen Settings
Global Dim keys.b(256) ;Array Used For The Keyboard Routine
Global active.b=#True ;Window Active Flag Set To TRUE By Default
Global fullscreen.b=#True ;Fullscreen Flag Set To Fullscreen Mode By Default
Global Dim spec.f(4) ;Sets Specular Highlight Of Balls
spec(0)=1.0 : spec(1)=1.0 : spec(2)=1.0 : spec(3)=1.0
Global Dim posl.f(4) ;Position Of Light Source
posl(0)=0 : posl(1)=400 : posl(2)=0 : posl(3)=1
Global Dim amb.f(4) ;Global Ambient
amb(0)=0.2 : amb(1)=0.2 : amb(2)=0.2 : amb(3)=1.0
Global Dim amb2.f(4) ;Ambient Of Light Source
amb2(0)=0.3 : amb2(1)=0.3 : amb2(2)=0.3 : amb2(3)=1.0
Global dir.TVECTOR ;Initial Direction Of Camera
TVector_make(dir,0,0,-10)
Global pos.TVECTOR ;Initial Position Of Camera
TVector_make(pos,0,-50,1000)
Global camera_rotation.f=0 ;Holds Rotation Around The Y Axis
Global veloc.TVECTOR ;Initial Velocity Of Balls
TVector_make(veloc,0.5,-0.1,0.5)
Global accel.TVECTOR ;Acceleration ie. Gravity Of Balls
TVector_make(accel,0,-0.05,0)
Global Dim ArrayVel.TVECTOR(10) ;Holds Velocity Of Balls
Global Dim ArrayPos.TVECTOR(10) ;Position Of Balls
Global Dim OldPos.TVECTOR(10) ;Old Position Of Balls
Global NrOfBalls.l ;Sets The Number Of Balls
Global Time.d=0.6 ;Timestep Of Simulation
Global hook_toball1.l=0 ;Hook Camera to Ball
Global sounds.l=1 ;Sound On/Off
Structure PLANE ;Plane Structure
_Position.TVECTOR
_Normal.TVECTOR
EndStructure
Structure CYLINDER ;Cylinder Structure
_Position.TVECTOR
_Axis.TVECTOR
_Radius.d
EndStructure
Structure EXPLOSION ;Explosion Structure
_Position.TVECTOR
_Alpha.f
_Scale.f
EndStructure
Global pl1.PLANE,pl2.PLANE,pl3.PLANE,pl4.PLANE,pl5.PLANE ;The 5 Planes Of The Room
Global cyl1.CYLINDER,cyl2.CYLINDER,cyl3.CYLINDER ;The 3 Cylinders Of The Room
Global Dim ExplosionArray.EXPLOSION(20) ;Holds Max 20 Explosions At Once
Global cylinder_obj.l ;Quadratic Object To Render The Cylinders
Global Dim texture.l(4) ;Stores Texture Objects
Global dlist.l ;Stores Display List
Declare.l WndProc(hWnd.l,uMsg.l,wParam.l,lParam.l) ;Declaration For WndProc
;Quick And Dirty Bitmap Loader, For 24 Bit Bitmaps With 1 Plane Only
;See http://www.dcs.ed.ac.uk/~mxr/gfx/2d/BMP.txt For More Info
Procedure.l ImageLoad(filename.s,*image.IMAGE)
Protected file.l
Protected size.l ;Size Of The Image In Bytes
Protected i.l ;Standard Counter
Protected planes.w ;Number Of Planes In Image (Must Be 1)
Protected bpp.w ;Number Of Bits Per Pixel (Must Be 24)
Protected temp.b ;Temporary Color Storage For bgr-rgb Conversion
file=ReadFile(#PB_Any,filename)
If file=#Null ;Make Sure The File Is There
MessageBox_(#Null,"File Not Found: "+filename,"IMAGE ERROR",#MB_OK | #MB_ICONINFORMATION)
ProcedureReturn 0
EndIf
FileSeek(file,18) ;Seek Through The Bmp Header, Up To The Width/Height
*image\sizeX=ReadLong(file) ;Read The Width
*image\sizeY=ReadLong(file) ;Read The Height
;Calculate The Size (Assuming 24 Bits Or 3 Bytes Per Pixel)
size=*image\sizeX**image\sizeY*3
planes=ReadWord(file) ;Read The Planes
If planes<>1
MessageBox_(#Null,"Planes from "+filename+" is Not 1: "+Str(planes),"IMAGE ERROR",#MB_OK | #MB_ICONINFORMATION)
ProcedureReturn 0
EndIf
bpp=ReadWord(file) ;Read The Bpp
If bpp<>24
MessageBox_(#Null,"Bpp from "+filename+" is Not 24: "+Str(bpp),"IMAGE ERROR",#MB_OK | #MB_ICONINFORMATION)
ProcedureReturn 0
EndIf
FileSeek(file,54) ;Seek Past The Rest Of The Bitmap Header
*image\Data=AllocateMemory(size)
If *image\Data=#Null
MessageBox_(#Null,"Error allocating memory for image data","IMAGE ERROR",#MB_OK | #MB_ICONINFORMATION)
ProcedureReturn 0
EndIf
If ReadData(file,*image\Data,size)<>size ;Read The Data
MessageBox_(#Null,"Error reading image data from "+filename,"IMAGE ERROR",#MB_OK | #MB_ICONINFORMATION)
ProcedureReturn 0
EndIf
For i=0 To size-1 Step 3 ;Reverse All Of The Colors (bgr -> rgb)
temp=PeekB(*image\Data+i)
PokeB(*image\Data+i,PeekB(*image\Data+i+2))
PokeB(*image\Data+i+2,temp)
Next
ProcedureReturn 1 ;We're Done
EndProcedure
Procedure LoadGLTextures() ;Load Bitmaps And Convert To Textures
Protected image1.IMAGE,image2.IMAGE,image3.IMAGE,image4.IMAGE
;Load Textures
If ImageLoad("Data/Marble.bmp",image1)=0
ProcedureReturn 0
EndIf
If ImageLoad("Data/Spark.bmp",image2)=0
ProcedureReturn 0
EndIf
If ImageLoad("Data/Boden.bmp",image3)=0
ProcedureReturn 0
EndIf
If ImageLoad("Data/Wand.bmp",image4)=0
ProcedureReturn 0
EndIf
glGenTextures_(2,@texture(0))
;Create Texture 1
glBindTexture_(#GL_TEXTURE_2D,texture(0)) ;2d texture (x and y size)
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_MAG_FILTER,#GL_LINEAR) ;Scale linearly when image bigger than texture
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_MIN_FILTER,#GL_LINEAR) ;Scale linearly when image smaller than texture
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_WRAP_S,#GL_REPEAT)
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_WRAP_T,#GL_REPEAT)
;2d texture, level of detail 0 (normal), 3 components (red, green, blue), x size from image, y size from image,
;border 0 (normal), rgb color data, unsigned byte data, and finally the data itself.
glTexImage2D_(#GL_TEXTURE_2D,0,3,image1\sizeX,image1\sizeY,0,#GL_RGB,#GL_UNSIGNED_BYTE,image1\Data)
;Create Texture 2
glBindTexture_(#GL_TEXTURE_2D,texture(1))
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_MAG_FILTER,#GL_LINEAR)
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_MIN_FILTER,#GL_LINEAR)
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_WRAP_S,#GL_REPEAT)
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_WRAP_T,#GL_REPEAT)
glTexImage2D_(#GL_TEXTURE_2D,0,3,image2\sizeX,image2\sizeY,0,#GL_RGB,#GL_UNSIGNED_BYTE,image2\Data)
glGenTextures_(2,@texture(2))
;Create Texture 3
glBindTexture_(#GL_TEXTURE_2D,texture(2))
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_MAG_FILTER,#GL_LINEAR)
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_MIN_FILTER,#GL_LINEAR)
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_WRAP_S,#GL_REPEAT)
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_WRAP_T,#GL_REPEAT)
glTexImage2D_(#GL_TEXTURE_2D,0,3,image3\sizeX,image3\sizeY,0,#GL_RGB,#GL_UNSIGNED_BYTE,image3\Data)
;Create Texture 4
glBindTexture_(#GL_TEXTURE_2D,texture(3))
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_MAG_FILTER,#GL_LINEAR)
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_MIN_FILTER,#GL_LINEAR)
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_WRAP_S,#GL_REPEAT)
glTexParameteri_(#GL_TEXTURE_2D,#GL_TEXTURE_WRAP_T,#GL_REPEAT)
glTexImage2D_(#GL_TEXTURE_2D,0,3,image4\sizeX,image4\sizeY,0,#GL_RGB,#GL_UNSIGNED_BYTE,image4\Data)
FreeMemory(image1\Data)
FreeMemory(image2\Data)
FreeMemory(image3\Data)
FreeMemory(image4\Data)
EndProcedure
Procedure ReSizeGLScene(width.l,height.l) ;Resize And Initialize The GL Window
If height=0 : height=1 : EndIf ;Prevent A Divide By Zero Error
glViewport_(0,0,width,height) ;Reset The Current Viewport
glMatrixMode_(#GL_PROJECTION) ;Select The Projection Matrix
glLoadIdentity_() ;Reset The Projection Matrix
gluPerspective(45.0,Abs(width/height),10.0,1700.0) ;Calculate The Aspect Ratio Of The Window
glMatrixMode_(#GL_MODELVIEW) ;Select The Modelview Matrix
glLoadIdentity_() ;Reset The Modelview Matrix
EndProcedure
Procedure InitVars()
;Create Planes
TVector_make(pl1\_Position,0,-300,0)
TVector_make(pl1\_Normal,0,1,0)
TVector_make(pl2\_Position,300,0,0)
TVector_make(pl2\_Normal,-1,0,0)
TVector_make(pl3\_Position,-300,0,0)
TVector_make(pl3\_Normal,1,0,0)
TVector_make(pl4\_Position,0,0,300)
TVector_make(pl4\_Normal,0,0,-1)
TVector_make(pl5\_Position,0,0,-300)
TVector_make(pl5\_Normal,0,0,1)
;Create Cylinders
TVector_make(cyl1\_Position,0,0,0)
TVector_make(cyl1\_Axis,0,1,0)
cyl1\_Radius=60+20
TVector_make(cyl2\_Position,200,-300,0)
TVector_make(cyl2\_Axis,0,0,1)
cyl2\_Radius=60+20
TVector_make(cyl3\_Position,-200,0,0)
TVector_make(cyl3\_Axis,0,1,1)
TVector_unit(cyl3\_Axis)
cyl3\_Radius=30+20
;Create Quadratic Object To Render Cylinders
cylinder_obj=gluNewQuadric_()
gluQuadricTexture_(cylinder_obj,#GL_TRUE)
;Set Initial Positions And Velocities Of Balls
;Also Initialize Array Which Holds Explosions
NrOfBalls=10
TVector_set(ArrayVel(0),veloc)
TVector_make(ArrayPos(0),199,180,10)
ExplosionArray(0)\_Alpha=0
ExplosionArray(0)\_Scale=1
TVector_set(ArrayVel(1),veloc)
TVector_make(ArrayPos(1),0,150,100)
ExplosionArray(1)\_Alpha=0
ExplosionArray(1)\_Scale=1
TVector_set(ArrayVel(2),veloc)
TVector_make(ArrayPos(2),-100,180,-100)
ExplosionArray(2)\_Alpha=0
ExplosionArray(2)\_Scale=1
Protected i.l
For i=3 To 10-1
TVector_set(ArrayVel(i),veloc)
TVector_make(ArrayPos(i),-500+i*75,300,-500+i*50)
ExplosionArray(i)\_Alpha=0
ExplosionArray(i)\_Scale=1
Next
For i=10 To 20-1
ExplosionArray(i)\_Alpha=0
ExplosionArray(i)\_Scale=1
Next
EndProcedure
Procedure.l InitGL() ;All Setup For OpenGL Goes Here
Protected df.f=100.0 ;Material Shininess
glClearDepth(1.0) ;Depth Buffer Setup
glEnable_(#GL_DEPTH_TEST) ;Enables Depth Testing
glDepthFunc_(#GL_LEQUAL) ;The Type Of Depth Testing To Do
glHint_(#GL_PERSPECTIVE_CORRECTION_HINT,#GL_NICEST) ;Really Nice Perspective Calculations
glClearColor_(0.0,0.0,0.0,0.0) ;Black Background
glMatrixMode_(#GL_MODELVIEW) ;Select The Modelview Matrix
glLoadIdentity_() ;Reset The Modelview Matrix
glShadeModel_(#GL_SMOOTH) ;Enable Smooth Shading
glEnable_(#GL_CULL_FACE) ;Enable Culling
glEnable_(#GL_DEPTH_TEST) ;Enable Depth Testing
glMaterialfv_(#GL_FRONT,#GL_SPECULAR,spec()) ;Set Material Specular
glMaterialfv_(#GL_FRONT,#GL_SHININESS,@df) ;Set Material Shininess
glEnable_(#GL_LIGHTING) ;Enable Lighting
glLightfv_(#GL_LIGHT0,#GL_POSITION,posl()) ;Position The Light
glLightfv_(#GL_LIGHT0,#GL_AMBIENT,amb2()) ;Setup The Ambient Light
glEnable_(#GL_LIGHT0) ;Enable Light One
glLightModelfv_(#GL_LIGHT_MODEL_AMBIENT,amb()) ;Ambient Model Lighting
glEnable_(#GL_COLOR_MATERIAL) ;Enable Material Coloring
glColorMaterial_(#GL_FRONT,#GL_AMBIENT_AND_DIFFUSE)
glEnable_(#GL_BLEND) ;Enable Blending
glBlendFunc_(#GL_SRC_ALPHA,#GL_ONE) ;Select The Type Of Blending
glEnable_(#GL_TEXTURE_2D) ;Enable Texture Mapping
LoadGLTextures()
;Construct Billboarded Explosion Primitive As Display List
;4 Quads At Right Angles To Each Other
dlist=glGenLists_(1)
glNewList_(dlist,#GL_COMPILE)
glBegin_(#GL_QUADS)
glRotatef_(-45.0,0.0,1.0,0.0) ;Rotate On The Y Axis By 45
glNormal3f_(0.0,0.0,1.0) ;Front Face
glTexCoord2f_(0.0, 0.0) : glVertex3f_(-50.0,-40.0, 0.0)
glTexCoord2f_(0.0, 1.0) : glVertex3f_( 50.0,-40.0, 0.0)
glTexCoord2f_(1.0, 1.0) : glVertex3f_( 50.0, 40.0, 0.0)
glTexCoord2f_(1.0, 0.0) : glVertex3f_(-50.0, 40.0, 0.0)
glNormal3f_(0.0,0.0,-1.0) ;Back Face
glTexCoord2f_(0.0, 0.0) : glVertex3f_(-50.0, 40.0, 0.0)
glTexCoord2f_(0.0, 1.0) : glVertex3f_( 50.0, 40.0, 0.0)
glTexCoord2f_(1.0, 1.0) : glVertex3f_( 50.0,-40.0, 0.0)
glTexCoord2f_(1.0, 0.0) : glVertex3f_(-50.0,-40.0, 0.0)
glNormal3f_(1.0,0.0,0.0) ;Right Face
glTexCoord2f_(0.0, 0.0) : glVertex3f_( 0.0,-40.0, 50.0)
glTexCoord2f_(0.0, 1.0) : glVertex3f_( 0.0,-40.0,-50.0)
glTexCoord2f_(1.0, 1.0) : glVertex3f_( 0.0, 40.0,-50.0)
glTexCoord2f_(1.0, 0.0) : glVertex3f_( 0.0, 40.0, 50.0)
glNormal3f_(-1.0,0.0,0.0) ;Left Face
glTexCoord2f_(0.0, 0.0) : glVertex3f_( 0.0, 40.0, 50.0)
glTexCoord2f_(0.0, 1.0) : glVertex3f_( 0.0, 40.0,-50.0)
glTexCoord2f_(1.0, 1.0) : glVertex3f_( 0.0,-40.0,-50.0)
glTexCoord2f_(1.0, 0.0) : glVertex3f_( 0.0,-40.0, 50.0)
glEnd_()
glEndList_()
ProcedureReturn #True ;Initialization Went OK
EndProcedure
;Fast Intersection Function Between Ray / Plane
Procedure.l TestIntersionPlane(*plane.PLANE,*position.TVECTOR,*direction.TVECTOR,*lamda.DOUBLE,*pNormal.TVECTOR)
Protected DotProduct.d,l2.d
Protected result.TVECTOR
DotProduct=TVector_dot(*direction,*plane\_Normal) ;Dot Product Between Plane Normal And Ray Direction
;Determine If Ray Parallel To Plane
If DotProduct<#ZERO And DotProduct>-#ZERO
ProcedureReturn 0
EndIf
TVector_subtract(result,*plane\_Position,*position) ;result=plane\_Position-position
l2=TVector_dot(*plane\_Normal,result)/DotProduct ;Find Distance To Collision Point
If l2<-#ZERO ;Test If Collision Behind Start
ProcedureReturn 0
EndIf
TVector_set(*pNormal,*plane\_Normal) ;pNormal=plane\_Normal
*lamda\d=l2
ProcedureReturn 1
EndProcedure
;Fast Intersection Function Between Ray / Cylinder
Procedure.l TestIntersionCylinder(*cylinder.CYLINDER,*position.TVECTOR,*direction.TVECTOR,*lamda.DOUBLE,*pNormal.TVECTOR,*newposition.TVECTOR)
Protected d.d,t.d,s.d,ln.d,in.d,out.d
Protected RC.TVECTOR,NV.TVECTOR,OV.TVECTOR,HB.TVECTOR
TVector_subtract(RC,*position,*cylinder\_Position)
TVector_cross(NV,*direction,*cylinder\_Axis)
ln=TVector_mag(NV)
If ln<#ZERO And ln>-#ZERO
ProcedureReturn 0
EndIf
TVector_unit(NV)
d=Abs(TVector_dot(RC,NV))
If d<=*cylinder\_Radius
TVector_cross(OV,RC,*cylinder\_Axis)
t=-TVector_dot(OV,NV)/ln
TVector_cross(OV,NV,*cylinder\_Axis)
TVector_unit(OV)
s=Abs(Sqr(*cylinder\_Radius**cylinder\_Radius-d*d)/TVector_dot(*direction,OV))
in=t-s
out=t+s
If in<-#ZERO
If out<-#ZERO
ProcedureReturn 0
Else
*lamda\d=out
EndIf
Else
If out<-#ZERO
*lamda\d=in
Else
If in<out
*lamda\d=in
Else
*lamda\d=out
EndIf
EndIf
EndIf
TVector_add(*newposition,*position,TVector_multiply(*newposition,*direction,*lamda\d)) ;newposition=position+(direction*lamda)
TVector_subtract(HB,*newposition,*cylinder\_Position) ;HB=newposition-cylinder\_Position
TVector_subtract(*pNormal,HB,TVector_multiply(*pNormal,*cylinder\_Axis,TVector_dot(HB,*cylinder\_Axis))) ;pNormal=HB-cylinder\_Axis*(HB.dot(cylinder\_Axis))
TVector_unit(*pNormal)
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure
;Find If Any Of The Current Balls Intersect With Eachother In The Current Timestep
;Returns The Index Of The 2 Intersecting Balls, The Point And Time Of Intersection
Procedure.l FindBallCol(*point.TVECTOR,*TimePoint.DOUBLE,Time2.d,*BallNr1.LONG,*BallNr2.LONG)
Protected RelativeV.TVECTOR,posi.TVECTOR
Protected rays.TRAY
Protected MyTime.d=0.0,Add.d=Time2/150.0
Protected Timedummy.d=10000,Timedummy2.d=-1
Protected i.l,j.l
;Test All Balls Against Eachother In 150 Small Steps
For i=0 To (NrOfBalls-1)-1
For j=i+1 To NrOfBalls-1
TVector_subtract(RelativeV,ArrayVel(i),ArrayVel(j)) ;Find Distance
TRay_setunit(rays,OldPos(i),TVector_unit(RelativeV))
MyTime=0.0
If TRay_pointdist(rays,OldPos(j))>40 ;If Distance Between Centers Greater Than 2*radius
Continue ;No Intersection Occurred
EndIf
While MyTime<Time2 ;Loop To Find The Exact Intersection Point
MyTime+Add
TVector_add(posi,OldPos(i),TVector_multiply(posi,RelativeV,MyTime)) ;posi=OldPos(i)+(RelativeV*MyTime)
If TVector_dist(posi,OldPos(j))<=40
TVector_set(*point,posi) ;point=posi
If Timedummy>MyTime-Add And MyTime-Add<>0 ;Note: added zero check
Timedummy=MyTime-Add
EndIf
*BallNr1\l=i
*BallNr2\l=j
Break
EndIf
Wend
Next
Next
If Timedummy<>10000
*TimePoint\d=Timedummy
ProcedureReturn 1
EndIf
ProcedureReturn 0
EndProcedure
;Moves, Finds The Collisions And Responses Of The Objects In The Current Time Step
Procedure idle() ;Main Loop Of The Simulation
Protected rt.d,rt2.d,rt4.d,lamda.d=10000
Protected norm.TVECTOR,uveloc.TVECTOR
Protected normal.TVECTOR,point.TVECTOR
Protected RestTime.d,BallTime.d
Protected Pos2.TVECTOR,Nc.TVECTOR,tv.TVECTOR
Protected BallNr.l=0,BallColNr1.l,BallColNr2.l
Protected i.l,j.l
If hook_toball1=0
camera_rotation+0.1
If camera_rotation>360
camera_rotation=0
EndIf
EndIf
RestTime=Time
lamda=1000
;Compute Velocity For Next Timestep Using Euler Equations
For j=0 To NrOfBalls-1
TVector_add(ArrayVel(j),ArrayVel(j),TVector_multiply(tv,accel,RestTime)) ;ArrayVel(j)+=accel*RestTime
Next
;While Time Step Not Over
While RestTime>#ZERO
lamda=10000 ;Initialize To Very Large Value
;For All The Balls Find Closest Intersection Between Balls And Planes / Cylinders
For i=0 To NrOfBalls-1
;Compute New Position And Distance
TVector_set(OldPos(i),ArrayPos(i))
TVector_setunit(uveloc,ArrayVel(i))
TVector_add(ArrayPos(i),ArrayPos(i),TVector_multiply(tv,ArrayVel(i),RestTime)) ;ArrayPos(i)+=ArrayVel(i)*RestTime
rt2=TVector_dist(OldPos(i),ArrayPos(i))
;Test If Collision Occured Between Ball And All 5 Planes
If TestIntersionPlane(pl1,OldPos(i),uveloc,@rt,norm)
rt4=rt*RestTime/rt2 ;Find Intersection Time
If rt4<=lamda ;If Smaller Than The One Already Stored Replace In Timestep
;If Intersection Time In Current Time Step
If rt4<=RestTime+#ZERO
If Not (rt<=#ZERO And TVector_dot(uveloc,norm)>#ZERO)
TVector_set(normal,norm)
TVector_add(point,OldPos(i),TVector_multiply(tv,uveloc,rt)) ;point=OldPos(i)+(uveloc*rt)
lamda=rt4
BallNr=i
EndIf
EndIf
EndIf
EndIf
If TestIntersionPlane(pl2,OldPos(i),uveloc,@rt,norm)
rt4=rt*RestTime/rt2
If rt4<=lamda
If rt4<=RestTime+#ZERO
If Not (rt<=#ZERO And TVector_dot(uveloc,norm)>#ZERO)
TVector_set(normal,norm)
TVector_add(point,OldPos(i),TVector_multiply(tv,uveloc,rt)) ;point=OldPos(i)+(uveloc*rt)
lamda=rt4
BallNr=i
EndIf
EndIf
EndIf
EndIf
If TestIntersionPlane(pl3,OldPos(i),uveloc,@rt,norm)
rt4=rt*RestTime/rt2
If rt4<=lamda
If rt4<=RestTime+#ZERO
If Not (rt<=#ZERO And TVector_dot(uveloc,norm)>#ZERO)
TVector_set(normal,norm)
TVector_add(point,OldPos(i),TVector_multiply(tv,uveloc,rt)) ;point=OldPos(i)+(uveloc*rt)
lamda=rt4
BallNr=i
EndIf
EndIf
EndIf
EndIf
If TestIntersionPlane(pl4,OldPos(i),uveloc,@rt,norm)
rt4=rt*RestTime/rt2
If rt4<=lamda
If rt4<=RestTime+#ZERO
If Not (rt<=#ZERO And TVector_dot(uveloc,norm)>#ZERO)
TVector_set(normal,norm)
TVector_add(point,OldPos(i),TVector_multiply(tv,uveloc,rt)) ;point=OldPos(i)+(uveloc*rt)
lamda=rt4
BallNr=i
EndIf
EndIf
EndIf
EndIf
If TestIntersionPlane(pl5,OldPos(i),uveloc,@rt,norm)
rt4=rt*RestTime/rt2
If rt4<=lamda
If rt4<=RestTime+#ZERO
If Not (rt<=#ZERO And TVector_dot(uveloc,norm)>#ZERO)
TVector_set(normal,norm)
TVector_add(point,OldPos(i),TVector_multiply(tv,uveloc,rt)) ;point=OldPos(i)+(uveloc*rt)
lamda=rt4
BallNr=i
EndIf
EndIf
EndIf
EndIf
;Now Test Intersection With The 3 Cylinders
If TestIntersionCylinder(cyl1,OldPos(i),uveloc,@rt,norm,Nc)
rt4=rt*RestTime/rt2
If rt4<=lamda
If rt4<=RestTime+#ZERO
If Not (rt<=#ZERO And TVector_dot(uveloc,norm)>#ZERO)
TVector_set(normal,norm)
TVector_set(point,Nc)
lamda=rt4
BallNr=i
EndIf
EndIf
EndIf
EndIf
If TestIntersionCylinder(cyl2,OldPos(i),uveloc,@rt,norm,Nc)
rt4=rt*RestTime/rt2
If rt4<=lamda
If rt4<=RestTime+#ZERO
If Not (rt<=#ZERO And TVector_dot(uveloc,norm)>#ZERO)
TVector_set(normal,norm)
TVector_set(point,Nc)
lamda=rt4
BallNr=i
EndIf
EndIf
EndIf
EndIf
If TestIntersionCylinder(cyl3,OldPos(i),uveloc,@rt,norm,Nc)
rt4=rt*RestTime/rt2
If rt4<=lamda
If rt4<=RestTime+#ZERO
If Not (rt<=#ZERO And TVector_dot(uveloc,norm)>#ZERO)
TVector_set(normal,norm)
TVector_set(point,Nc)
lamda=rt4
BallNr=i
EndIf
EndIf
EndIf
EndIf
Next
;After All Balls Were Tested With Planes / Cylinders Test For
;Collision Between Them And Replace If Collision Time Smaller
If FindBallCol(Pos2,@BallTime,RestTime,@BallColNr1,@BallColNr2)
If sounds
PlaySound_("Data/Explode.wav",#Null,#SND_FILENAME | #SND_ASYNC)
EndIf
If lamda=10000 Or lamda>BallTime
RestTime=RestTime-BallTime
Protected pb1.TVECTOR,pb2.TVECTOR,xaxis.TVECTOR
Protected U1x.TVECTOR,U1y.TVECTOR,U2x.TVECTOR,U2y.TVECTOR
Protected V1x.TVECTOR,V1y.TVECTOR,V2x.TVECTOR,V2y.TVECTOR
Protected a.d,b.d
;Find Positions Of Ball1 And Ball2
TVector_add(pb1,OldPos(BallColNr1),TVector_multiply(tv,ArrayVel(BallColNr1),BallTime)) ;pb1=OldPos(BallColNr1)+(ArrayVel(BallColNr1)*BallTime)
TVector_add(pb2,OldPos(BallColNr2),TVector_multiply(tv,ArrayVel(BallColNr2),BallTime)) ;pb2=OldPos(BallColNr2)+(ArrayVel(BallColNr2)*BallTime)
TVector_set(xaxis,TVector_unit(TVector_subtract(tv,pb2,pb1))) ;Find X-Axis
a=TVector_dot(xaxis,ArrayVel(BallColNr1)) ;Find Projection
TVector_multiply(U1x,xaxis,a) ;Find Projected Vectors
TVector_subtract(U1y,ArrayVel(BallColNr1),U1x) ;U1y=ArrayVel(BallColNr1)-U1x
;Do The Same As Above To Find Projection Vectors For The Other Ball
TVector_set(xaxis,TVector_unit(TVector_subtract(tv,pb1,pb2))) ;xaxis=(pb1-pb2).unit()
b=TVector_dot(xaxis,ArrayVel(BallColNr2))
TVector_multiply(U2x,xaxis,b) ;U2x=xaxis*b
TVector_subtract(U2y,ArrayVel(BallColNr2),U2x) ;U2y=ArrayVel(BallColNr2)-U2x
;Now Find New Velocities
TVector_add(V1x,U1x,TVector_subtract(tv,U2x,TVector_subtract(tv,U1x,U2x)))
TVector_multiply(V1x,V1x,0.5) ;V1x=(U1x+U2x-(U1x-U2x))*0.5
TVector_add(V2x,U1x,TVector_subtract(tv,U2x,TVector_subtract(tv,U2x,U1x)))
TVector_multiply(V2x,V2x,0.5) ;V2x=(U1x+U2x-(U2x-U1x))*0.5
TVector_set(V1y,U1y) ;V1y=U1y
TVector_set(V2y,U2y) ;V2y=U2y
For j=0 To NrOfBalls-1 ;Update All Ball Positions
TVector_add(ArrayPos(j),OldPos(j),TVector_multiply(tv,ArrayVel(j),BallTime)) ;ArrayPos(j)=OldPos(j)+(ArrayVel(j)*BallTime)
Next
;Set New Velocity Vectors To The Colliding Balls
TVector_add(ArrayVel(BallColNr1),V1x,V1y) ;ArrayVel(BallColNr1)=V1x+V1y
TVector_add(ArrayVel(BallColNr2),V2x,V2y) ;ArrayVel(BallColNr2)=V2x+V2y
;Update Explosion Array
For j=0 To 20-1
If ExplosionArray(j)\_Alpha<=0
ExplosionArray(j)\_Alpha=1
TVector_set(ExplosionArray(j)\_Position,ArrayPos(BallColNr1))
ExplosionArray(j)\_Scale=1
Break
EndIf
Next
Continue
EndIf
EndIf
;End Of Tests
;If Collision Occured Move Simulation For The Correct Timestep
;And Compute Response For The Colliding Ball
If lamda<>10000
RestTime-lamda
For j=0 To NrOfBalls-1
TVector_add(ArrayPos(j),OldPos(j),TVector_multiply(tv,ArrayVel(j),lamda)) ;ArrayPos(j)=OldPos(j)+(ArrayVel(j)*lamda)
Next
rt2=TVector_mag(ArrayVel(BallNr)) ;Find Magnitude Of Velocity
TVector_unit(ArrayVel(BallNr)) ;Normalize It
;Compute Reflection
TVector_add(tv,ArrayVel(BallNr),TVector_multiply(tv,normal,2*TVector_dot(normal,TVector_invert(tv,ArrayVel(BallNr)))))
TVector_set(ArrayVel(BallNr),TVector_unit(tv)) ;ArrayVel(BallNr)=TVector_unit(ArrayVel(BallNr)+(normal * (2*TVector_dot(normal,-ArrayVel(BallNr))) ))
TVector_multiply(ArrayVel(BallNr),ArrayVel(BallNr),rt2) ;Multiply With Magnitude To Obtain Final Velocity Vector
;Update Explosion Array And Insert Explosion
For j=0 To 20-1
If ExplosionArray(j)\_Alpha<=0
ExplosionArray(j)\_Alpha=1
TVector_set(ExplosionArray(j)\_Position,point)
ExplosionArray(j)\_Scale=1
Break
EndIf
Next
Else
RestTime=0
EndIf
Wend ;End Of While Loop
EndProcedure
Procedure.l DrawGLScene() ;Here's Where We Do All The Drawing
Protected i.l
glMatrixMode_(#GL_MODELVIEW) ;Select The Modelview Matrix
glLoadIdentity_() ;Reset The Modelview Matrix
;Set Camera In Hookmode
If hook_toball1
Protected unit_followvector.TVECTOR
TVector_set(unit_followvector,ArrayVel(0)) ;unit_followvector=ArrayVel(0)
TVector_unit(unit_followvector)
gluLookAt(ArrayPos(0)\_x+250,ArrayPos(0)\_y+250,ArrayPos(0)\_z,ArrayPos(0)\_x+ArrayVel(0)\_x,ArrayPos(0)\_y+ArrayVel(0)\_y,ArrayPos(0)\_z+ArrayVel(0)\_z,0.0,1.0,0.0)
Else
gluLookAt(pos\_x,pos\_y,pos\_z,pos\_x+dir\_x,pos\_y+dir\_y,pos\_z+dir\_z,0.0,1.0,0.0)
EndIf
glClear_(#GL_COLOR_BUFFER_BIT | #GL_DEPTH_BUFFER_BIT) ;Clear Screen And Depth Buffer
glRotatef_(camera_rotation,0.0,1.0,0.0) ;Rotate On The Y Axis
;Render Balls
For i=0 To NrOfBalls-1
Select i
Case 1 : glColor3f_(1.0,1.0,1.0) ;white
Case 2 : glColor3f_(1.0,1.0,0.0) ;yellow
Case 3 : glColor3f_(0.0,1.0,1.0) ;cyan
Case 4 : glColor3f_(0.0,1.0,0.0) ;green
Case 5 : glColor3f_(0.0,0.0,1.0) ;blue
Case 6 : glColor3f_(0.6,0.2,0.3) ;dark red
Case 7 : glColor3f_(1.0,0.0,1.0) ;purple
Case 8 : glColor3f_(0.0,0.7,0.4) ;dark green
Case 9 : glColor3f_(0.5,0.4,0.0) ;brown
Default : glColor3f_(1.0,0.0,0.0) ;red
EndSelect
glPushMatrix_()
glTranslated(ArrayPos(i)\_x,ArrayPos(i)\_y,ArrayPos(i)\_z) ;Position Ball
gluSphere(cylinder_obj,20.0,20,20)
glPopMatrix_()
Next
glEnable_(#GL_TEXTURE_2D) ;Enable Texture Mapping
;Render Walls (Planes) With Texture
glBindTexture_(#GL_TEXTURE_2D,texture(3))
glColor3f_(1.0,1.0,1.0) ;white
glBegin_(#GL_QUADS)
;Front Face
glTexCoord2f_(1.0, 0.0) : glVertex3f_( 320.0, 320.0, 320.0)
glTexCoord2f_(1.0, 1.0) : glVertex3f_( 320.0,-320.0, 320.0)
glTexCoord2f_(0.0, 1.0) : glVertex3f_(-320.0,-320.0, 320.0)
glTexCoord2f_(0.0, 0.0) : glVertex3f_(-320.0, 320.0, 320.0)
;Back Face
glTexCoord2f_(1.0, 0.0) : glVertex3f_(-320.0, 320.0,-320.0)
glTexCoord2f_(1.0, 1.0) : glVertex3f_(-320.0,-320.0,-320.0)
glTexCoord2f_(0.0, 1.0) : glVertex3f_( 320.0,-320.0,-320.0)
glTexCoord2f_(0.0, 0.0) : glVertex3f_( 320.0, 320.0,-320.0)
;Right Face
glTexCoord2f_(1.0, 0.0) : glVertex3f_( 320.0, 320.0,-320.0)
glTexCoord2f_(1.0, 1.0) : glVertex3f_( 320.0,-320.0,-320.0)
glTexCoord2f_(0.0, 1.0) : glVertex3f_( 320.0,-320.0, 320.0)
glTexCoord2f_(0.0, 0.0) : glVertex3f_( 320.0, 320.0, 320.0)
;Left Face
glTexCoord2f_(1.0, 0.0) : glVertex3f_(-320.0, 320.0, 320.0)
glTexCoord2f_(1.0, 1.0) : glVertex3f_(-320.0,-320.0, 320.0)
glTexCoord2f_(0.0, 1.0) : glVertex3f_(-320.0,-320.0,-320.0)
glTexCoord2f_(0.0, 0.0) : glVertex3f_(-320.0, 320.0,-320.0)
glEnd_()
;Render Floor (Plane) With Colours
glBindTexture_(#GL_TEXTURE_2D,texture(2))
glBegin_(#GL_QUADS)
;Bottom Face
glTexCoord2f_(1.0, 0.0) : glVertex3f_(-320.0,-320.0, 320.0)
glTexCoord2f_(1.0, 1.0) : glVertex3f_( 320.0,-320.0, 320.0)
glTexCoord2f_(0.0, 1.0) : glVertex3f_( 320.0,-320.0,-320.0)
glTexCoord2f_(0.0, 0.0) : glVertex3f_(-320.0,-320.0,-320.0)
glEnd_()
;Render Columns (Cylinders)
glBindTexture_(#GL_TEXTURE_2D,texture(0)) ;Choose The Texture To Use
glColor3f_(0.5,0.5,0.5) ;grey
glPushMatrix_()
glRotatef_(90.0,1.0,0.0,0.0) ;Rotate On The X Axis By 90
glTranslatef_(0.0,0.0,-500.0) ;Move Away 500
gluCylinder(cylinder_obj,60.0,60.0,1000.0,20,2)
glPopMatrix_()
glPushMatrix_()
glTranslatef_(200.0,-300.0,-500.0) ;Move Right 200, Down 300 And Away 500
gluCylinder(cylinder_obj,60.0,60.0,1000.0,20,2)
glPopMatrix_()
glPushMatrix_()
glTranslatef_(-200.0,0.0,0.0) ;Move Left 200
glRotatef_(135.0,1.0,0.0,0.0) ;Rotate On The X Axis By 135
glTranslatef_(0.0,0.0,-500.0) ;Move Away 500
gluCylinder(cylinder_obj,30.0,30.0,1000.0,20,2)
glPopMatrix_()
;Render / Blend Explosions
glEnable_(#GL_BLEND) ;Enable Blending
glDepthMask_(#GL_FALSE) ;Disable Depth Buffer Writes
glBindTexture_(#GL_TEXTURE_2D,texture(1)) ;Upload Texture
For i=0 To 20-1 ;Update And Render Explosions
If ExplosionArray(i)\_Alpha>=0
glPushMatrix_()
ExplosionArray(i)\_Alpha-0.01 ;Update Alpha
ExplosionArray(i)\_Scale+0.03 ;Update Scale
glColor4f_(1.0,1.0,0.0,ExplosionArray(i)\_Alpha) ;Assign Vertices Colour Yellow With Alpha
glScalef_(ExplosionArray(i)\_Scale,ExplosionArray(i)\_Scale,ExplosionArray(i)\_Scale) ;Scale
;Translate Into Position Taking Into Account The Offset Caused By The Scale
glTranslatef_(ExplosionArray(i)\_Position\_x/ExplosionArray(i)\_Scale,ExplosionArray(i)\_Position\_y/ExplosionArray(i)\_Scale,ExplosionArray(i)\_Position\_z/ExplosionArray(i)\_Scale)
glCallList_(dlist) ;Call Display List
glPopMatrix_()
EndIf
Next
glDepthMask_(#GL_TRUE) ;Enable Depth Mask
glDisable_(#GL_BLEND) ;Disable Blending
glDisable_(#GL_TEXTURE_2D) ;Disable Texture Mapping
ProcedureReturn #True ;Keep Going
EndProcedure
Procedure KillGLWindow() ;Properly Kill The Window
If fullscreen ;Are We In Fullscreen Mode?
If ChangeDisplaySettings_(#Null,#CDS_TEST)=0 ;If The Shortcut Doesn't Work
ChangeDisplaySettings_(#Null,#CDS_RESET) ;Do It Anyway (To Get The Values Out Of The Registry)
ChangeDisplaySettings_(DMsaved,#CDS_RESET) ;Change It To The Saved Settings
Else
ChangeDisplaySettings_(#Null,#CDS_RESET) ;If It Works, Go Right Ahead
EndIf
ShowCursor_(#True) ;Show Mouse Pointer
EndIf
If hRC ;Do We Have A Rendering Context?
If wglMakeCurrent_(#Null,#Null)=0 ;Are We Able To Release The DC And RC Contexts?
MessageBox_(#Null,"Release Of DC And RC Failed.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
EndIf
If wglDeleteContext_(hRC)=0 ;Are We Able To Delete The RC?
MessageBox_(#Null,"Release Rendering Context Failed.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
EndIf
hRC=#Null ;Set RC To NULL
EndIf
If hDC And ReleaseDC_(hWnd,hDC)=0 ;Are We Able To Release The DC
MessageBox_(#Null,"Release Device Context Failed.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
hDC=#Null ;Set DC To NULL
EndIf
If hWnd And DestroyWindow_(hWnd)=0 ;Are We Able To Destroy The Window?
MessageBox_(#Null,"Could Not Release hWnd.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
hWnd=#Null ;Set hWnd To NULL
EndIf
If UnregisterClass_("OpenGL",hInstance)=0 ;Are We Able To Unregister Class
MessageBox_(#Null,"Could Not Unregister Class.","SHUTDOWN ERROR",#MB_OK | #MB_ICONINFORMATION)
hInstance=#Null ;Set hInstance To NULL
EndIf
EndProcedure
;This Code Creates Our OpenGL Window. Parameters Are:
;title - Title To Appear At The Top Of The Window
;width - Width Of The GL Window Or Fullscreen Mode
;height - Height Of The GL Window Or Fullscreen Mode
;bits - Number Of Bits To Use For Color (8/16/24/32)
;fullscreenflag - Use Fullscreen Mode (TRUE) Or Windowed Mode (FALSE)
Procedure.b CreateGLWindow(title.s,width.l,height.l,bits.l,fullscreenflag.b)
Protected PixelFormat.l ;Holds The Results After Searching For A Match
Protected wc.WNDCLASS ;Windows Class Structure
Protected dwExStyle.l ;Window Extended Style
Protected dwStyle.l ;Window Style
Protected WindowRect.RECT ;Grabs Rectangle Upper Left / Lower Right Values
Protected wpos.POINT ;Window position
WindowRect\left=0 ;Set Left Value To 0
WindowRect\right=width ;Set Right Value To Requested Width
WindowRect\top=0 ;Set Top Value To 0
WindowRect\bottom=height ;Set Bottom Value To Requested Height
fullscreen=fullscreenflag ;Set The Global Fullscreen Flag
hInstance=GetModuleHandle_(#Null) ;Grab An Instance For Our Window
wc\style=#CS_HREDRAW | #CS_VREDRAW | #CS_OWNDC ;Redraw On Size, And Own DC For Window
wc\lpfnWndProc=@WndProc() ;WndProc Handles Messages
wc\cbClsExtra=0 ;No Extra Window Data
wc\cbWndExtra=0 ;No Extra Window Data
wc\hInstance=hInstance ;Set The Instance
wc\hIcon=LoadIcon_(#Null,#IDI_WINLOGO) ;Load The Default Icon
wc\hCursor=LoadCursor_(#Null,#IDC_ARROW) ;Load The Arrow Pointer
wc\hbrBackground=#Null ;No Background Required For GL
wc\lpszMenuName=#Null ;We Don't Want A Menu
wc\lpszClassName=@"OpenGL" ;Set The Class Name
If RegisterClass_(wc)=0 ;Attempt To Register The Window Class
MessageBox_(#Null,"Failed To Register The Window Class.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
EnumDisplaySettings_(#Null,#ENUM_CURRENT_SETTINGS,DMsaved) ;Save The Current Display State
If fullscreen ;Attempt Fullscreen Mode?
Protected dmScreenSettings.DEVMODE ;Device Mode
dmScreenSettings\dmSize=SizeOf(DEVMODE) ;Size Of The Devmode Structure
dmScreenSettings\dmFields=#DM_BITSPERPEL | #DM_PELSWIDTH | #DM_PELSHEIGHT ;bit flags to specify the members of DEVMODE that were initialized
dmScreenSettings\dmBitsPerPel=bits ;Selected Bits Per Pixel
dmScreenSettings\dmPelsWidth=width ;Selected Screen Width in pixels
dmScreenSettings\dmPelsHeight=height ;Selected Screen Height in pixels
;Try To Set Selected Mode And Get Results. Note: CDS_FULLSCREEN Gets Rid Of Start Bar
If ChangeDisplaySettings_(dmScreenSettings,#CDS_FULLSCREEN)<>#DISP_CHANGE_SUCCESSFUL
;If The Mode Fails, Offer Two Options. Quit Or Use Windowed Mode
If MessageBox_(#Null,"The Requested Fullscreen Mode Is Not Supported By"+Chr(10)+"Your Video Card. Use Windowed Mode Instead?","NeHe GL",#MB_YESNO | #MB_ICONEXCLAMATION)=#IDYES
fullscreen=#False ;Windowed Mode Selected. Fullscreen = FALSE
Else
;Pop Up A Message Box Letting User Know The Program Is Closing
MessageBox_(#Null,"Program Will Now Close.","ERROR",#MB_OK | #MB_ICONSTOP)
ProcedureReturn #False
EndIf
EndIf
EndIf
If fullscreen ;Are We Still In Fullscreen Mode?
dwExStyle=#WS_EX_APPWINDOW ;Window Extended Style
dwStyle=#WS_POPUP ;Windows Style
ShowCursor_(#False) ;Hide Mouse Pointer
Else
dwExStyle=#WS_EX_APPWINDOW | #WS_EX_WINDOWEDGE ;Window Extended Style
dwStyle=#WS_OVERLAPPEDWINDOW ;Windows Style
EndIf
AdjustWindowRectEx_(WindowRect,dwStyle,#False,dwExStyle) ;Adjust Window To True Requested Size
If fullscreen=0 ;if not fullscreen mode calculate screen centered window
wpos\x=(GetSystemMetrics_(#SM_CXSCREEN)/2)-((WindowRect\right-WindowRect\left)/2)
wpos\y=(GetSystemMetrics_(#SM_CYSCREEN)/2)-((WindowRect\bottom-WindowRect\top)/2)
EndIf
;CreateWindowEx_(Extended Window Style, Class Name, Window Title, Window Style, Window X Position, Window Y Position, Width, Height, No Parent Window, No Menu, Instance, No Creation Data)
hWnd=CreateWindowEx_(dwExStyle,"OpenGL",title,dwStyle | #WS_CLIPSIBLINGS | #WS_CLIPCHILDREN,wpos\x,wpos\y,WindowRect\right-WindowRect\left,WindowRect\bottom-WindowRect\top,#Null,#Null,hInstance,#Null)
If hWnd=0
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Window Creation Error.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
Protected pfd.PIXELFORMATDESCRIPTOR ;pfd Tells Windows How We Want Things To Be
pfd\nSize=SizeOf(PIXELFORMATDESCRIPTOR) ;Size Of This Structure
pfd\nVersion=1 ;Version Number
pfd\dwFlags=#PFD_SUPPORT_OPENGL | #PFD_DOUBLEBUFFER | #PFD_DRAW_TO_WINDOW ;Format Must Support Window, OpenGL, Double Buffering
pfd\iPixelType=#PFD_TYPE_RGBA ;Request An RGBA Format
pfd\cColorBits=bits ;Select Our Color Depth
pfd\cRedBits=0 ;Color Bits Ignored
pfd\cRedShift=0
pfd\cGreenBits=0
pfd\cGreenShift=0
pfd\cBlueBits=0
pfd\cBlueShift=0
pfd\cAlphaBits=0 ;No Alpha Buffer
pfd\cAlphaShift=0 ;Shift Bit Ignored
pfd\cAccumBits=0 ;No Accumulation Buffer
pfd\cAccumRedBits=0 ;Accumulation Bits Ignored
pfd\cAccumGreenBits=0
pfd\cAccumBlueBits=0
pfd\cAccumAlphaBits=0
pfd\cDepthBits=16 ;16Bit Z-Buffer (Depth Buffer)
pfd\cStencilBits=0 ;No Stencil Buffer
pfd\cAuxBuffers=0 ;No Auxiliary Buffer
pfd\iLayerType=#PFD_MAIN_PLANE ;Main Drawing Layer
pfd\bReserved=0 ;Reserved
pfd\dwLayerMask=0 ;Layer Masks Ignored
pfd\dwVisibleMask=0
pfd\dwDamageMask=0
hDC=GetDC_(hWnd)
If hDC=0 ;Did We Get A Device Context?
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Can't Create A GL Device Context.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
PixelFormat=ChoosePixelFormat_(hDC,pfd)
If PixelFormat=0 ;Did Windows Find A Matching Pixel Format?
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Can't Find A Suitable PixelFormat.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
If SetPixelFormat_(hDC,PixelFormat,pfd)=0 ;Are We Able To Set The Pixel Format?
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Can't Set The PixelFormat.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
hRC=wglCreateContext_(hDC)
If hRC=0 ;Are We Able To Get A Rendering Context?
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Can't Create A GL Rendering Context.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
If wglMakeCurrent_(hDC,hRC)=0 ;Try To Activate The Rendering Context
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Can't Activate The GL Rendering Context.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
ShowWindow_(hWnd,#SW_SHOW) ;Show The Window
SetForegroundWindow_(hWnd) ;Slightly Higher Priority
SetFocus_(hWnd) ;Sets Keyboard Focus To The Window
ReSizeGLScene(width,height) ;Set Up Our Perspective GL Screen
If InitGL()=0 ;Initialize Our Newly Created GL Window
KillGLWindow() ;Reset The Display
MessageBox_(#Null,"Initialization Failed.","ERROR",#MB_OK | #MB_ICONEXCLAMATION)
ProcedureReturn #False
EndIf
ProcedureReturn #True ;Success
EndProcedure
Procedure ProcessKeys() ;Process Key Presses
If keys(#VK_UP) And pos\_z>400 ;Up Arrow
pos\_z-10
EndIf
If keys(#VK_DOWN) And pos\_z<1200 ;Down Arrow
pos\_z+10
EndIf
If keys(#VK_LEFT) ;Left Arrow
camera_rotation+2
EndIf
If keys(#VK_RIGHT) ;Right Arrow
camera_rotation-2
EndIf
If keys(#VK_ADD) And Time<2.5 ;Numpad + Key
Time+0.1
keys(#VK_ADD)=#False
EndIf
If keys(#VK_SUBTRACT) And Time>0.0 ;Numpad - Key
Time-0.1
keys(#VK_SUBTRACT)=#False
EndIf
If keys(#VK_F2) ;F2 Key
hook_toball1=~hook_toball1 & 1 ;Toggle Hook Camera To Ball
camera_rotation=0
keys(#VK_F2)=#False
EndIf
If keys(#VK_F3) ;F3 Key
sounds=~sounds & 1 ;Toggle Sound
keys(#VK_F3)=#False
EndIf
If keys(#VK_F1) ;Is F1 Being Pressed?
keys(#VK_F1)=#False ;If So Make Key FALSE
KillGLWindow() ;Kill Our Current Window
fullscreen=~fullscreen & 1 ;Toggle Fullscreen / Windowed Mode
;Recreate Our OpenGL Window
If CreateGLWindow("NeHe's Collision Detection Tutorial",640,480,16,fullscreen)=0
ProcedureReturn 0 ;Quit If Window Was Not Created
EndIf
EndIf
EndProcedure
Procedure.l WndProc(hWnd.l,uMsg.l,wParam.l,lParam.l)
Select uMsg ;Check For Windows Messages
Case #WM_ACTIVATE ;Watch For Window Activate Message
If HiWord(wParam)=0 ;Check Minimization State
active=#True ;Program Is Active
Else
active=#False ;Program Is No Longer Active
EndIf
ProcedureReturn 0 ;Return To The Message Loop
Case #WM_SYSCOMMAND ;Intercept System Commands
Select wParam ;Check System Calls
Case #SC_SCREENSAVE ;Screensaver Trying To Start?
ProcedureReturn 0 ;Prevent From Happening
Case #SC_MONITORPOWER ;Monitor Trying To Enter Powersave?
ProcedureReturn 0 ;Prevent From Happening
EndSelect
Case #WM_CLOSE ;Did We Receive A Close Message?
PostQuitMessage_(0) ;Send A Quit Message
ProcedureReturn 0 ;Jump Back
Case #WM_KEYDOWN ;Is A Key Being Held Down?
keys(wParam)=#True ;If So, Mark It As TRUE
ProcedureReturn 0 ;Jump Back
Case #WM_KEYUP ;Has A Key Been Released?
keys(wParam)=#False ;If So, Mark It As FALSE
ProcedureReturn 0 ;Jump Back
Case #WM_SIZE ;Resize The OpenGL Window
ReSizeGLScene(LoWord(lParam),HiWord(lParam)) ;LoWord=Width, HiWord=Height
ProcedureReturn 0 ;Jump Back
EndSelect
;Pass All Unhandled Messages To DefWindowProc
ProcedureReturn DefWindowProc_(hWnd,uMsg,wParam,lParam)
EndProcedure
Procedure.l WinMain() ;Main Program
Protected msg.MSG ;Windows Message Structure
Protected done.b ;Bool Variable To Exit Loop
;Ask The User Which Screen Mode They Prefer
If MessageBox_(#Null,"Would You Like To Run In Fullscreen Mode?","Start FullScreen?",#MB_YESNO | #MB_ICONQUESTION)=#IDNO
fullscreen=#False ;Windowed Mode
EndIf
InitVars() ;Initialize Variables
If CreateGLWindow("NeHe's Collision Detection Tutorial",640,480,16,fullscreen)=0 ;Create The Window
ProcedureReturn 0 ;Quit If Window Was Not Created
EndIf
While done=#False ;Loop That Runs While done=FALSE
If PeekMessage_(msg,#Null,0,0,#PM_REMOVE) ;Is There A Message Waiting?
If msg\message=#WM_QUIT ;Have We Received A Quit Message?
done=#True ;If So done=TRUE
Else ;If Not, Deal With Window Messages
TranslateMessage_(msg) ;Translate The Message
DispatchMessage_(msg) ;Dispatch The Message
EndIf
Else ;If There Are No Messages
If active
;Draw The Scene. Watch For ESC Key And Quit Messages From DrawGLScene()
If keys(#VK_ESCAPE) ;Active? Was There A Quit Received?
done=#True ;ESC or DrawGLScene Signalled A Quit
Else ;Not Time To Quit, Update Screen
idle() ;Advance Simulation
DrawGLScene() ;Draw Scene
SwapBuffers_(hDC) ;Swap Buffers (Double Buffering)
ProcessKeys() ;Process Key Presses
EndIf
EndIf
EndIf
Wend
;Shutdown
KillGLWindow() ;Kill The Window
glDeleteTextures_(4,texture()) ;Free textures
End ;Exit The Program
EndProcedure
WinMain() ;run the main program