Well, after a little headache (and some borrowing from the blitzmax forum
), I have compiled a piece of code that I think is rather yummy.
It allows you to create and draw filled (or unfilled) polygons with any number of sides, and in any irregular shape you can imagine.
I wanted to limit the number of plugins required to use it (Matrix1Utils is a given, sorry! I refuse to code in DBP without it), so it draws using DBP dots by default. But, if you have
Advanced2D or
D3DFunc installed, you just have to do some little comment switcherooskis in LineFunction() and TriangleFunction() and performance increases dramatically.
Now teh codez:
`D3D_Init
Sync On : Sync Rate 0
Backdrop On
Color Backdrop 0
// Hit up the subroutine for the type defs and globals
Gosub _InitYimBoxitron
// Create a new polygon object first parameter is line color, second is fill color
poly1 = yimPolyNew(RGB(255, 255, 255), RGB(123, 123, 123))
// Polygons are created with 0 vertices to start, so get busy
yimPolyAddVert(poly1, 0, 0)
yimPolyAddVert(poly1, 30, 30)
yimPolyAddVert(poly1, 30, 60)
yimPolyAddVert(poly1, 20, 70)
yimPolyAddVert(poly1, 10, 50)
yimPolyAddVert(poly1, -5, 50)
yimPolyAddVert(poly1, 10, 30)
Do
Text 5, 5, Str$(Screen FPS())
// Draw the poly with an offset x and y position
// The last parameter is a filled option flag
yimPolyDraw(poly1, 50, 50, 1)
Sync
Loop
Function TriangleFunction(x1, y1, x2, y2, x3, y3, color As Dword, filled)
// Creates a triangle using preferred line function
yimTriangle(x1, y1, x2, y2, x3, y3, color, filled)
// Advanced2D Filled Triangle (FASTER)
`If filled : a2FillTriangle x1, y1, x2, y2, x3, y3, color : Else : a2Triangle x1, y1, x2, y2, x3, y3, color : EndIf
EndFunction
Function LineFunction(x1, y1, x2, y2, lineColor1 As Dword, lineColor2 As Dword)
//** Line using DBP Dots (TIME TO GET YOURSElf A PLUGIN)
yimLine(x1, y1, x2, y2, lineColor1)
//** Advanced2D Line (FASTER)
`a2Line x1, y1, x2, y2, lineColor1, lineColor2
//** D3D_Func Line (FASTEST)
`D3D_Line x1, y1, x2, y2, lineColor1, lineColor2
EndFunction
_InitYimBoxitron:
Type yimPolyVert
x As Integer
y As Integer
color As Dword
EndType
Type yimPolyTri
p1 As yimPolyVert
p2 As yimPolyVert
p3 As yimPolyVert
EndType
Type yimPoly
vertsPtr As Integer
trisPtr As Integer
changed As Integer
lineColor As Dword
fillColor As Dword
EndType
Dim yimPolys() As yimPoly
Dim yimPolyVertsGhost() As yimPolyVert
ptr = Get ArrayPtr(yimPolyVertsGhost())
Unlink Array yimPolyVertsGhost()
Undim ArrayPtr ptr
Dim yimPolyTriArray() As yimPolyTri
ptr = Get ArrayPtr(yimPolyTriArray())
Unlink Array yimPolyTriArray()
Undim ArrayPtr ptr
Return
Function yimPolyNew(lineColor As Dword, fillColor As Dword)
Array Insert At Bottom yimPolys()
ac = Array Count(yimPolys())
Dim yimPolyNewVertsArray() As yimPolyVert
yimPolys(ac).vertsPtr = Get ArrayPtr(yimPolyNewVertsArray())
yimPolys(ac).lineColor = lineColor
yimPolys(ac).fillColor = fillColor
UnLink Array yimPolyNewVertsArray()
UnDim yimPolyNewVertsArray()
EndFunction ac
Function yimPolyAddVert(poly As Integer, x As Integer, y As Integer)
Link Array yimPolyVertsGhost(), yimPolys(poly).vertsPtr
Array Insert At Bottom yimPolyVertsGhost()
ac = Array Count(yimPolyVertsGhost())
yimPolyVertsGhost(ac).x = x
yimPolyVertsGhost(ac).y = y
yimPolyVertsGhost(ac).color = yimPolys(poly).lineColor
yimPolys(poly).vertsPtr = Get ArrayPtr(yimPolyVertsGhost())
yimPolys(poly).changed = 1
UnLink Array yimPolyVertsGhost()
EndFunction ac
Function yimPolySetVertPosition(poly As Integer, vert As Integer, x As Integer, y As Integer)
Link Array yimPolyVertsGhost(), yimPolys(poly).vertsPtr
If x <> yimPolyVertsGhost(ac).x Or y <> yimPolyVertsGhost(ac).y Then yimPolys(poly).changed = 1
yimPolyVertsGhost(ac).x = x
yimPolyVertsGhost(ac).y = y
UnLink Array yimPolyVertsGhost()
EndFunction
Function yimPolySetVertColor(poly As Integer, vert As Integer, color As Dword)
Link Array yimPolyVertsGhost(), yimPolys(poly).vertsPtr
yimPolyVertsGhost(ac).color = color
UnLink Array yimPolyVertsGhost()
EndFunction
Function yimPolyDraw(poly As Integer, x As Integer, y As Integer, filled As Integer)
If filled
If yimPolys(poly).changed
yimPolyTriangulate(poly)
yimPolys(poly).changed = 0
EndIf
Link Array yimPolyTriArray(), yimPolys(poly).trisPtr
ac = Array Count(yimPolyTriArray())
For i = 0 To ac
x1 = x+yimPolyTriArray(i).p1.x
y1 = y+yimPolyTriArray(i).p1.y
x2 = x+yimPolyTriArray(i).p2.x
y2 = y+yimPolyTriArray(i).p2.y
x3 = x+yimPolyTriArray(i).p3.x
y3 = y+yimPolyTriArray(i).p3.y
TriangleFunction(x1, y1, x2, y2, x3, y3, yimPolys(poly).fillColor, 1)
Next i
Unlink Array yimPolyTriArray()
EndIf
Link Array yimPolyVertsGhost(), yimPolys(poly).vertsPtr
ac = Array Count(yimPolyVertsGhost())
For i = 0 To ac
lineColor1 = yimPolyVertsGhost(i).color
lineColor2 = yimPolyVertsGhost(yimGetNextArrayItem(yimPolys(poly).vertsPtr, i, 1)).color
x1 = x+yimPolyVertsGhost(i).x
y1 = y+yimPolyVertsGhost(i).y
x2 = x+yimPolyVertsGhost(yimGetNextArrayItem(yimPolys(poly).vertsPtr, i, 1)).x
y2 = y+yimPolyVertsGhost(yimGetNextArrayItem(yimPolys(poly).vertsPtr, i, 1)).y
LineFunction(x1, y1, x2, y2, lineColor1, lineColor2)
Next i
Unlink Array yimPolyVertsGhost()
EndFunction
Function yimGetNextArrayItem(arrayPtr As Integer, curPos As Integer, count As Integer)
For i = 1 To count
Inc curPos
If curPos > Get ArrayPtr Count(arrayPtr) Then curPos = 0
Next i
EndFunction curPos
Function yimGetPrevArrayItem(arrayPtr As Integer, curPos As Integer, count As Integer)
For i = 1 To count
Dec curPos
If curPos < 0 Then curPos = Get ArrayPtr Count(arrayPtr)
Next i
EndFunction curPos
Function yimGetArrayItemIndex(arrayPtr, itemPtr)
ac = Get ArrayPtr Count(arrayPtr)
For i = 0 To ac
If Get ArrayPtr Item Ptr(arrayPtr, i) = itemPtr Then ExitFunction i
Next i
EndFunction -1
Function yimLine(x1, y1, x2, y2, color As Dword) // ******* Conversion from: http://www.blitzbasic.com/codearcs/codearcs.php?code=1465
Lock Pixels
Steep = (Abs(Y2-Y1) > Abs(X2-X1))
If Steep
Temp=X1
X1=Y1
Y1=Temp
Temp=X2
X2=Y2
Y2=Temp
EndIf
DeltaX = Abs(X2-X1)
DeltaY = Abs(Y2-Y1)
Error = 0
DeltaError = DeltaY
X = X1
Y = Y1
XStep = -1
If X1<X2 Then XStep = 1
YStep = -1
If Y1<Y2 Then YStep = 1
If Steep
Dot Y, X, color
Else
Dot X, Y, color
EndIf
While X<>X2
Inc X, XStep
Inc Error, DeltaError
If (Error << 1)>DeltaX
Inc Y, YStep
Error=Error-DeltaX
EndIf
If Steep
Dot Y, X, color
Else
Dot X, Y, color
EndIf
EndWhile
Unlock Pixels
EndFunction
Function yimTriangle(x1, y1, x2, y2, x3, y3, color As Dword, filled) // ******* Conversion from Axel Wheeler's post on: http://www.blitzbasic.com/Community/posts.php?topic=93985
If filled
Local Xa As Float
Local Xb As Float
Local Xc As Float
Local Ya As Float
Local Yb As Float
Local Yc As Float
Xa = x1
Ya = y1
Xb = x2
Yb = y2
Xc = x3
Yc = y3
If Yb<Ya
Xtemp#=Xa
Ytemp#=Ya
Xa=Xb
Ya=Yb
Xb=Xtemp#
Yb=Ytemp#
EndIf
If Yc<Ya
Xtemp#=Xa
Ytemp#=Ya
Xa=Xc
Ya=Yc
Xc=Xtemp#
Yc=Ytemp#
EndIf
If Yc<Yb
Xtemp#=Xb
Ytemp#=Yb
Xb=Xc
Yb=Yc
Xc=Xtemp#
Yc=Ytemp#
EndIf
For y#=Ya To Yc
If Yc=Ya Then Yc=Yc+.00001
proportionA#=(y#-Ya)/(Yc-Ya)
Xlong#=Xa+(Xc-Xa)*proportionA#
If y#<Yb
If Yb = Ya Then Yb = Yb + .00001
ProportionB#=(y#-Ya)/(Yb-Ya)
Xshort#=Xa+(Xb-Xa)*ProportionB#
Else
If Yc = Yb Then Yc = Yc+.00001
ProportionB#=(y#-Yb)/(Yc-Yb)
Xshort#=Xb+(Xc-Xb)*ProportionB#
EndIf
LineFunction(Xlong#, y#, Xshort#, y#, color, color)
Next y#
Else
LineFunction(x1, y1, x2, y2, color, color)
LineFunction(x2, y2, x3, y3, color, color)
LineFunction(x3, y3, x1, y1, color, color)
EndIf
EndFunction
Function yimPolyTriangulate(poly) // ******* Conversion from Warpy's post on: http://www.blitzbasic.com/Community/posts.php?topic=78165
If yimPolys(poly).trisPtr > 0
Undim ArrayPtr yimPolys(poly).trisPtr
EndIf
Dim yimNewTriArray() As yimPolyTri
yimPolys(poly).trisPtr = Get ArrayPtr(yimNewTriArray())
Unlink Array yimNewTriArray()
UnDim yimNewTriArray()
Link Array yimPolyVertsGhost(), yimPolys(poly).vertsPtr
c = Array Count(yimPolyVertsGhost())
Dim yimPolyVertsCopy(c) As yimPolyVert
For i = 0 To c
yimPolyVertsCopy(i).x = yimPolyVertsGhost(i).x
yimPolyVertsCopy(i).y = yimPolyVertsGhost(i).y
Next i
Unlink Array yimPolyVertsGhost()
Inc c
If c < 3
UnDim yimPolyVertsCopy()
ExitFunction
EndIf
While c > 3
i = 0
go = 0
While go = 0
Local p1 As yimPolyVert
Local p2 As yimPolyVert
Local p3 As yimPolyVert
p1 = yimPolyVertsCopy(i)
p2 = yimPolyVertsCopy((i+1) Mod c)
p3 = yimPolyVertsCopy((i+2) Mod c)
Inc lastArrayPtr
midx# = (p1.x + p2.x + p3.x) / 3.0
midy# = (p1.y + p2.y + p3.y) / 3.0
hits=0
For ii = 0 To c-1
x1# = yimPolyVertsCopy(ii).x
y1# = yimPolyVertsCopy(ii).y
x2# = yimPolyVertsCopy((ii+1) Mod c).x
y2# = yimPolyVertsCopy((ii+1) Mod c).y
If (y1#-midy#) * (y2#-midy#) < 0.0
ix# = x1# + (x2#-x1#)*(midy#-y1#)/(y2#-y1#)
If ix# < midx# Then Inc hits
EndIf
Next ii
If (hits Mod 2) = 1
x1#=p1.x
y1#=p1.y
x2#=p3.x
y2#=p3.y
dx1#=x2#-x1#
dy1#=y2#-y1#
go = 1
n = (i+3) Mod c
While n<>i
x3#=yimPolyVertsCopy(n).x
y3#=yimPolyVertsCopy(n).y
dx2#=x3#-x2#
dy2#=y3#-y2#
If dx1#<>dx2# Or x1#<>x2# Or dy1#<>dy2# Or y1#<>y2#
lambda#=(y2#-y1#+dy2#*(x1#-x2#)/dx2#)/(dy1#-dx1#*dy2#/dx2#)
mu#=(x1#-x2#+lambda#*dx1#)/dx2#
If lambda#>0 And lambda#<1
If mu#>=0 And mu#<=1
go=0
EndIf
EndIf
EndIf
x2#=x3#
y2#=y3#
n = (n+1) Mod c
EndWhile
EndIf
If go = 0
i = (i+1) Mod c
If i = 0
End
UnDim yimPolyVertsCopy()
ExitFunction
EndIf
EndIf
EndWhile
yimPolyAddTri(poly, p1.x, p1.y, p2.x, p2.y, p3.x, p3.y)
Array Delete Element yimPolyVertsCopy(), (i+1) Mod c
Dec c
EndWhile
yimPolyAddTri(poly, yimPolyVertsCopy(0).x, yimPolyVertsCopy(0).y, yimPolyVertsCopy(1).x, yimPolyVertsCopy(1).y, yimPolyVertsCopy(2).x, yimPolyVertsCopy(2).y)
UnDim yimPolyVertsCopy()
EndFunction
Function yimPolyAddTri(poly, x1, y1, x2, y2, x3, y3)
Link Array yimPolyTriArray(), yimPolys(poly).trisPtr
tTri As yimPolyTri
tTri.p1.x = x1
tTri.p1.y = y1
tTri.p2.x = x2
tTri.p2.y = y2
tTri.p3.x = x3
tTri.p3.y = y3
Array Insert At Bottom yimPolyTriArray()
yimPolyTriArray() = tTri
yimPolys(poly).trisPtr = Get ArrayPtr(yimPolyTriArray())
Unlink Array yimPolyTriArray()
EndFunction
Function yimPolyNumTris(poly)
Link Array yimPolyTriArray(), yimPolys(poly).trisPtr
nt = Array Count(yimPolyTriArray())
Unlink Array yimPolyTriArray()
EndFunction nt
I am not the best at commenting code, so if you have any questions about what's going on in here, let me know.
UPDATE:
Decided to make a non-Matrix1Util version and clean the code up a bit
Sync On : Sync Rate 0
Backdrop On
Color Backdrop 0
// Uncomment for D3DFunc support
`D3D_Init
Global MAX_POLYS = 10
Global MAX_VERTICES = 255
// Hit up the subroutine for the type defs and globals
Gosub _InitYimBoxitron
// Create a new polygon object first parameter is line color, second is fill color
poly1 = yimPolyNew(RGB(255, 255, 255), RGB(123, 123, 123))
poly2 = yimPolyNew(RGB(255,255,255), RGB(123,123,0))
yimPolyAddVert(poly1, 10, 0)
yimPolyAddVert(poly1, 40, 0)
yimPolyAddVert(poly1, 50, 10)
yimPolyAddVert(poly1, 50, 30)
yimPolyAddVert(poly1, 40, 40)
yimPolyAddVert(poly1, 10, 40)
yimPolyAddVert(poly1, 0, 30)
yimPolyAddVert(poly1, 0, 10)
yimPolyAddVert(poly2, -2, 25)
yimPolyAddVert(poly2, 18, 45)
yimPolyAddVert(poly2, 32, 45)
yimPolyAddVert(poly2, 52, 25)
yimPolyAddVert(poly2, 52, 50)
yimPolyAddVert(poly2, 67, 65)
yimPolyAddVert(poly2, 75, 65)
yimPolyAddVert(poly2, 75, 68)
yimPolyAddVert(poly2, 57, 68)
yimPolyAddVert(poly2, 57, 65)
yimPolyAddVert(poly2, 64, 65)
yimPolyAddVert(poly2, 51, 52)
yimPolyAddVert(poly2, 27, 52)
yimPolyAddVert(poly2, 27, 69)
yimPolyAddVert(poly2, 35, 69)
yimPolyAddVert(poly2, 35, 72)
yimPolyAddVert(poly2, 16, 72)
yimPolyAddVert(poly2, 16, 69)
yimPolyAddVert(poly2, 24, 69)
yimPolyAddVert(poly2, 24, 52)
yimPolyAddVert(poly2, -1, 52)
yimPolyAddVert(poly2, -14, 65)
yimPolyAddVert(poly2, -7, 65)
yimPolyAddVert(poly2, -7, 68)
yimPolyAddVert(poly2, -25, 68)
yimPolyAddVert(poly2, -25, 65)
yimPolyAddVert(poly2, -17, 65)
yimPolyAddVert(poly2, -2, 50)
Do
Text 5, 5, Str$(Screen FPS())
// Draw the poly with an offset x and y position
// The last parameter is a filled option flag
yimPolyDraw(poly1, 50, 50, 1)
yimPolyDraw(poly2, 50, 50, 1)
Sync
Loop
Function TriangleFunction(x1, y1, x2, y2, x3, y3, color As Dword, filled)
// Creates a triangle using preferred line function
yimTriangle(x1, y1, x2, y2, x3, y3, color, filled)
// Advanced2D Filled Triangle (FASTER)
`If filled : a2FillTriangle x1, y1, x2, y2, x3, y3, color : Else : a2Triangle x1, y1, x2, y2, x3, y3, color : EndIf
EndFunction
Function LineFunction(x1, y1, x2, y2, lineColor1 As Dword, lineColor2 As Dword)
//** Line using DBP Dots (TIME TO GET YOURSElf A PLUGIN)
yimLine(x1, y1, x2, y2, lineColor1)
//** Advanced2D Line (FASTER)
`a2Line x1, y1, x2, y2, lineColor1, lineColor2
//** D3D_Func Line (FASTEST)
`D3D_Line x1, y1, x2, y2, lineColor1, lineColor2
EndFunction
_InitYimBoxitron:
Type yimPolyVert
x As Integer
y As Integer
color As Dword
EndType
Type yimPolyTri
p1 As yimPolyVert
p2 As yimPolyVert
p3 As yimPolyVert
EndType
Type yimPoly
numVerts As Integer
numTris As Integer
changed As Integer
lineColor As Dword
fillColor As Dword
EndType
Global numPolys = -1
Dim yimPolys(MAX_POLYS) As yimPoly
Dim yimPolyVertsGhost(MAX_POLYS, MAX_VERTICES) As yimPolyVert
Dim yimPolyTriArray(MAX_POLYS, MAX_VERTICES) As yimPolyTri
Return
Function yimPolyNew(lineColor As Dword, fillColor As Dword)
Inc numPolys
yimPolys(numPolys).numVerts = -1
yimPolys(numPolys).lineColor = lineColor
yimPolys(numPolys).fillColor = fillColor
EndFunction numPolys
Function yimPolyAddVert(poly As Integer, x As Integer, y As Integer)
Inc yimPolys(poly).numVerts
ac = yimPolys(poly).numVerts
yimPolyVertsGhost(poly, ac).x = x
yimPolyVertsGhost(poly, ac).y = y
yimPolyVertsGhost(poly, ac).color = yimPolys(poly).lineColor
yimPolys(poly).changed = 1
EndFunction ac
Function yimPolySetVertPosition(poly As Integer, vert As Integer, x As Integer, y As Integer)
ac = yimPolys(poly).numVerts
If x <> yimPolyVertsGhost(ac).x Or y <> yimPolyVertsGhost(ac).y Then yimPolys(poly).changed = 1
yimPolyVertsGhost(poly, ac).x = x
yimPolyVertsGhost(poly, ac).y = y
EndFunction
Function yimPolySetVertColor(poly As Integer, vert As Integer, color As Dword)
ac = yimPolys(poly).numVerts
yimPolyVertsGhost(poly, ac).color = color
EndFunction
Function yimPolyDraw(poly As Integer, x As Integer, y As Integer, filled As Integer)
If filled
If yimPolys(poly).changed
yimPolyTriangulate(poly)
yimPolys(poly).changed = 0
EndIf
ac = yimPolys(poly).numTris
For i = 0 To ac
x1 = x+yimPolyTriArray(poly, i).p1.x
y1 = y+yimPolyTriArray(poly, i).p1.y
x2 = x+yimPolyTriArray(poly, i).p2.x
y2 = y+yimPolyTriArray(poly, i).p2.y
x3 = x+yimPolyTriArray(poly, i).p3.x
y3 = y+yimPolyTriArray(poly, i).p3.y
TriangleFunction(x1, y1, x2, y2, x3, y3, yimPolys(poly).fillColor, 1)
Next i
EndIf
ac = yimPolys(poly).numVerts
For i = 0 To ac
lineColor1 = yimPolyVertsGhost(poly, i).color
lineColor2 = yimPolyVertsGhost(poly, (i+1) Mod (ac+1)).color
x1 = x+yimPolyVertsGhost(poly, i).x
y1 = y+yimPolyVertsGhost(poly, i).y
x2 = x+yimPolyVertsGhost(poly, (i+1) Mod (ac+1)).x
y2 = y+yimPolyVertsGhost(poly, (i+1) Mod (ac+1)).y
LineFunction(x1, y1, x2, y2, lineColor1, lineColor2)
Next i
EndFunction
Function yimLine(x1, y1, x2, y2, color As Dword) // ******* Conversion from: http://www.blitzbasic.com/codearcs/codearcs.php?code=1465
Lock Pixels
Steep = (Abs(Y2-Y1) > Abs(X2-X1))
If Steep
Temp=X1
X1=Y1
Y1=Temp
Temp=X2
X2=Y2
Y2=Temp
EndIf
DeltaX = Abs(X2-X1)
DeltaY = Abs(Y2-Y1)
Error = 0
DeltaError = DeltaY
X = X1
Y = Y1
XStep = -1
If X1<X2 Then XStep = 1
YStep = -1
If Y1<Y2 Then YStep = 1
If Steep
Dot Y, X, color
Else
Dot X, Y, color
EndIf
While X<>X2
Inc X, XStep
Inc Error, DeltaError
If (Error << 1)>DeltaX
Inc Y, YStep
Error=Error-DeltaX
EndIf
If Steep
Dot Y, X, color
Else
Dot X, Y, color
EndIf
EndWhile
Unlock Pixels
EndFunction
Function yimTriangle(x1, y1, x2, y2, x3, y3, color As Dword, filled) // ******* Conversion from Axel Wheeler's post on: http://www.blitzbasic.com/Community/posts.php?topic=93985
If filled
Local Xa As Float
Local Xb As Float
Local Xc As Float
Local Ya As Float
Local Yb As Float
Local Yc As Float
Xa = x1
Ya = y1
Xb = x2
Yb = y2
Xc = x3
Yc = y3
If Yb<Ya
Xtemp#=Xa
Ytemp#=Ya
Xa=Xb
Ya=Yb
Xb=Xtemp#
Yb=Ytemp#
EndIf
If Yc<Ya
Xtemp#=Xa
Ytemp#=Ya
Xa=Xc
Ya=Yc
Xc=Xtemp#
Yc=Ytemp#
EndIf
If Yc<Yb
Xtemp#=Xb
Ytemp#=Yb
Xb=Xc
Yb=Yc
Xc=Xtemp#
Yc=Ytemp#
EndIf
For y#=Ya To Yc
If Yc=Ya Then Yc=Yc+.00001
proportionA#=(y#-Ya)/(Yc-Ya)
Xlong#=Xa+(Xc-Xa)*proportionA#
If y#<Yb
If Yb = Ya Then Yb = Yb + .00001
ProportionB#=(y#-Ya)/(Yb-Ya)
Xshort#=Xa+(Xb-Xa)*ProportionB#
Else
If Yc = Yb Then Yc = Yc+.00001
ProportionB#=(y#-Yb)/(Yc-Yb)
Xshort#=Xb+(Xc-Xb)*ProportionB#
EndIf
LineFunction(Xlong#, y#, Xshort#, y#, color, color)
Next y#
Else
LineFunction(x1, y1, x2, y2, color, color)
LineFunction(x2, y2, x3, y3, color, color)
LineFunction(x3, y3, x1, y1, color, color)
EndIf
EndFunction
Function yimPolyTriangulate(poly) // ******* Conversion from Warpy's post on: http://www.blitzbasic.com/Community/posts.php?topic=78165
yimPolys(poly).numTris = -1
c = yimPolys(poly).numVerts
Dim yimPolyVertsCopy(c) As yimPolyVert
For i = 0 To c
yimPolyVertsCopy(i).x = yimPolyVertsGhost(poly, i).x
yimPolyVertsCopy(i).y = yimPolyVertsGhost(poly, i).y
Next i
Inc c
If c < 3
UnDim yimPolyVertsCopy()
ExitFunction
EndIf
While c > 3
i = 0
go = 0
While go = 0
Local p1 As yimPolyVert
Local p2 As yimPolyVert
Local p3 As yimPolyVert
p1 = yimPolyVertsCopy(i)
p2 = yimPolyVertsCopy((i+1) Mod c)
p3 = yimPolyVertsCopy((i+2) Mod c)
Inc lastArrayPtr
midx# = (p1.x + p2.x + p3.x) / 3.0
midy# = (p1.y + p2.y + p3.y) / 3.0
hits=0
For ii = 0 To c-1
x1# = yimPolyVertsCopy(ii).x
y1# = yimPolyVertsCopy(ii).y
x2# = yimPolyVertsCopy((ii+1) Mod c).x
y2# = yimPolyVertsCopy((ii+1) Mod c).y
If (y1#-midy#) * (y2#-midy#) < 0.0
ix# = x1# + (x2#-x1#)*(midy#-y1#)/(y2#-y1#)
If ix# < midx# Then Inc hits
EndIf
Next ii
If (hits Mod 2) = 1
x1#=p1.x
y1#=p1.y
x2#=p3.x
y2#=p3.y
dx1#=x2#-x1#
dy1#=y2#-y1#
go = 1
n = (i+3) Mod c
While n<>i
x3#=yimPolyVertsCopy(n).x
y3#=yimPolyVertsCopy(n).y
dx2#=x3#-x2#
dy2#=y3#-y2#
If dx1#<>dx2# Or x1#<>x2# Or dy1#<>dy2# Or y1#<>y2#
lambda#=(y2#-y1#+dy2#*(x1#-x2#)/dx2#)/(dy1#-dx1#*dy2#/dx2#)
mu#=(x1#-x2#+lambda#*dx1#)/dx2#
If lambda#>0 And lambda#<1
If mu#>=0 And mu#<=1
go=0
EndIf
EndIf
EndIf
x2#=x3#
y2#=y3#
n = (n+1) Mod c
EndWhile
EndIf
If go = 0
i = (i+1) Mod c
If i = 0
UnDim yimPolyVertsCopy()
ExitFunction
EndIf
EndIf
EndWhile
yimPolyAddTri(poly, p1.x, p1.y, p2.x, p2.y, p3.x, p3.y)
Array Delete Element yimPolyVertsCopy(), (i+1) Mod c
Dec c
EndWhile
yimPolyAddTri(poly, yimPolyVertsCopy(0).x, yimPolyVertsCopy(0).y, yimPolyVertsCopy(1).x, yimPolyVertsCopy(1).y, yimPolyVertsCopy(2).x, yimPolyVertsCopy(2).y)
UnDim yimPolyVertsCopy()
EndFunction
Function yimPolyAddTri(poly, x1, y1, x2, y2, x3, y3)
Inc yimPolys(poly).numTris
tTri As yimPolyTri
tTri.p1.x = x1
tTri.p1.y = y1
tTri.p2.x = x2
tTri.p2.y = y2
tTri.p3.x = x3
tTri.p3.y = y3
yimPolyTriArray(poly, yimPolys(poly).numTris) = tTri
EndFunction
I *think* I got rid of all of the Matrix1 commands...
TTYL Apillo
May 10th / Jerico2day-OBese87 / VOTE NOW
