2d Polygon collision Module

Miscellaneous Forums/Blitz Showcase/2d Polygon collision Module

Tibit
 #1
I improved the code a little (atleast to my liking) I made methods out of the functions. Which made the implentation much more trival (easier).
Ex instead of :

ship:dPoly = dPoly.Create()
dPoly.Poly_AddVertex(ship,0,-5)
dPoly.Poly_Resize(ship,10,10)
ship1:dPoly = dPoly.Poly_Copy(ship)

You would Do:
Ship:Polygon = Polygon.Create()
Ship.AddVertex(0,-5)
Ship.Resize(10,10)
Ship2:Polygon = Ship.Copy()

It helps me to speed up the coding =)

I also added a example line infront of each function

And I made a new example to test the Polygon-Type. Even thou I do not use it as a module here below just un-comment the import part and make sure you name everything correctly and it should still work as a stand alone module. 

Strict

'TO TEST RUN
Graphics 800,600,0',300'16,500

Global Poly1:TPolygon = TPolygon.Create()
'This creates a box with size 100x100
Poly1.Add(-50,-50)
Poly1.Add(50,-50)
Poly1.Add(50,50)
Poly1.Add(-50,50)
Poly1.Add(-50,-50)
Global Poly2:TPolygon = Poly1.Copy()
Global Rect:TPolygon  = Poly1.Copy()

Global X,Y 'This is for the test ball
Global GW = GraphicsWidth()/2 , GH = GraphicsHeight()/2 'Center everything so that we look from the coordinates 0,0 in the middle

Local Fps:FpsCounter = New FPSCounter
While Not KeyDown(Key_Escape)

	If Poly1 And Poly2
	
		If KeyHit(1) Poly1.Add( MouseX()-GW,MouseY()-GH )	'LeftMouse
		
		If KeyHit(2) Poly1.Add( Poly1.ix[0],Poly1.iy[0] )'Join back to start 'Right Mouse
		
		If KeyHit(Key_Space) Poly1 = TPolygon.Create() 'Start on a new Polygon
		
		Plot MouseX(),MouseY()	 'Mark Mouse

		Poly1.Draw( GW,GH )
		
		Poly2.Remove()
		Poly2 = Poly1.Copy() 'Make a copy of the polygon
		Poly2.Scale( 0.1 , 0.1 )'10% smaller
		Poly2.Draw( MouseX(), MouseY() )
		
		If PolygonOverlap(Poly1,GW,GH,Poly2,MouseX(), MouseY() ,False )
			DrawText "< <   C O L L I S I O N   D E T E C T E D   > >" , 0,0
		EndIf
		
		If PolygonOverlap(Poly1,GW,GH,Rect,X,Y,False )
			DrawText "< <   C O L L I S I O N   D E T E C T E D   > >" , 2,0
		EndIf	
			
		If PolygonOverlap(Poly2,MouseX(),MouseY(),Rect,X,Y,False )
			DrawText "< <   C O L L I S I O N   D E T E C T E D   > >" , 0,2
		EndIf		

	EndIf

		Rect.Draw(X,Y) ; X:+Rand(-2,2) ;Y:+Rand(-1,1)'Draw and shake the ball		
		
		DrawText( "X: "+MouseX()+"  Y: "+MouseY(),20,20 ) 
		FPS.CalculateFPS() ;FPS.DrawFPS(20,40)
		
		If KeyDown(Key_D) Poly1 = Null ;Poly2 = Null
		DrawText( " Polygon Count : "+Tpolygon.Count,20,60 )
			
Flip;Cls	
Wend


Type FPSCounter
	Field FPS%,Count%,Time%
	
	Method CalculateFPS()
			Count:+1			
			If Time+1000 < MilliSecs() 'FPS last sec
				
				FPS=Count' <- Frames/Sec
				Count=0
				Time=MilliSecs()			
			EndIf	
	End Method
	
	Method DrawFPS(X=0,Y=0)
		DrawText "Current FPS: "+FPS,X,Y
	End Method
	
	Method New() Time = MilliSecs() EndMethod
End Type
'---------------------------------------------------------------------------------------




Rem
Here starts the actuall module 

Module indiepath.poly

ModuleInfo "Name: 2d Polygon Lib"
ModuleInfo "License: Public Domain"
ModuleInfo "Author: Tim Fisher & Gosse Corrupted , Edit by Wave"

Import BRL.LinkedList
Import BRL.GLMax2D
End Rem


Global gSin#[360]
Global gCos#[360]

Local a%

For a = 0 To 359
	gSin#[a] = Sin(a)
	gCos#[a] = Cos(a)
Next

Type TPolygon
	
	Global List:TList
	Global Count
		
	Field iX#[64]	
	Field iY#[64]	
	Field fX#[64]	
	Field fY#[64]	
	Field iVertexCount		
	Field fScaleX#			
	Field fScaleY#			
	Field fAngle#			
	Field iMinX#				
	Field iMinY#				
	Field iMaxX#				
	Field iMaxY#
				
		'Used internally only
		Method New ()
            	If List = Null Then List = CreateList()
            	List.AddLast Self
			Count:+1
    		End Method		
		
		Method Remove()            	
			List.Remove Self
			Count:-1	
		EndMethod
		'Remove this Poly
		'MyPoly.Remove
		
		'Create a New Polygon Instance		
		'MyPoly:Polygon = Polygon.Create()
		Function Create:Tpolygon()
			Local Poly:TPolygon
			Poly = New TPolygon
			Poly.fScaleX=1;Poly.fScaleY=1
			Return Poly
		End Function		
		
		' The use:
		' MyPoly.AddVertex(x,y)
		Method AddVertex( X#,Y#, Update=True)
			iX#[iVertexCount] = x#
			iY#[iVertexCount] = y#		
			iVertexCount:+ 1
			If Update Then Self.Update()
		End Method
		'This is a even shorter version =)
		Method Add(X#,Y#,Update=True)
			AddVertex(X,Y,Update=True)		
		EndMethod
				
				
		'Scale alters the size
		'Ex to scale to double size
		'MyPoly.Scale(2,2)' 2 = 200%
		'Ex to scale to half size
		'MyPoly.Scale(0.5,0.5)' 0.5 = 50%
		Method Scale(sx#,sy#,Update=True)
			fScaleX#:* sx#
			fScaleY#:* sy#	
			If Update Then Self.Update()
		EndMethod

		
		'Resize the Poly by a stated amount
		'Set the polygon size		
		'MyPoly.ReSize(1,1)'set to original size
		Method Resize(sx#,sy#,update=True)
			fScaleX# = sx#
			fScaleY# = sy#	
			If update Then Self.Update()
		EndMethod
		
		
		'Turn the Poly By the stated amount
		'Ex MyPoly.Turn(15) 
		'Adds to the current direction
		Method Turn(rot#,update=True)
			fAngle# = wrap_angle(fAngle# + rot#)
			If update Then Self.Update()
		EndMethod
		
		
		'Rotate the Poly by the stated amount
		'Set the direction to this angle
		Method SetDir(Angle#,update=True)
			fAngle# = wrap_angle(angle#)
			If update Then Self.Update()
		EndMethod
		
		

		
		'Copy one poly to another
		'Returns a Polygon equal to the one you copied
		'Ex:
		'ACopyofMyPoly:Polygon = MyPoly.Copy()
		Method Copy:TPolygon()
			Local NewPoly:TPolygon
			NewPoly = New TPolygon
				
			For Local i = 0 To iVertexCount - 1
				NewPoly.iX#[i] = iX#[i]
				NewPoly.iY#[i] = iY#[i]
				NewPoly.fX#[i] = fX#[i]
				NewPoly.fY#[i] = fY#[i]
			Next
			
			NewPoly.iVertexCount = iVertexCount
			NewPoly.fScaleX#	= fScaleX#
			NewPoly.fScaleY#	= fScaleY#
			NewPoly.fAngle# 	= fAngle#
			NewPoly.iMinX# 	= iMinX#
			NewPoly.iMinY#	= iMinY#
			NewPoly.iMaxX# 	= iMaxX#
			NewPoly.iMaxY# 	= iMaxY#
			
			Return NewPoly
		EndMethod
		
		
		
		'Update the Poly
		Method Update()
			Local f1X#, f1Y#, f1#, f2#, angle#,i 
			
			iMinX = 9999999.00
			iMinY = 9999999.00
			iMaxX = -9999999.00
			iMaxY = -9999999.00
			
			For i = 0 To iVertexCount - 1
				f1X# = iX#[i] * fScaleX#
				f1y# = iY#[i] * fScaleY#
				
				angle# = fAngle#
				
				If angle# <> 0 Then
					f1# = gCos#[Angle#] * f1X# - gSin#[Angle#] * f1Y#
					f2# = gSin#[Angle#] * f1X# + gCos#[Angle#] * f1Y#
					f1X# = f1#
					f1y# = f2#
				EndIf
		
				fX#[i] = f1X#
				fY#[i] = f1Y#
					
				If f1X# < iMinX# Then iMinX = f1X#
				If f1Y# < iMinY# Then iMinY = f1Y#
				If f1X# > iMaxX# Then iMaxX = f1X#
				If f1Y# > iMaxY# Then iMaxY = f1Y#
			Next
		End Method			

		'Draw the Specified Poly to Screen
		'Uses the current drawing color
		'Dunno what happens with rotations and line-scales?
		Method Draw(x#,y#)
			Local lx#, ly#, i
			lx# = fX#[0] + x#
			ly# = fY#[0] + y#
			
			For i = 1 To iVertexCount -1
				DrawLine (lx#,ly#,fX#[i]+x,fY#[i]+y)
				lx# = fX#[i] + x#
				ly# = fY#[i] + y#
			Next
		EndMethod 
		
		'Make sure all angles are within 0 to 360 degrees
		Function Wrap_Angle#(angle#)
			While angle# >= 360 ; angle#:- 360 ; Wend
			While angle# <  0   ; angle#:+ 360 ; Wend
			Return angle#
		End Function
End Type
	
'Return TRUE if circles overlap
'This is faster than poly overlap and could be used 
'until we get into a "critical" range.
Function CircleOverlap(x1#,y1#,rad1#,x2#,y2#,rad2#)
	Local dx#, dy#, rsqr#
	dx# = x2# - x1#
	dy# = y2# - y1#
	rsqr# = (rad1# + rad2#) * (rad1# + rad2#)
	Return (dx#*dx#+dy#*dy# < rsqr#)
End Function
		
'Checks 2 polygons and sees if they overlap			
Function PolygonOverlap(poly1:TPolygon,x1#,y1#,poly2:TPolygon,x2#,y2#,bounding = True)

	Local tx1#, ty1#, tx2#, ty2#, tx3#, ty3#, tx4#, ty4#
	Local dSqr#, d1#, d2#, dx#, dy#
	Local lx1#, ly1#, lx2#, ly2#
	Local i,j
	
		If bounding Then
			tx1 = X1 + poly1.iMinX
			ty1 = Y1 + poly1.iMinY
			tx2 = X1 + poly1.iMaxX
			ty2 = Y1 + poly1.iMaxY
			tx3 = X2 + poly2.iMinX
			ty3 = Y2 + poly2.iMinY
			tx4 = X2 + poly2.iMaxX
			ty4 = Y2 + poly2.iMaxX
	

			If Not (tx3 > tx1 And ty3 > ty1 And tx3 < tx2 And ty3 < ty2) Then
				If Not (tx4 > tx1 And ty4 > ty1 And tx4 < tx2 And ty4 < ty2) Then
					If Not (tx3 > tx1 And ty4 > ty1 And tx3 < tx2 And ty4 < ty2) Then
						If Not (tx4 > tx1 And ty3 > ty1 And tx4 < tx2 And ty3 < ty2) Then
							Return False
						End If
					End If
				End If
			End If
		End If
		

		lx1 = poly1.fX#[0] + X1
		ly1 = poly1.fY#[0] + Y1
		lx2 = poly2.fX#[0] + X2
		ly2 = poly2.fY#[0] + Y2

		For i = 1 To poly1.iVertexCount - 1
			For j = 1 To poly2.iVertexCount - 1

			tx1 = poly1.fX#[i] + X1
			ty1 = poly1.fY#[i] + Y1
			tx3 = poly2.fX#[j] + X2
			ty3 = poly2.fY#[j] + Y2
			tx2 = lX1
			ty2 = lY1
			tx4 = lX2
			ty4 = lY2

			dSqr = (ty4-ty3)*(tx2-tx1)-(tx4-tx3)*(ty2-ty1)
			d1 = (ty1-ty3)
			d2 = (tx1-tx3)
			dX = ((tx2-tx1)*d1-(ty2-ty1)*d2)
			dY = ((tx4-tx3)*d1-(ty4-ty3)*d2)
	
			If dSqr = 0 Then
	
				If dX = 0 And dY = 0 Then
					Return True
				End If
			Else
	
				d1 = dX / dSqr
				d2 = dY / dSqr
				If (d1 >= 0 And d1 <= 1) And (d2 >= 0 And d2 <= 1) Then
					Return True
				End If
			End If

			lX2 = tx3
			lY2 = ty3
		Next

		lX1 = tx1
		lY1 = ty1
	Next
	Return False
End Function


There isn't someone who would know how to implend collision for points/rects/ovals versus Polygons?