NeHe's Collision Detection Tutorial (Lesson 30)

[hagibaba]

This shows how to simulate collision detection and collision response.
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

[hagibaba]

This is the "Collisions.pb" file which is a include file for this lesson.

Code: Select all

;Include File For Collisions (Lesson 30)

;Mathex.h

#EPSILON=1.0e-8 ;General maths constants
#ZERO=#EPSILON
#M_PI=3.1415926535

Procedure.d T_limit(x.d,lower.d,upper.d) ;Limit range of value
 If x<lower
  ProcedureReturn lower
 EndIf
 If x>upper
  ProcedureReturn upper
 EndIf
 ProcedureReturn x
EndProcedure

Procedure.d T_sqr(x.d) ;Square of value (power of 2)
 ProcedureReturn x*x
EndProcedure

Procedure.d T_RadToDeg(rad.d) ;Convert radian to degree
 ProcedureReturn ((rad*180.0)/#M_PI)
EndProcedure

Procedure.d T_DegToRad(deg.d) ;Convert degree to radian
 ProcedureReturn ((deg*#M_PI)/180.0)
EndProcedure

;Structures

Structure TVECTOR ;Vector (point or direction)
 _x.d : _y.d : _z.d : _Status.l
EndStructure

Structure TRAY ;Line or Ray
 _P.TVECTOR ;Any point on the line
 _V.TVECTOR ;Direction of the line
EndStructure

Structure TMATRIX33 ;Matrix (3 by 3)
 _Mx.d[3*3]
EndStructure

;TVector.h, TVector.cpp

;#INVALID=0 ;TVector constants (Note: I've used numbers instead)
;#DEFAULT=1
;#UNIT=2

;Constructors

Procedure TVector_reset(*this.TVECTOR) ;this=0,0,0,#INVALID
 *this\_x=0.0
 *this\_y=0.0
 *this\_z=0.0
 *this\_Status=0 ;#INVALID
EndProcedure

Procedure TVector_make(*this.TVECTOR,x.d,y.d,z.d) ;this=x,y,z,#DEFAULT
 *this\_x=x
 *this\_y=y
 *this\_z=z
 *this\_Status=1 ;#DEFAULT
EndProcedure

Procedure TVector_set(*this.TVECTOR,*v.TVECTOR) ;this=v
 *this\_x=*v\_x
 *this\_y=*v\_y
 *this\_z=*v\_z
 *this\_Status=*v\_Status
EndProcedure

Declare.b TRay_adjacentPoints(*this.TRAY,*ray.TRAY,*point1.TVECTOR,*point2.TVECTOR)

;Mid point between two lines

Procedure TVector_midpoint(*this.TVECTOR,*ray1.TRAY,*ray2.TRAY) ;Mid point between two rays

 Protected point1.TVECTOR,point2.TVECTOR
 If TRay_adjacentPoints(*ray1,*ray2,point1,point2)
  *this\_x=(point1\_x+point2\_x)*0.5
  *this\_y=(point1\_y+point2\_y)*0.5
  *this\_z=(point1\_z+point2\_z)*0.5
 Else
  TVector_reset(*this)
 EndIf
 
EndProcedure

;Selectors

Procedure.d TVector_X(*this.TVECTOR) ;d=this\_x
 ProcedureReturn *this\_x
EndProcedure

Procedure.d TVector_Y(*this.TVECTOR) ;d=this\_y
 ProcedureReturn *this\_y
EndProcedure

Procedure.d TVector_Z(*this.TVECTOR) ;d=this\_z
 ProcedureReturn *this\_z
EndProcedure

Procedure.l TVector_isUnit(*this.TVECTOR) ;this\_Status=#UNIT
 If *this\_Status=2
  ProcedureReturn *this\_Status
 EndIf
EndProcedure

Procedure.l TVector_isDefault(*this.TVECTOR) ;this\_Status=#DEFAULT
 If *this\_Status=1
  ProcedureReturn *this\_Status
 EndIf
EndProcedure

Procedure.l TVector_isValid(*this.TVECTOR) ;this\_Status<>INVALID
 If *this\_Status<>0
  ProcedureReturn *this\_Status
 EndIf
EndProcedure

Declare.d TVector_mag(*this.TVECTOR)

;Change the status of a vector

Procedure.l TVector_unit(*this.TVECTOR) ;Make a unit vector

 If TVector_isDefault(*this)
  Protected rep.d=TVector_mag(*this)
  If rep<#EPSILON
   *this\_x=0.0
   *this\_y=0.0
   *this\_z=0.0
  Else
   Protected temp.d=1.0/rep
   *this\_x*temp
   *this\_y*temp
   *this\_z*temp
  EndIf
  *this\_Status=2 ;#UNIT
 EndIf
 ProcedureReturn *this
 
EndProcedure

Procedure.l TVector_setunit(*result.TVECTOR,*v.TVECTOR)
 TVector_set(*result,*v) ;result=v
 ProcedureReturn TVector_unit(*result) ;result.unit()
EndProcedure

Procedure.l TVector_default(*this.TVECTOR) ;Make a default vector

 If TVector_isUnit(*this)
  *this\_Status=1 ;#DEFAULT
 EndIf
 ProcedureReturn *this
 
EndProcedure

Procedure.l TVector_setdefault(*result.TVECTOR,*v.TVECTOR)
 TVector_set(*result,*v) ;result=v
 ProcedureReturn TVector_default(*result) ;result.default()
EndProcedure

;Magnitude

Procedure.d TVector_mag(*this.TVECTOR)
 If TVector_isValid(*this)
  If TVector_isUnit(*this)
   ProcedureReturn 1.0
  Else
   ProcedureReturn Sqr(T_sqr(*this\_x) + T_sqr(*this\_y) + T_sqr(*this\_z))
  EndIf
 Else
  ProcedureReturn 0.0
 EndIf
EndProcedure

Procedure.d TVector_magSqr(*this.TVECTOR)
 If TVector_isValid(*this)
  If TVector_isUnit(*this)
   ProcedureReturn 1.0
  Else
   ProcedureReturn (T_sqr(*this\_x) + T_sqr(*this\_y) + T_sqr(*this\_z))
  EndIf
 Else
  ProcedureReturn 0.0
 EndIf
EndProcedure

;Dot or scalar product

Procedure.d TVector_dot(*this.TVECTOR,*v.TVECTOR)
 If TVector_isValid(*this) And TVector_isValid(*v)
  ProcedureReturn (*this\_x**v\_x + *this\_y**v\_y + *this\_z**v\_z) 
 Else
  ProcedureReturn 0.0
 EndIf
EndProcedure

Declare.l TVector_subtract(*result.TVECTOR,*v1.TVECTOR,*v2.TVECTOR)

;Distance between two vectors

Procedure.d TVector_dist(*this.TVECTOR,*v.TVECTOR)
 Protected tv.TVECTOR
 TVector_subtract(tv,*this,*v) ;tv=this-v
 ProcedureReturn TVector_mag(tv) ;tv.mag()
EndProcedure

Procedure.d TVector_distSqr(*this.TVECTOR,*v.TVECTOR)
 Protected tv.TVECTOR
 TVector_subtract(tv,*this,*v) ;tv=this-v
 ProcedureReturn TVector_magSqr(tv) ;tv.magSqr()
EndProcedure

;Optimised arithmetic methods

Procedure.l TVector_add(*result.TVECTOR,*v1.TVECTOR,*v2.TVECTOR)

 If TVector_isValid(*v1) And TVector_isValid(*v2)
  *result\_x=*v1\_x+*v2\_x
  *result\_y=*v1\_y+*v2\_y
  *result\_z=*v1\_z+*v2\_z
  *result\_Status=1 ;#DEFAULT
 Else
  TVector_reset(*result)
 EndIf
 ProcedureReturn *result
 
EndProcedure

Procedure.l TVector_subtract(*result.TVECTOR,*v1.TVECTOR,*v2.TVECTOR)

 If TVector_isValid(*v1) And TVector_isValid(*v2)
  *result\_x=*v1\_x-*v2\_x
  *result\_y=*v1\_y-*v2\_y
  *result\_z=*v1\_z-*v2\_z
  *result\_Status=1 ;#DEFAULT
 Else
  TVector_reset(*result)
 EndIf
 ProcedureReturn *result
 
EndProcedure

Procedure.l TVector_cross(*result.TVECTOR,*v1.TVECTOR,*v2.TVECTOR)

 If TVector_isValid(*v1) And TVector_isValid(*v2)
  *result\_x=*v1\_y**v2\_z - *v1\_z**v2\_y
  *result\_y=*v1\_z**v2\_x - *v1\_x**v2\_z
  *result\_z=*v1\_x**v2\_y - *v1\_y**v2\_x
  *result\_Status=1 ;#DEFAULT
 Else
  TVector_reset(*result)
 EndIf
 ProcedureReturn *result
 
EndProcedure

Procedure.l TVector_invert(*result.TVECTOR,*v1.TVECTOR)

 If TVector_isValid(*v1)
  *result\_x=-*v1\_x
  *result\_y=-*v1\_y
  *result\_z=-*v1\_z
  *result\_Status=*v1\_Status
 Else
  TVector_reset(*result)
 EndIf
 ProcedureReturn *result
 
EndProcedure

Procedure.l TVector_multiply(*result.TVECTOR,*v1.TVECTOR,scale.d)

 If TVector_isValid(*v1)
  *result\_x=*v1\_x*scale
  *result\_y=*v1\_y*scale
  *result\_z=*v1\_z*scale
  *result\_Status=1 ;#DEFAULT
 Else
  TVector_reset(*result)
 EndIf
 ProcedureReturn *result
 
EndProcedure

;TRay.h, TRay.cpp

;Line between two points OR point and a direction

Procedure TRay_setunit(*this.TRAY,*point1.TVECTOR,*point2.TVECTOR) ;Line between two points OR point and a direction

 TVector_set(*this\_P,*point1) ;this\_P=point1
 If TVector_isUnit(*point2)
  TVector_set(*this\_V,*point2) ;this\_V=point2
 Else
  TVector_subtract(*this\_V,*point2,*point1) ;this\_V=point2-point1
  TVector_unit(*this\_V) ;this\_V.unit()
 EndIf
 
EndProcedure

Declare.l TRay_isValid(*this.TRAY)

;Adjacent points on both lines

Procedure.b TRay_adjacentPoints(*this.TRAY,*ray.TRAY,*point1.TVECTOR,*point2.TVECTOR)

 If TRay_isValid(*this) And TRay_isValid(*ray)
  Protected temp.d=TVector_dot(*this\_V,*ray\_V)
  Protected temp2.d=1.0-T_sqr(temp)
  Protected mu.d,a.d,b.d,lambda.d
  Protected tv.TVECTOR ;Temporary vector to enable use of optimised routines
  ;Check for parallel rays
  If Abs(temp2)<#EPSILON
   TVector_subtract(tv,*this\_P,*ray\_P) ;tv=this\_P-ray\_P
   mu=TVector_dot(*this\_V,tv)/temp
   TVector_set(*point1,*this\_P) ;point1=this\_P
   TVector_add(*point2,*ray\_P,TVector_multiply(tv,*ray\_V,mu)) ;point2=ray\_P+(ray\_V*mu)
  Else
   a=TVector_dot(*this\_V,TVector_subtract(tv,*ray\_P,*this\_P)) ;tv=ray\_P-this\_P
   b=TVector_dot(*ray\_V,TVector_subtract(tv,*this\_P,*ray\_P)) ;tv=this\_P-ray\_P
   mu=(b+temp*a)/temp2
   lambda=(a+temp*b)/temp2
   TVector_add(*point1,*this\_P,TVector_multiply(tv,*this\_V,lambda)) ;point1=this\_P+(this\_V*lambda)
   TVector_add(*point2,*ray\_P,TVector_multiply(tv,*ray\_V,mu)) ;point2=ray\_P+(ray\_V*mu)
  EndIf
  ProcedureReturn #True
 EndIf
 ProcedureReturn #False
 
EndProcedure

;Unary operator

Procedure.l TRay_invert(*result.TRAY,*ray.TRAY)
 TVector_set(*result\_P,*ray\_P) ;result\_P=ray\_P
 TVector_invert(*result\_V,*ray\_V) ;*result\_V=-ray\_V
 ProcedureReturn *result
EndProcedure

;Selectors

Procedure.l TRay_P(*this.TRAY) ;this\_P
 ProcedureReturn *this\_P
EndProcedure

Procedure.l TRay_V(*this.TRAY) ;this\_V
 ProcedureReturn *this\_V
EndProcedure

Procedure.l TRay_isValid(*this.TRAY)
 ProcedureReturn (TVector_isUnit(*this\_V) And TVector_isValid(*this\_P))
EndProcedure

;Distances

Procedure.d TRay_raydist(*this.TRAY,*ray.TRAY) ;Distance between two rays

 Protected point1.TVECTOR,point2.TVECTOR
 If TRay_adjacentPoints(*this,*ray,point1,point2)
  ProcedureReturn TVector_dist(point1,point2)
 Else
  ProcedureReturn 0.0
 EndIf
 
EndProcedure

Procedure.d TRay_pointdist(*this.TRAY,*point.TVECTOR) ;Distance between a ray and a point

 If TRay_isValid(*this) And TVector_isValid(*point)
  Protected tv.TVECTOR,point2.TVECTOR
  Protected lambda.d
  TVector_subtract(tv,*point,*this\_P) ;tv=point-this\_P
  lambda=TVector_dot(*this\_V,tv)
  TVector_add(point2,*this\_P,TVector_multiply(tv,*this\_V,lambda)) ;point2=this\_P+(this\_V*lambda)
  ProcedureReturn TVector_dist(*point,point2)
 EndIf
 ProcedureReturn 0.0
 
EndProcedure

;TMatrix.h, TMatrix.cpp

;_Mx[0,0]=x1, _Mx[0,1]=y1, _Mx[0,2]=z1
;_Mx[1,0]=x2, _Mx[1,1]=y2, _Mx[1,2]=z2
;_Mx[2,0]=x3, _Mx[2,1]=y3, _Mx[2,2]=z3

;Constructors

Procedure TMatrix33_normal(*this.TMATRIX33)

 *this\_Mx[0]=1.0 : *this\_Mx[1]=0.0 : *this\_Mx[2]=0.0
 *this\_Mx[3]=0.0 : *this\_Mx[4]=1.0 : *this\_Mx[5]=0.0
 *this\_Mx[6]=0.0 : *this\_Mx[7]=0.0 : *this\_Mx[8]=1.0
 
EndProcedure

Procedure TMatrix33_make(*this.TMATRIX33,mx00.d,mx01.d,mx02.d,mx10.d,mx11.d,mx12.d,mx20.d,mx21.d,mx22.d)

 *this\_Mx[0]=mx00 : *this\_Mx[1]=mx01 : *this\_Mx[2]=mx02
 *this\_Mx[3]=mx10 : *this\_Mx[4]=mx11 : *this\_Mx[5]=mx12
 *this\_Mx[6]=mx20 : *this\_Mx[7]=mx21 : *this\_Mx[8]=mx22
 
EndProcedure

Procedure TMatrix33_cosine(*this.TMATRIX33,Phi.d,Theta.d,Psi.d)

 Protected c1.d=Cos(Phi),c2.d=Cos(Theta),c3.d=Cos(Psi)
 Protected s1.d=Sin(Phi),s2.d=Sin(Theta),s3.d=Sin(Psi)
 *this\_Mx[0]=c2*c3
 *this\_Mx[1]=-c2*s3
 *this\_Mx[2]=s2
 *this\_Mx[3]=s1*s2*c3+c1*s3
 *this\_Mx[4]=-s1*s2*s3+c1*c3
 *this\_Mx[5]=-s1*c2
 *this\_Mx[6]=-c1*s2*c3+s1*s3
 *this\_Mx[7]=c1*s2*s3+s1*c3
 *this\_Mx[8]=c1*c2
 
EndProcedure

;Selectors

Procedure.d TMatrix33_get(*this.TMATRIX33,Row.l,Column.l)
 ProcedureReturn *this\_Mx[(3*Row)+Column]
EndProcedure

;Optimised artimetric methods

Procedure.l TMatrix33_add(*result.TMATRIX33,*m1.TMATRIX33,*m2.TMATRIX33)

 *result\_Mx[0]=*m1\_Mx[0]+*m2\_Mx[0]
 *result\_Mx[1]=*m1\_Mx[1]+*m2\_Mx[1]
 *result\_Mx[2]=*m1\_Mx[2]+*m2\_Mx[2]
 *result\_Mx[3]=*m1\_Mx[3]+*m2\_Mx[3]
 *result\_Mx[4]=*m1\_Mx[4]+*m2\_Mx[4]
 *result\_Mx[5]=*m1\_Mx[5]+*m2\_Mx[5]
 *result\_Mx[6]=*m1\_Mx[6]+*m2\_Mx[6]
 *result\_Mx[7]=*m1\_Mx[7]+*m2\_Mx[7]
 *result\_Mx[8]=*m1\_Mx[8]+*m2\_Mx[8]
 ProcedureReturn *result
 
EndProcedure

Procedure.l TMatrix33_subtract(*result.TMATRIX33,*m1.TMATRIX33,*m2.TMATRIX33)

 *result\_Mx[0]=*m1\_Mx[0]-*m2\_Mx[0]
 *result\_Mx[1]=*m1\_Mx[1]-*m2\_Mx[1]
 *result\_Mx[2]=*m1\_Mx[2]-*m2\_Mx[2]
 *result\_Mx[3]=*m1\_Mx[3]-*m2\_Mx[3]
 *result\_Mx[4]=*m1\_Mx[4]-*m2\_Mx[4]
 *result\_Mx[5]=*m1\_Mx[5]-*m2\_Mx[5]
 *result\_Mx[6]=*m1\_Mx[6]-*m2\_Mx[6]
 *result\_Mx[7]=*m1\_Mx[7]-*m2\_Mx[7]
 *result\_Mx[8]=*m1\_Mx[8]-*m2\_Mx[8]
 ProcedureReturn *result
 
EndProcedure

Procedure.l TMatrix33_dot33(*result.TMATRIX33,*m1.TMATRIX33,*m2.TMATRIX33)

 *result\_Mx[0]=*m1\_Mx[0]**m2\_Mx[0] + *m1\_Mx[1]**m2\_Mx[3] + *m1\_Mx[2]**m2\_Mx[6]
 *result\_Mx[3]=*m1\_Mx[3]**m2\_Mx[0] + *m1\_Mx[4]**m2\_Mx[3] + *m1\_Mx[5]**m2\_Mx[6]
 *result\_Mx[6]=*m1\_Mx[6]**m2\_Mx[0] + *m1\_Mx[7]**m2\_Mx[3] + *m1\_Mx[8]**m2\_Mx[6]
 *result\_Mx[1]=*m1\_Mx[0]**m2\_Mx[1] + *m1\_Mx[1]**m2\_Mx[4] + *m1\_Mx[2]**m2\_Mx[7]
 *result\_Mx[4]=*m1\_Mx[3]**m2\_Mx[1] + *m1\_Mx[4]**m2\_Mx[4] + *m1\_Mx[5]**m2\_Mx[7]
 *result\_Mx[7]=*m1\_Mx[6]**m2\_Mx[1] + *m1\_Mx[7]**m2\_Mx[4] + *m1\_Mx[8]**m2\_Mx[7]
 *result\_Mx[2]=*m1\_Mx[0]**m2\_Mx[2] + *m1\_Mx[1]**m2\_Mx[5] + *m1\_Mx[2]**m2\_Mx[8]
 *result\_Mx[5]=*m1\_Mx[3]**m2\_Mx[2] + *m1\_Mx[4]**m2\_Mx[5] + *m1\_Mx[5]**m2\_Mx[8]
 *result\_Mx[8]=*m1\_Mx[6]**m2\_Mx[2] + *m1\_Mx[7]**m2\_Mx[5] + *m1\_Mx[8]**m2\_Mx[8]
 ProcedureReturn *result
 
EndProcedure

Procedure.l TMatrix33_multiply(*result.TMATRIX33,*m1.TMATRIX33,scale.d)

 *result\_Mx[0]=*m1\_Mx[0]*scale
 *result\_Mx[1]=*m1\_Mx[1]*scale
 *result\_Mx[2]=*m1\_Mx[2]*scale
 *result\_Mx[3]=*m1\_Mx[3]*scale
 *result\_Mx[4]=*m1\_Mx[4]*scale
 *result\_Mx[5]=*m1\_Mx[5]*scale
 *result\_Mx[6]=*m1\_Mx[6]*scale
 *result\_Mx[7]=*m1\_Mx[7]*scale
 *result\_Mx[8]=*m1\_Mx[8]*scale
 ProcedureReturn *result
 
EndProcedure

Procedure.l TMatrix33_dot(*result.TVECTOR,*m1.TMATRIX33,*v.TVECTOR)

 Protected a.d,b.d,c.d
 a=*m1\_Mx[0]**v\_x + *m1\_Mx[1]**v\_y + *m1\_Mx[2]**v\_z
 b=*m1\_Mx[3]**v\_x + *m1\_Mx[4]**v\_y + *m1\_Mx[5]**v\_z
 c=*m1\_Mx[6]**v\_x + *m1\_Mx[7]**v\_y + *m1\_Mx[8]**v\_z
 TVector_make(*result,a,b,c)
 ProcedureReturn *result
 
EndProcedure

;Determinants

Procedure.d TMatrix33_determinant(*this.TMATRIX33)

 Protected a.d,b.d,c.d
 a=*this\_Mx[0] * (*this\_Mx[4]**this\_Mx[8] - *this\_Mx[5]**this\_Mx[7])
 b=*this\_Mx[1] * (*this\_Mx[3]**this\_Mx[8] - *this\_Mx[5]**this\_Mx[6])
 c=*this\_Mx[2] * (*this\_Mx[3]**this\_Mx[7] - *this\_Mx[4]**this\_Mx[6])
 ProcedureReturn (a-b+c)
 
EndProcedure

;Transpose

Procedure.l TMatrix33_transpose(*this.TMATRIX33)

 Protected t.d
 t=*this\_Mx[2] : *this\_Mx[2]=*this\_Mx[6] : *this\_Mx[6]=t
 t=*this\_Mx[1] : *this\_Mx[1]=*this\_Mx[3] : *this\_Mx[3]=t
 t=*this\_Mx[5] : *this\_Mx[5]=*this\_Mx[7] : *this\_Mx[7]=t
 ProcedureReturn *this
 
EndProcedure

;Inverse

Procedure.l TMatrix33_inverse(*result.TMATRIX33,*m1.TMATRIX33)

 Protected det.d=TMatrix33_determinant(*m1)
 If Abs(det)<#EPSILON
  TMatrix33_normal(*result)
 Else
  *result\_Mx[0]=*m1\_Mx[4]**m1\_Mx[8] - *m1\_Mx[5]**m1\_Mx[7]
  *result\_Mx[1]=*m1\_Mx[7]**m1\_Mx[2] - *m1\_Mx[8]**m1\_Mx[1]
  *result\_Mx[2]=*m1\_Mx[1]**m1\_Mx[5] - *m1\_Mx[2]**m1\_Mx[4]
  *result\_Mx[3]=*m1\_Mx[5]**m1\_Mx[6] - *m1\_Mx[3]**m1\_Mx[8]
  *result\_Mx[4]=*m1\_Mx[8]**m1\_Mx[0] - *m1\_Mx[6]**m1\_Mx[2]
  *result\_Mx[5]=*m1\_Mx[2]**m1\_Mx[3] - *m1\_Mx[0]**m1\_Mx[5]
  *result\_Mx[6]=*m1\_Mx[3]**m1\_Mx[7] - *m1\_Mx[4]**m1\_Mx[6]
  *result\_Mx[7]=*m1\_Mx[6]**m1\_Mx[1] - *m1\_Mx[7]**m1\_Mx[0]
  *result\_Mx[8]=*m1\_Mx[0]**m1\_Mx[4] - *m1\_Mx[1]**m1\_Mx[3]
  TMatrix33_multiply(*result,*result,1.0/det) ;result=result*(1.0/det)
 EndIf
 ProcedureReturn *result
 
EndProcedure

[dige]

Wow, thats pretty cool!!! @hagibaba: Thank you again and again!!

[benny]

Wow, thats pretty cool!!! @hagibaba: Thank you again and again!!

I second that

[THCM]

Awesome!

[Magus1011]

What a wonderfull example of traditional Windows Programming and Event handling.

@hagibaba: Thank you very much for a great example!
--
Best Regards,
Magus.

[Dare]

Hi hagibaba,

Great tutorial examples on your page!

Some have to have debugger turned off to run otherwise they get an invalid memory access on my box (line number shown appears to be beyond the end of the include file).

I am not smart enough to follow your code (yet) and don't have a clue about where it happens, whether this is only an issue with debugger on (or fails gracefully with it off) and how to get around it.

Can you advise on this? Thanks.

Regardless, this is pretty cool and lots of learning material here. Thanks!

[Andre]

I didn't check the tutorial examples myself.
But as it seems, it could be a very good addition to the CodeArchiv.

So if you agree, hagibaba, I will add them.

[hagibaba]

Hi Dare, thanks.

I don't know why you get a IMA with Debugger on with some of them.
This one works ok with debug on or off on my machine so I don't think
I can help. I would suggest if you're going to try debugging the problem
to find the simplest lesson it happens on and comment out stuff until it
stops. Also, the code for this lesson is beyond my understanding as well.
Collisions are a very complex topic.

Hi Andre,

yes please, do add them to the CodeArchiv that would be great thanks.
I will do more lessons when I can find the time.

[Dare]

Hi hagibaba.

Thanks for the response. (lesson 30 runs fine, btw, it is some of the others that don't).

I think it is somewhere in the area of code that begins:

Code: Select all

;glaux.lib symbols
!public ___ftoll
!___ftoll dw 0
!public __imp__wsprintfA
!__imp__wsprintfA dw 0

Import "glaux.lib"
; .... etc

But haven't really gone into it yet. * panics at the thought *

Thanks again.

[Andre]

Hi Andre,

yes please, do add them to the CodeArchiv that would be great thanks.
I will do more lessons when I can find the time.

Ok, thanks. Then I will do this...

And if needed ask related questions here.

[mpz]

Hello,

next code actualised for x86/x64, PB 5.73.

Sorry, but you "must" get the original texture from the internet, i have not purebasic textures for that

P.S:I think the code can work with linux and mac Osx too.


Greetings Michael

C Code and texture
iamyaker.googlepages.com/30_Collide.rar

Code: Select all

;NeHe's Collision Detection Tutorial (Lesson 30) 
;http://nehe.gamedev.net
;https://nehe.gamedev.net/tutorial/collision_detection/17005/
;Credits: Nico Gruener, Dreglor, traumatic, hagibaba
;Author: MPz
;Date: 29 Oct 2021
;Note: up-to-date with PB v5.73 (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" 

;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.i 
EndStructure 

Global DMsaved.DEVMODE ;Saves The Previous Screen Settings 

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.i=0 ;Hook Camera to Ball 
Global sounds.i=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.i ;Quadratic Object To Render The Cylinders 
Global Dim texture.i(5) ;Stores Texture Objects 
Global dlist.i ;Stores Display List 

;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 ImageLoad(filename.s,*image.IMAGE) 

 Protected file.i 
 Protected size.i ;Size Of The Image In Bytes 
 Protected i.i ;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 
 Debug size
 
 planes=ReadWord(file) ;Read The Planes 
  Debug 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
 
 Debug 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

 CloseFile(file) 
 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 
   Debug "Data/Marble.bmp"
   ProcedureReturn 0 
 EndIf
 
If ImageLoad("Data/Spark.bmp",image2)=0 
     Debug "Data/Spark.bmp"
   ProcedureReturn 0 
 EndIf 
 
 If ImageLoad("Data/Boden.bmp",image3)=0 
   Debug "Data/Boden.bmp"
   ProcedureReturn 0 
 EndIf 
 If ImageLoad("Data/Wand.bmp",image4)=0 
   Debug "Data/Wand.bmp"
   ProcedureReturn 0 
 EndIf 
 
 Debug "textur"
 Debug @texture(0)
 Debug @texture(1)
 Debug @texture(2)
 Debug @texture(3)
 Debug @texture(4)
 
 glGenTextures_(5,@texture(0)) 
 Debug "textur"
 Debug texture(0)
 Debug texture(1)
 Debug texture(2)
 Debug texture(3)
 Debug texture(4)
 
 ;glGenTextures_(1,@texture(0)) 
 ;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) 
 
 Debug "size"
 Debug image1\sizeX * image1\sizeY
 Debug image1\sizeX 
 Debug image2\sizeX * image2\sizeY
 Debug image2\sizeX 
 Debug image3\sizeX * image3\sizeY
 Debug image3\sizeX 
 Debug image4\sizeX * image4\sizeY
 Debug image4\sizeX 
 
 ; glGenTextures_(1,@texture(1)) 
 
 ;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_(1,@texture(2)) 
 ;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) 
 
 ;glGenTextures_(1,@texture(3)) 
 
 ;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) 
 
  Debug "textur"
 Debug PeekI(@texture(0))
 Debug PeekI(@texture(1))
 Debug PeekI(@texture(2))
 Debug PeekI(@texture(3))
 Debug PeekI(@texture(4))
 
 
 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 
 
 ResizeGadget(0, 0, 0, width, height)
 
 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.i 
 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 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 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 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 FindBallCol(*point.TVECTOR,*TimePoint.DOUBLE,Time2.d,*BallNr1.INTEGER,*BallNr2.INTEGER) 

 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.i,j.i 
  
 ;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\i=i 
     *BallNr2\i=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.i=0,BallColNr1.i,BallColNr2.i 
 Protected i.i,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 DrawScene(Gadget)
 
 Protected i.i
  
 SetGadgetAttribute(Gadget, #PB_OpenGL_SetContext, #True)
  
 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 
 
 SetGadgetAttribute(Gadget, #PB_OpenGL_FlipBuffers, #True)
 
 ProcedureReturn #True ;Keep Going 
      
EndProcedure

Procedure CreateGLWindow(title.s,WindowWidth.l,WindowHeight.l,bits.l=16,fullscreenflag.b=0,Vsync.b=0)
  
  If InitKeyboard() = 0 Or InitSprite() = 0 Or InitMouse() = 0
    MessageRequester("Error", "Can't initialize Keyboards or Mouse", 0)
    End
  EndIf

  If fullscreenflag
    hWnd = OpenWindow(0, 0, 0, WindowWidth, WindowHeight, title, #PB_Window_BorderLess|#PB_Window_Maximize )
    OpenWindowedScreen(WindowID(0), 0, 0,WindowWidth(0),WindowHeight(0)) 
  Else  
    hWnd = OpenWindow(0, 1, 1, WindowWidth, WindowHeight, title,#PB_Window_MinimizeGadget |  #PB_Window_MaximizeGadget | #PB_Window_SizeGadget ) 
    OpenWindowedScreen(WindowID(0), 1, 1, WindowWidth,WindowHeight) 
  EndIf
  
  If bits = 24
    OpenGlFlags + #PB_OpenGL_24BitDepthBuffer 
  EndIf
  
  If bits = 32
    OpenGlFlags + #PB_OpenGL_24BitDepthBuffer + #PB_OpenGL_8BitStencilBuffer
  EndIf
  
  If Vsync = 0
    OpenGlFlags + #PB_OpenGL_NoFlipSynchronization
  EndIf
  
  OpenGLGadget(0, 0, 0, WindowWidth(0),WindowHeight(0),OpenGlFlags)
  
  SetActiveGadget(0) 
  
  ReSizeGLScene(WindowWidth(0),WindowHeight(0))
  ;hDC = GetDC_(hWnd)
  
EndProcedure


InitVars() 

CreateGLWindow("NeHe's Collision Detection Tutorial (Lesson 30) ",640,480,16,0,1)

InitGL() 


Repeat

  Repeat 
    Event = WindowEvent()
    Select Event
      Case #PB_Event_CloseWindow
        Quit = 1
      Case #PB_Event_SizeWindow  
        ReSizeGLScene(WindowWidth(0),WindowHeight(0)) ;LoWord=Width, HiWord=Height
    EndSelect
  
  Until Event = 0
  
  ExamineKeyboard()
        
  If KeyboardPushed(#PB_Key_Escape)    ; // push ESC key
    Quit = 1                               ; // This is the end
  EndIf
  
  If KeyboardPushed(#PB_Key_Up) And pos\_z>400 ;Up Arrow 
    pos\_z-10 
  EndIf
  
  If KeyboardPushed(#PB_Key_Down) And pos\_z<1200 ;Down Arrow 
   pos\_z+10 
  EndIf 
  
  If KeyboardPushed(#PB_Key_Left) ;Left Arrow 
   camera_rotation+2 
  EndIf 
  
  If KeyboardPushed(#PB_Key_Right) ;Right Arrow 
   camera_rotation-2 
  EndIf 
  
  If KeyboardPushed(#PB_Key_Add) And Time<2.5 And Addp=0;Numpad + Key 
    Addp=#True
    Time+0.1 
  ElseIf Not KeyboardPushed(#PB_Key_Add)
   Addp=#False 
 EndIf 
  
 If KeyboardPushed(#PB_Key_Subtract) And Time>0.0 And Subp = 0;Numpad - Key 
   Subp = #True
   Time-0.1 
 ElseIf Not KeyboardPushed(#PB_Key_Subtract)
   Subp=#False 
 EndIf 
  
 If KeyboardPushed(#PB_Key_F2) And F2p=0 ;F2 Key 
   F2p=#True
   hook_toball1=~hook_toball1 & 1 ;Toggle Hook Camera To Ball 
   camera_rotation=0 
 ElseIf Not KeyboardPushed(#PB_Key_F2)
   F2p=#False 
 EndIf
 
 If KeyboardPushed(#PB_Key_F3) And F3p=0;F3 Key 
   F3p=#True
   sounds=~sounds & 1 ;Toggle Sound 
 ElseIf Not KeyboardPushed(#PB_Key_F3)
   F3p=#False 
 EndIf   
  idle()
  DrawScene(0)
  
Until Quit = 1

Collisions.pb

Code: Select all

;Include File For Collisions (Lesson 30) 

;Mathex.h 

#EPSILON=1.0e-8 ;General maths constants 
#ZERO=#EPSILON 
#M_PI=3.1415926535 

Procedure.d T_limit(x.d,lower.d,upper.d) ;Limit range of value 
 If x<lower 
  ProcedureReturn lower 
 EndIf 
 If x>upper 
  ProcedureReturn upper 
 EndIf 
 ProcedureReturn x 
EndProcedure 

Procedure.d T_sqr(x.d) ;Square of value (power of 2) 
 ProcedureReturn x*x 
EndProcedure 

Procedure.d T_RadToDeg(rad.d) ;Convert radian to degree 
 ProcedureReturn ((rad*180.0)/#M_PI) 
EndProcedure 

Procedure.d T_DegToRad(deg.d) ;Convert degree to radian 
 ProcedureReturn ((deg*#M_PI)/180.0) 
EndProcedure 

;Structures 

Structure TVECTOR ;Vector (point or direction) 
 _x.d : _y.d : _z.d : _Status.i 
EndStructure 

Structure TRAY ;Line or Ray 
 _P.TVECTOR ;Any point on the line 
 _V.TVECTOR ;Direction of the line 
EndStructure 

Structure TMATRIX33 ;Matrix (3 by 3) 
 _Mx.d[3*3] 
EndStructure 

;TVector.h, TVector.cpp 

;#INVALID=0 ;TVector constants (Note: I've used numbers instead) 
;#DEFAULT=1 
;#UNIT=2 

;Constructors 

Procedure TVector_reset(*this.TVECTOR) ;this=0,0,0,#INVALID 
 *this\_x=0.0 
 *this\_y=0.0 
 *this\_z=0.0 
 *this\_Status=0 ;#INVALID 
EndProcedure 

Procedure TVector_make(*this.TVECTOR,x.d,y.d,z.d) ;this=x,y,z,#DEFAULT 
 *this\_x=x 
 *this\_y=y 
 *this\_z=z 
 *this\_Status=1 ;#DEFAULT 
EndProcedure 

Procedure TVector_set(*this.TVECTOR,*v.TVECTOR) ;this=v 
 *this\_x=*v\_x 
 *this\_y=*v\_y 
 *this\_z=*v\_z 
 *this\_Status=*v\_Status 
EndProcedure 

Declare.b TRay_adjacentPoints(*this.TRAY,*ray.TRAY,*point1.TVECTOR,*point2.TVECTOR) 

;Mid point between two lines 

Procedure TVector_midpoint(*this.TVECTOR,*ray1.TRAY,*ray2.TRAY) ;Mid point between two rays 

 Protected point1.TVECTOR,point2.TVECTOR 
 If TRay_adjacentPoints(*ray1,*ray2,point1,point2) 
  *this\_x=(point1\_x+point2\_x)*0.5 
  *this\_y=(point1\_y+point2\_y)*0.5 
  *this\_z=(point1\_z+point2\_z)*0.5 
 Else 
  TVector_reset(*this) 
 EndIf 
  
EndProcedure 

;Selectors 

Procedure.d TVector_X(*this.TVECTOR) ;d=this\_x 
 ProcedureReturn *this\_x 
EndProcedure 

Procedure.d TVector_Y(*this.TVECTOR) ;d=this\_y 
 ProcedureReturn *this\_y 
EndProcedure 

Procedure.d TVector_Z(*this.TVECTOR) ;d=this\_z 
 ProcedureReturn *this\_z 
EndProcedure 

Procedure TVector_isUnit(*this.TVECTOR) ;this\_Status=#UNIT 
 If *this\_Status=2 
  ProcedureReturn *this\_Status 
 EndIf 
EndProcedure 

Procedure TVector_isDefault(*this.TVECTOR) ;this\_Status=#DEFAULT 
 If *this\_Status=1 
  ProcedureReturn *this\_Status 
 EndIf 
EndProcedure 

Procedure TVector_isValid(*this.TVECTOR) ;this\_Status<>INVALID 
 If *this\_Status<>0 
  ProcedureReturn *this\_Status 
 EndIf 
EndProcedure 

Declare.d TVector_mag(*this.TVECTOR) 

;Change the status of a vector 

Procedure TVector_unit(*this.TVECTOR) ;Make a unit vector 

 If TVector_isDefault(*this) 
  Protected REP.d=TVector_mag(*this) 
  If REP<#EPSILON 
   *this\_x=0.0 
   *this\_y=0.0 
   *this\_z=0.0 
  Else 
   Protected temp.d=1.0/REP 
   *this\_x*temp 
   *this\_y*temp 
   *this\_z*temp 
  EndIf 
  *this\_Status=2 ;#UNIT 
 EndIf 
 ProcedureReturn *this 
  
EndProcedure 

Procedure TVector_setunit(*result.TVECTOR,*v.TVECTOR) 
 TVector_set(*result,*v) ;result=v 
 ProcedureReturn TVector_unit(*result) ;result.unit() 
EndProcedure 

Procedure TVector_default(*this.TVECTOR) ;Make a default vector 

 If TVector_isUnit(*this) 
  *this\_Status=1 ;#DEFAULT 
 EndIf 
 ProcedureReturn *this 
  
EndProcedure 

Procedure TVector_setdefault(*result.TVECTOR,*v.TVECTOR) 
 TVector_set(*result,*v) ;result=v 
 ProcedureReturn TVector_default(*result) ;result.default() 
EndProcedure 

;Magnitude 

Procedure.d TVector_mag(*this.TVECTOR) 
 If TVector_isValid(*this) 
  If TVector_isUnit(*this) 
   ProcedureReturn 1.0 
  Else 
   ProcedureReturn Sqr(T_sqr(*this\_x) + T_sqr(*this\_y) + T_sqr(*this\_z)) 
  EndIf 
 Else 
  ProcedureReturn 0.0 
 EndIf 
EndProcedure 

Procedure.d TVector_magSqr(*this.TVECTOR) 
 If TVector_isValid(*this) 
  If TVector_isUnit(*this) 
   ProcedureReturn 1.0 
  Else 
   ProcedureReturn (T_sqr(*this\_x) + T_sqr(*this\_y) + T_sqr(*this\_z)) 
  EndIf 
 Else 
  ProcedureReturn 0.0 
 EndIf 
EndProcedure 

;Dot or scalar product 

Procedure.d TVector_dot(*this.TVECTOR,*v.TVECTOR) 
 If TVector_isValid(*this) And TVector_isValid(*v) 
  ProcedureReturn (*this\_x**v\_x + *this\_y**v\_y + *this\_z**v\_z) 
 Else 
  ProcedureReturn 0.0 
 EndIf 
EndProcedure 

Declare TVector_subtract(*result.TVECTOR,*v1.TVECTOR,*v2.TVECTOR) 

;Distance between two vectors 

Procedure.d TVector_dist(*this.TVECTOR,*v.TVECTOR) 
 Protected tv.TVECTOR 
 TVector_subtract(tv,*this,*v) ;tv=this-v 
 ProcedureReturn TVector_mag(tv) ;tv.mag() 
EndProcedure 

Procedure.d TVector_distSqr(*this.TVECTOR,*v.TVECTOR) 
 Protected tv.TVECTOR 
 TVector_subtract(tv,*this,*v) ;tv=this-v 
 ProcedureReturn TVector_magSqr(tv) ;tv.magSqr() 
EndProcedure 

;Optimised arithmetic methods 

Procedure TVector_add(*result.TVECTOR,*v1.TVECTOR,*v2.TVECTOR) 

 If TVector_isValid(*v1) And TVector_isValid(*v2) 
  *result\_x=*v1\_x+*v2\_x 
  *result\_y=*v1\_y+*v2\_y 
  *result\_z=*v1\_z+*v2\_z 
  *result\_Status=1 ;#DEFAULT 
 Else 
  TVector_reset(*result) 
 EndIf 
 ProcedureReturn *result 
  
EndProcedure 

Procedure TVector_subtract(*result.TVECTOR,*v1.TVECTOR,*v2.TVECTOR) 

 If TVector_isValid(*v1) And TVector_isValid(*v2) 
  *result\_x=*v1\_x-*v2\_x 
  *result\_y=*v1\_y-*v2\_y 
  *result\_z=*v1\_z-*v2\_z 
  *result\_Status=1 ;#DEFAULT 
 Else 
  TVector_reset(*result) 
 EndIf 
 ProcedureReturn *result 
  
EndProcedure 

Procedure TVector_cross(*result.TVECTOR,*v1.TVECTOR,*v2.TVECTOR) 

 If TVector_isValid(*v1) And TVector_isValid(*v2) 
  *result\_x=*v1\_y**v2\_z - *v1\_z**v2\_y 
  *result\_y=*v1\_z**v2\_x - *v1\_x**v2\_z 
  *result\_z=*v1\_x**v2\_y - *v1\_y**v2\_x 
  *result\_Status=1 ;#DEFAULT 
 Else 
  TVector_reset(*result) 
 EndIf 
 ProcedureReturn *result 
  
EndProcedure 

Procedure TVector_invert(*result.TVECTOR,*v1.TVECTOR) 

 If TVector_isValid(*v1) 
  *result\_x=-*v1\_x 
  *result\_y=-*v1\_y 
  *result\_z=-*v1\_z 
  *result\_Status=*v1\_Status 
 Else 
  TVector_reset(*result) 
 EndIf 
 ProcedureReturn *result 
  
EndProcedure 

Procedure TVector_multiply(*result.TVECTOR,*v1.TVECTOR,scale.d) 

 If TVector_isValid(*v1) 
  *result\_x=*v1\_x*scale 
  *result\_y=*v1\_y*scale 
  *result\_z=*v1\_z*scale 
  *result\_Status=1 ;#DEFAULT 
 Else 
  TVector_reset(*result) 
 EndIf 
 ProcedureReturn *result 
  
EndProcedure 

;TRay.h, TRay.cpp 

;Line between two points OR point and a direction 

Procedure TRay_setunit(*this.TRAY,*point1.TVECTOR,*point2.TVECTOR) ;Line between two points OR point and a direction 

 TVector_set(*this\_P,*point1) ;this\_P=point1 
 If TVector_isUnit(*point2) 
  TVector_set(*this\_V,*point2) ;this\_V=point2 
 Else 
  TVector_subtract(*this\_V,*point2,*point1) ;this\_V=point2-point1 
  TVector_unit(*this\_V) ;this\_V.unit() 
 EndIf 
  
EndProcedure 

Declare TRay_isValid(*this.TRAY) 

;Adjacent points on both lines 

Procedure.b TRay_adjacentPoints(*this.TRAY,*ray.TRAY,*point1.TVECTOR,*point2.TVECTOR) 

 If TRay_isValid(*this) And TRay_isValid(*ray) 
  Protected temp.d=TVector_dot(*this\_V,*ray\_V) 
  Protected temp2.d=1.0-T_sqr(temp) 
  Protected mu.d,a.d,b.d,lambda.d 
  Protected tv.TVECTOR ;Temporary vector to enable use of optimised routines 
  ;Check for parallel rays 
  If Abs(temp2)<#EPSILON 
   TVector_subtract(tv,*this\_P,*ray\_P) ;tv=this\_P-ray\_P 
   mu=TVector_dot(*this\_V,tv)/temp 
   TVector_set(*point1,*this\_P) ;point1=this\_P 
   TVector_add(*point2,*ray\_P,TVector_multiply(tv,*ray\_V,mu)) ;point2=ray\_P+(ray\_V*mu) 
  Else 
   a=TVector_dot(*this\_V,TVector_subtract(tv,*ray\_P,*this\_P)) ;tv=ray\_P-this\_P 
   b=TVector_dot(*ray\_V,TVector_subtract(tv,*this\_P,*ray\_P)) ;tv=this\_P-ray\_P 
   mu=(b+temp*a)/temp2 
   lambda=(a+temp*b)/temp2 
   TVector_add(*point1,*this\_P,TVector_multiply(tv,*this\_V,lambda)) ;point1=this\_P+(this\_V*lambda) 
   TVector_add(*point2,*ray\_P,TVector_multiply(tv,*ray\_V,mu)) ;point2=ray\_P+(ray\_V*mu) 
  EndIf 
  ProcedureReturn #True 
 EndIf 
 ProcedureReturn #False 
  
EndProcedure 

;Unary operator 

Procedure TRay_invert(*result.TRAY,*ray.TRAY) 
 TVector_set(*result\_P,*ray\_P) ;result\_P=ray\_P 
 TVector_invert(*result\_V,*ray\_V) ;*result\_V=-ray\_V 
 ProcedureReturn *result 
EndProcedure 

;Selectors 

Procedure TRay_P(*this.TRAY) ;this\_P 
 ProcedureReturn *this\_P 
EndProcedure 

Procedure TRay_V(*this.TRAY) ;this\_V 
 ProcedureReturn *this\_V 
EndProcedure 

Procedure TRay_isValid(*this.TRAY) 
 ProcedureReturn (TVector_isUnit(*this\_V) | TVector_isValid(*this\_P)) 
EndProcedure 

;Distances 

Procedure.d TRay_raydist(*this.TRAY,*ray.TRAY) ;Distance between two rays 

 Protected point1.TVECTOR,point2.TVECTOR 
 If TRay_adjacentPoints(*this,*ray,point1,point2) 
  ProcedureReturn TVector_dist(point1,point2) 
 Else 
  ProcedureReturn 0.0 
 EndIf 
  
EndProcedure 

Procedure.d TRay_pointdist(*this.TRAY,*point.TVECTOR) ;Distance between a ray and a point 

 If TRay_isValid(*this) And TVector_isValid(*point) 
  Protected tv.TVECTOR,point2.TVECTOR 
  Protected lambda.d 
  TVector_subtract(tv,*point,*this\_P) ;tv=point-this\_P 
  lambda=TVector_dot(*this\_V,tv) 
  TVector_add(point2,*this\_P,TVector_multiply(tv,*this\_V,lambda)) ;point2=this\_P+(this\_V*lambda) 
  ProcedureReturn TVector_dist(*point,point2) 
 EndIf 
 ProcedureReturn 0.0 
  
EndProcedure 

;TMatrix.h, TMatrix.cpp 

;_Mx[0,0]=x1, _Mx[0,1]=y1, _Mx[0,2]=z1 
;_Mx[1,0]=x2, _Mx[1,1]=y2, _Mx[1,2]=z2 
;_Mx[2,0]=x3, _Mx[2,1]=y3, _Mx[2,2]=z3 

;Constructors 

Procedure TMatrix33_normal(*this.TMATRIX33) 

 *this\_Mx[0]=1.0 : *this\_Mx[1]=0.0 : *this\_Mx[2]=0.0 
 *this\_Mx[3]=0.0 : *this\_Mx[4]=1.0 : *this\_Mx[5]=0.0 
 *this\_Mx[6]=0.0 : *this\_Mx[7]=0.0 : *this\_Mx[8]=1.0 
  
EndProcedure 

Procedure TMatrix33_make(*this.TMATRIX33,mx00.d,mx01.d,mx02.d,mx10.d,mx11.d,mx12.d,mx20.d,mx21.d,mx22.d) 

 *this\_Mx[0]=mx00 : *this\_Mx[1]=mx01 : *this\_Mx[2]=mx02 
 *this\_Mx[3]=mx10 : *this\_Mx[4]=mx11 : *this\_Mx[5]=mx12 
 *this\_Mx[6]=mx20 : *this\_Mx[7]=mx21 : *this\_Mx[8]=mx22 
  
EndProcedure 

Procedure TMatrix33_cosine(*this.TMATRIX33,Phi.d,Theta.d,Psi.d) 

 Protected c1.d=Cos(Phi),c2.d=Cos(Theta),c3.d=Cos(Psi) 
 Protected s1.d=Sin(Phi),s2.d=Sin(Theta),s3.d=Sin(Psi) 
 *this\_Mx[0]=c2*c3 
 *this\_Mx[1]=-c2*s3 
 *this\_Mx[2]=s2 
 *this\_Mx[3]=s1*s2*c3+c1*s3 
 *this\_Mx[4]=-s1*s2*s3+c1*c3 
 *this\_Mx[5]=-s1*c2 
 *this\_Mx[6]=-c1*s2*c3+s1*s3 
 *this\_Mx[7]=c1*s2*s3+s1*c3 
 *this\_Mx[8]=c1*c2 
  
EndProcedure 

;Selectors 

Procedure.d TMatrix33_get(*this.TMATRIX33,Row.l,Column.l) 
 ProcedureReturn *this\_Mx[(3*Row)+Column] 
EndProcedure 

;Optimised artimetric methods 

Procedure TMatrix33_add(*result.TMATRIX33,*m1.TMATRIX33,*m2.TMATRIX33) 

 *result\_Mx[0]=*m1\_Mx[0]+*m2\_Mx[0] 
 *result\_Mx[1]=*m1\_Mx[1]+*m2\_Mx[1] 
 *result\_Mx[2]=*m1\_Mx[2]+*m2\_Mx[2] 
 *result\_Mx[3]=*m1\_Mx[3]+*m2\_Mx[3] 
 *result\_Mx[4]=*m1\_Mx[4]+*m2\_Mx[4] 
 *result\_Mx[5]=*m1\_Mx[5]+*m2\_Mx[5] 
 *result\_Mx[6]=*m1\_Mx[6]+*m2\_Mx[6] 
 *result\_Mx[7]=*m1\_Mx[7]+*m2\_Mx[7] 
 *result\_Mx[8]=*m1\_Mx[8]+*m2\_Mx[8] 
 ProcedureReturn *result 
  
EndProcedure 

Procedure TMatrix33_subtract(*result.TMATRIX33,*m1.TMATRIX33,*m2.TMATRIX33) 

 *result\_Mx[0]=*m1\_Mx[0]-*m2\_Mx[0] 
 *result\_Mx[1]=*m1\_Mx[1]-*m2\_Mx[1] 
 *result\_Mx[2]=*m1\_Mx[2]-*m2\_Mx[2] 
 *result\_Mx[3]=*m1\_Mx[3]-*m2\_Mx[3] 
 *result\_Mx[4]=*m1\_Mx[4]-*m2\_Mx[4] 
 *result\_Mx[5]=*m1\_Mx[5]-*m2\_Mx[5] 
 *result\_Mx[6]=*m1\_Mx[6]-*m2\_Mx[6] 
 *result\_Mx[7]=*m1\_Mx[7]-*m2\_Mx[7] 
 *result\_Mx[8]=*m1\_Mx[8]-*m2\_Mx[8] 
 ProcedureReturn *result 
  
EndProcedure 

Procedure TMatrix33_dot33(*result.TMATRIX33,*m1.TMATRIX33,*m2.TMATRIX33) 

 *result\_Mx[0]=*m1\_Mx[0]**m2\_Mx[0] + *m1\_Mx[1]**m2\_Mx[3] + *m1\_Mx[2]**m2\_Mx[6] 
 *result\_Mx[3]=*m1\_Mx[3]**m2\_Mx[0] + *m1\_Mx[4]**m2\_Mx[3] + *m1\_Mx[5]**m2\_Mx[6] 
 *result\_Mx[6]=*m1\_Mx[6]**m2\_Mx[0] + *m1\_Mx[7]**m2\_Mx[3] + *m1\_Mx[8]**m2\_Mx[6] 
 *result\_Mx[1]=*m1\_Mx[0]**m2\_Mx[1] + *m1\_Mx[1]**m2\_Mx[4] + *m1\_Mx[2]**m2\_Mx[7] 
 *result\_Mx[4]=*m1\_Mx[3]**m2\_Mx[1] + *m1\_Mx[4]**m2\_Mx[4] + *m1\_Mx[5]**m2\_Mx[7] 
 *result\_Mx[7]=*m1\_Mx[6]**m2\_Mx[1] + *m1\_Mx[7]**m2\_Mx[4] + *m1\_Mx[8]**m2\_Mx[7] 
 *result\_Mx[2]=*m1\_Mx[0]**m2\_Mx[2] + *m1\_Mx[1]**m2\_Mx[5] + *m1\_Mx[2]**m2\_Mx[8] 
 *result\_Mx[5]=*m1\_Mx[3]**m2\_Mx[2] + *m1\_Mx[4]**m2\_Mx[5] + *m1\_Mx[5]**m2\_Mx[8] 
 *result\_Mx[8]=*m1\_Mx[6]**m2\_Mx[2] + *m1\_Mx[7]**m2\_Mx[5] + *m1\_Mx[8]**m2\_Mx[8] 
 ProcedureReturn *result 
  
EndProcedure 

Procedure TMatrix33_multiply(*result.TMATRIX33,*m1.TMATRIX33,scale.d) 

 *result\_Mx[0]=*m1\_Mx[0]*scale 
 *result\_Mx[1]=*m1\_Mx[1]*scale 
 *result\_Mx[2]=*m1\_Mx[2]*scale 
 *result\_Mx[3]=*m1\_Mx[3]*scale 
 *result\_Mx[4]=*m1\_Mx[4]*scale 
 *result\_Mx[5]=*m1\_Mx[5]*scale 
 *result\_Mx[6]=*m1\_Mx[6]*scale 
 *result\_Mx[7]=*m1\_Mx[7]*scale 
 *result\_Mx[8]=*m1\_Mx[8]*scale 
 ProcedureReturn *result 
  
EndProcedure 

Procedure TMatrix33_dot(*result.TVECTOR,*m1.TMATRIX33,*v.TVECTOR) 

 Protected a.d,b.d,c.d 
 a=*m1\_Mx[0]**v\_x + *m1\_Mx[1]**v\_y + *m1\_Mx[2]**v\_z 
 b=*m1\_Mx[3]**v\_x + *m1\_Mx[4]**v\_y + *m1\_Mx[5]**v\_z 
 c=*m1\_Mx[6]**v\_x + *m1\_Mx[7]**v\_y + *m1\_Mx[8]**v\_z 
 TVector_make(*result,a,b,c) 
 ProcedureReturn *result 
  
EndProcedure 

;Determinants 

Procedure.d TMatrix33_determinant(*this.TMATRIX33) 

 Protected a.d,b.d,c.d 
 a=*this\_Mx[0] * (*this\_Mx[4]**this\_Mx[8] - *this\_Mx[5]**this\_Mx[7]) 
 b=*this\_Mx[1] * (*this\_Mx[3]**this\_Mx[8] - *this\_Mx[5]**this\_Mx[6]) 
 c=*this\_Mx[2] * (*this\_Mx[3]**this\_Mx[7] - *this\_Mx[4]**this\_Mx[6]) 
 ProcedureReturn (a-b+c) 
  
EndProcedure 

;Transpose 

Procedure TMatrix33_transpose(*this.TMATRIX33) 

 Protected t.d 
 t=*this\_Mx[2] : *this\_Mx[2]=*this\_Mx[6] : *this\_Mx[6]=t 
 t=*this\_Mx[1] : *this\_Mx[1]=*this\_Mx[3] : *this\_Mx[3]=t 
 t=*this\_Mx[5] : *this\_Mx[5]=*this\_Mx[7] : *this\_Mx[7]=t 
 ProcedureReturn *this 
  
EndProcedure 

;Inverse 

Procedure TMatrix33_inverse(*result.TMATRIX33,*m1.TMATRIX33) 

 Protected det.d=TMatrix33_determinant(*m1) 
 If Abs(det)<#EPSILON 
  TMatrix33_normal(*result) 
 Else 
  *result\_Mx[0]=*m1\_Mx[4]**m1\_Mx[8] - *m1\_Mx[5]**m1\_Mx[7] 
  *result\_Mx[1]=*m1\_Mx[7]**m1\_Mx[2] - *m1\_Mx[8]**m1\_Mx[1] 
  *result\_Mx[2]=*m1\_Mx[1]**m1\_Mx[5] - *m1\_Mx[2]**m1\_Mx[4] 
  *result\_Mx[3]=*m1\_Mx[5]**m1\_Mx[6] - *m1\_Mx[3]**m1\_Mx[8] 
  *result\_Mx[4]=*m1\_Mx[8]**m1\_Mx[0] - *m1\_Mx[6]**m1\_Mx[2] 
  *result\_Mx[5]=*m1\_Mx[2]**m1\_Mx[3] - *m1\_Mx[0]**m1\_Mx[5] 
  *result\_Mx[6]=*m1\_Mx[3]**m1\_Mx[7] - *m1\_Mx[4]**m1\_Mx[6] 
  *result\_Mx[7]=*m1\_Mx[6]**m1\_Mx[1] - *m1\_Mx[7]**m1\_Mx[0] 
  *result\_Mx[8]=*m1\_Mx[0]**m1\_Mx[4] - *m1\_Mx[1]**m1\_Mx[3] 
  TMatrix33_multiply(*result,*result,1.0/det) ;result=result*(1.0/det) 
 EndIf 
 ProcedureReturn *result 
  
EndProcedure