... and I discovered this works for ALL simple polygons, either concave OR convex... yeah! something useful!
This needs optimizing (is messy and there might be some shortcuts) and especially make it work with with direct memory graphics instead of the dopey LINE command and it will be good to go! I am gonna cross my fingers and say, "wow.. I am getting better at this programming stuff!"
Here is the code:
Code: Select all
' =====================================================
' ===== CONVEX or CONVEX POLYGON FILL ROUTINE =======
' =====================================================
type vertice
x as integer
y as integer
side as integer
NLP as integer ' the next left side point
NRP as integer ' the next right side point
Lslp as double ' this is the slope from this point towards the next point ON THE LEFT SIDE!
Rslp as double ' this is the slope from this point towards the next point ON THE RIGHT SIDE!
end type
dim shared as vertice points(5)
dim shared as integer NumOfPoints
dim shared as integer Key, extraspace, loops = 0
screenres 800,600,32
randomize timer
do
loops +=1
cls
color rgb(255,255,255)
'
' make random points (within designated areas...) and show them
'
NumOfPoints = 5 : Points(0).x = NumOfPoints
points(1).x = int(rnd*390)+11 'upper left
points(1).y = int(rnd*290)+11
points(2).x = int(rnd*390)+401 'upper right
points(2).y = int(rnd*290)+11
points(3).x = int(rnd*190)+11 'center left
points(3).y = int(rnd*200)+301
points(4).x = int(rnd*190)+601 'center right
points(4).y = int(rnd*200)+301
points(5).x = int(rnd*400)+201 'bottom center
points(5).y = int(rnd*90)+501
for p as integer = 1 to NumOfPoints
Circle (points(p).x, points(p).y), 4, RGB(255,0,0) ,,,, f
next p
' ======================================================================
' ============== ENTER ROUTINE HERE
' ============== with all points in array points(5)
' ============== points(0).x = NumberOfPoints (should be four or five)
' ======================================================================
NumOfPoints = Points(0).x
'
'sort the array of points, from top to bottom, and left to right
'
dim as integer exchange = 1, passnum = NumOfPoints - 1
while passnum > 0 and exchange = 1
exchange = 0
for i as integer = 1 to passnum
if points(i).y > points(i+1).y then
exchange = 1
swap points(i), points(i+1)
end if
' if the Y values are same, then sort based on x values...
if points(i).y = points(i+1).y then
if points(i).x > points(i+1).x then
exchange = 1
swap points(i), points(i+1)
end if
end if
next i
passnum -= 1
wend
'
' find Top-Most and Bottom-Most points, show them
'
circle (points(1).x, points(1).y), 5, RGB(255,255,255) ' top
circle (points(NumOfPoints).x, points(NumOfPoints).y), 5, RGB(255,255,255) ' bottom
'
' calc main left/right dividing slope...
'
dim as integer TLP, TRP
dim as double MainSlope, CurSlope
MainSlope = (points(1).x - points(NumOfPoints).x) / (points(1).y - points(NumOfPoints).y)
for p as integer = 2 to NumOfPoints-1
CurSlope = (points(1).x - points(p).x) / (points(1).y - points(p).y)
if CurSlope < MainSlope then
points(p).side = -1
else
points(p).side = 1
end if
'print MainSlope, curSlope, p, points(p).side
next p
TLP = 1 ' set top Left Point to the first point
TRP = 1 ' set Top Right Point same as Top Left Point
points(1).side = 0 ' set first point side to 0 (means is on BOTH sides)
' check for same y value of first two points
if points(1).y = points(2).y then
points(2).side = 1 ' set second point to RIGHT side only
points(1).side = -1 ' set first point to LEFT side only, 0 means BOTH sides
TRP = 2 ' set Top Right Point to the second point
end if
' NOW, figure out the slopes of each point ot the next point on same side!
dim as integer curleftpoint = TLP, currightpoint = TRP, nextLeft, nextRight
dim as integer q
' find all the left points, calc each slope
do
' find next left point
nextLeft = curleftpoint
do
nextLeft += 1
loop while points(nextLeft).side > 0
' got the next left, now calc slope to it from current left
points(curleftpoint).Lslp = (points(curleftpoint).x - points(nextLeft).x) / (points(curleftpoint).y - points(nextLeft).y)
' save this next point
points(curleftpoint).NLP = nextLeft
curleftpoint = nextLeft
loop while points(nextleft).side <> 0 'until at bottom point
' find all the right points, calc each slope
do
' find next right point
nextRight = currightpoint
do
nextRight += 1
loop while points(nextRight).side < 0
' got the next right, now calc slope to it from current right
points(currightpoint).Rslp = (points(currightpoint).x - points(nextRight).x) / (points(currightpoint).y - points(nextRight).y)
' save this next point
points(currightpoint).NRP = nextRight
currightpoint = nextRight
loop while points(nextRight).side <> 0 'until at bottom point
' locate 2,1 : print "Main Slope = ";MainSlope
'
' for p as integer = 1 to NumOfPoints
' print
' print using "(#) (### / ###) side(##) Lslp(###.###) Rslp(###.###)";p;points(p).x;points(p).y;points(p).side;points(p).Lslp;points(p).Rslp;
' next p
'
' ok, now we got a sorted array of points, each identified as to which 'side' they are on
' lets determine how many yvalues there will be in total...
dim as integer NumOfYvalues = points(NumOfPoints).y - points(1).y + 1
' set the initial x-values for both sides..
dim as double Lx = points(TLP).x , Rx = points(TRP).x
' set the current point for each side
dim as integer CLP = TLP, CRP = TRP
for yvalue as integer = points(1).y + 1 to points(NumOfPoints).y 'iterate through all the yvalues
' calc the x-value for this y value for both Left and Right
Lx += points(CLP).Lslp : Rx += points(CRP).Rslp
' draw the line between the to xvalues at this yvalue
line (int(Lx), yvalue) - (int(Rx), yvalue), rgb(0,255,0)
' check to see if reached next left/right points...
if yvalue >= points(points(CLP).NLP).y then
' change current left point to the next left point!
CLP = points(CLP).NLP
end if
if yvalue >= points(points(CRP).NRP).y then
' change current right point to the next right point!
CRP = points(CRP).NRP
end if
sleep 10
next yvalue
beep
Key = getkey
loop until Key = 27