Simple polygon intersection by geometry.
Code: Select all
Randomize
#include once "GL/gl.bi"
#include once "GL/glu.bi"
Type Point
As Double x,y
End Type
Type Line
As Point s,f
End Type
Function range(f As Long,L As Long) As Long
Return Int(Rnd*((l+1)-(f))+(f))
End Function
Function isleft(L As Line,p As Point) As Long 'for function intersect
Return Sgn((L.s.x-L.f.x)*(p.y-L.f.y)-(p.x-L.f.x)*(L.s.y-L.f.y))<0
End Function
Function intersect(L1 As Line,L2 As Line) As Long 'do 2 lines intersect?
If isleft(L2,L1.s) = isleft(L2,L1.f) Then Return 0
If isleft(L1,L2.s) = isleft(L1,L2.f) Then Return 0
Return -1
End Function
Function intersection(L1 As Line,L2 As Line) As Point 'point of intersection of 2 lines
Dim As Double z=(L1.f.x-L1.s.x):If z=0 Then z=1e-6
Var M1=(L1.f.y-L1.s.y)/z
z=(L2.f.x-L2.s.x):If z=0 Then z=1e-6
Var M2=(L2.f.y-L2.s.y)/z
z=(L1.f.x-L1.s.x):If z=0 Then z=1e-6
Var C1=(L1.s.y*L1.f.x-L1.s.x*L1.f.y)/z
z=(L2.f.x-L2.s.x):If z=0 Then z=1e-6
Var C2=(L2.s.y*L2.f.x-L2.s.x*L2.f.y)/z
z=Iif (M1-M2<>0,M1-M2,1e-6)
Return Type((C2-C1)/z,(M1*C2-M2*C1)/z)
End Function
Function inpolygon(p1() As Point,Byval p2 As Point) As Integer 'is a point in a polygon?
#define Winder(L1,L2,p) ((L1.x-L2.x)*(p.y-L2.y)-(p.x-L2.x)*(L1.y-L2.y))
Dim As Integer index,nextindex,k=Ubound(p1)+1,wn
For n As Integer=1 To Ubound(p1)
index=n Mod k:nextindex=(n+1) Mod k
If nextindex=0 Then nextindex=1
If p1(index).y<=p2.y Then
If p1(nextindex).y>p2.y Andalso Winder(p1(index),p1(nextindex),p2)>0 Then wn+=1
Else
If p1(nextindex).y<=p2.y Andalso Winder(p1(index),p1(nextindex),p2)<0 Then wn-=1
End If
Next n
Return wn
End Function
'polygon/polygon intersections to ret()
Function intersections(p1() As Point,p2() As Point,ret() As Point) As Long
Redim ret(0)
Redim As Line x(0),y(0)
'do the edge intersections
For n As Long=Lbound(p1) To Ubound(p1)-1
Redim Preserve x(1 To Ubound(x)+1)
x(Ubound(x))=Type<Line>(p1(n),p1(n+1))
Next
Redim Preserve x(1 To Ubound(x)+1)
x(Ubound(x))=Type<Line>(p1(Ubound(p1)),p1(Lbound(p1)))
For n As Long=Lbound(p2) To Ubound(p2)-1
Redim Preserve y(1 To Ubound(y)+1)
y(Ubound(y))=Type<Line>(p2(n),p2(n+1))
Next
Redim Preserve y(1 To Ubound(y)+1)
y(Ubound(y))=Type<Line>(p2(Ubound(p2)),p2(Lbound(p2)))
For n As Long=Lbound(x) To Ubound(x)
For m As Long=Lbound(y) To Ubound(y)
If intersect(x(n),y(m)) Then
Var p=intersection(x(n),y(m))
Redim Preserve ret(1 To Ubound(ret)+1)
ret(Ubound(ret))=p
End If
Next
Next
'do the vertex intersections
For n As Long=Lbound(p1) To Ubound(p1)
If inpolygon(p2(),p1(n)) Then
Redim Preserve ret(1 To Ubound(ret)+1)
ret(Ubound(ret))=p1(n)
End If
Next n
For n As Long=Lbound(p2) To Ubound(p2)
If inpolygon(p1(),p2(n)) Then
Redim Preserve ret(1 To Ubound(ret)+1)
ret(Ubound(ret))=p2(n)
End If
Next n
Dim As Point C '-- get centroid
Dim As Long counter
For n As Long=Lbound(ret) To Ubound(ret)
counter+=1
c.x+=ret(n).x
c.y+=ret(n).y
Next n
c.x=c.x/counter
c.y=c.y/counter
'to suit anti clockwise quad points
For p1 As Long = Lbound(ret) To Ubound(ret)-1
For p2 As Long = p1 + 1 To Ubound(ret)
If Atan2(ret(p1).y-c.y,ret(p1).x-c.x)< Atan2(ret(p2).y-c.y,ret(p2).x-c.x) Then
Swap ret(p1),ret(p2)
End If
Next p2
Next p1
Return Ubound(ret)
End Function
Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
Static As Double timervalue,lastsleeptime,t3,frames
frames+=1
If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000
If sleeptime<1 Then sleeptime=1
lastsleeptime=sleeptime
timervalue=Timer
Return sleeptime
End Function
Sub Getpolygon(n As Long=8,_ 'number of sides
centreX As Long,_ 'centres
centreY As Long,_
size As Long=100,_ 'size
angle As Single=0,_ ' rotate
ex As Single=1,_ 'eccentricity on x plane
ey As Single=1,_ 'eccentricity on y plane
offset As Single=0,_ 'offset initial angle
p() As Point) 'out array
Redim p(1 To n)
angle=angle*0.0174532925199433 'degrees to radians
offset=offset*0.0174532925199433
Dim slug As Single=6.283185307179586/n
Dim As Single x1,y1
Dim As Single x1r,y1r
Dim As Long count
Dim As Single cosangle=Cos(angle),sinangle=Sin(angle)
For z As Single=0+offset To 6.283185307179586 +offset Step slug
count+=1
If count>n Then Exit For
x1=centrex+ex*(size)*Cos(z)
y1=centrey+ey*(size)*Sin(z)
'now rotate
x1r=(cosangle*(x1-centreX)-sinangle*(y1-centreY))+centreX
y1r=(sinangle*(x1-centreX)+cosangle*(y1-centreY))+centreY
p(count)=Type<Point>(x1r,y1r)
Next z
End Sub
Dim As Integer scrnx=1024,scrny=768
Screenres scrnX,scrnY,32,,2
'minimum for ortho
glMatrixMode GL_PROJECTION
glOrtho 0, scrnx, scrny, 0,-1, 1
gllinewidth 4
Redim As Point p(),q(),i()
Dim As Single a,ex1,ey1,ex2,ey2
Dim As String key
Dim As Long x1,y1,x2,y2,rad1,rad2,num1,num2,fps
'start settings
num1=5
x1=400
y1=300
rad1=150
ex1=1
ey1=1
num2=6
x2=400
y2=500
rad2=150
ex2=1
ey2=1
Windowtitle "PRESS SPACE KEY"
Do
key=Inkey
If key=" " Then
key=""
x1=range(200,700): x2=range(200,700)
y1=range(200,600): y2=range(200,600)
num1=range(3,9):num2=range(3,9)
rad1=range(150,400):rad2=range(150,400)
End If
a+=.75 'angle
Getpolygon(num1,x1,y1,rad1,a,ex1,ey1,,p())
Getpolygon(num2,x2,y2,rad2,-a,ex2,ey2,,q())
intersections(p(),q(),i())
' ======= use opengl to render only ============
glClear GL_COLOR_BUFFER_BIT Or GL_DEPTH_BUFFER_BIT
glbegin gl_polygon
glcolor3ub 200,0,0'draw red polygon
For n As Long=Lbound(p) To Ubound(p)
glvertex2i p(n).x,p(n).y
Next
glend
glbegin gl_polygon
glcolor3ub 0,0,200 'draw blue polygon
For n As Long=Lbound(q) To Ubound(q)
glvertex2i q(n).x,q(n).y
Next
glend
'the intersected polygon
glbegin gl_polygon
glcolor3ub(0,200,0) 'draw the intersection polygon
For n As Long=Lbound(i) To Ubound(i)
glvertex2i i(n).x,i(n).y
Next
glend
glcolor3ub 200,200,255 'draw a border
glbegin gl_lines
For n As Long=Lbound(i) To Ubound(i)-1
glvertex2i i(n).x,i(n).y
glvertex2i i(n+1).x,i(n+1).y
Next
glvertex2i i(Ubound(i)).x,i(Ubound(i)).y
glvertex2i i(Lbound(i)).x,i(Lbound(i)).y
glend
Flip
Sleep regulate(60,fps),1
Loop Until key=Chr(27)