Trying to figure algorithm to draw and paint polygons
#1
My preoccupation at the moment is trying to pinpoint an X,Y position to get anywhere within a polygon to paint its innards.

I'm wondering, am I heading in the right direction with this prototyping code:

Code: (Select All)
PSET (50,25) : AreaStartX = POINT(0) : AreaStartY = POINT(1) : PaintX = POINT(0) : PaintY = POINT(1)
LINE - STEP (20,15),14
PaintX = (PaintX + POINT(0) ) / 2
PaintY =  (PaintY + POINT(1) ) / 2
LINE - STEP (-10,15),14
PaintX = ( PaintX + POINT(0) ) / 2
PaintY = ( PaintY + POINT(1) ) / 2
LINE - STEP (-10,-10),14
PaintX = ( PaintX + POINT(0) ) / 2
PaintY = ( PaintY + POINT(1) ) / 2
LINE - (AreaStartX, AreaStartY), 14
PaintX = ( PaintX + POINT(0) ) / 2
PaintY = ( PaintY + POINT(1) ) / 2
PRINT PaintX, PaintY
PAINT (PaintX, PaintY), 1, 14

EDIT 1: Had a bunch of unnecessary INT instances in there and yanked them out.
EDIT 2: Had a bunch of unnecessary ABS instances in there and yanked them out too.
Reply
#2
Hi Charlie, 

Here is something I saved from our fearless leader (Steve), it might be of help or at least of interest:
Code: (Select All)
Screen _NewImage(800, 600, 32)
For i = 1 To 50
    Line (Rnd * 800, Rnd * 600)-(Rnd * 800, Rnd * 600), _RGB(Rnd * 256, Rnd * 256, Rnd * 256), BF
Next
Sleep

Fill_It "(100,100)-(200,200)-(300,500)-(200,150)-(100,100)", "(115,110)", -1
Fill_It "(400,400)-(600,400)-(400,550)-(600,550)-(400,400)", "(425,405),(425,545)", &HFFFFFF00




Sub Fill_It (DrawPoint$, FillPoint$, Kolor As _Unsigned Long)
    Dim x As Long, y As Long
    Dim temp As Long: temp = _NewImage(_Width, _Height, 32)
    d = _Dest
    _Dest temp
    temp$ = DrawPoint$: temp2$ = FillPoint$
    GetPoint temp$, x, y
    PSet (x, y), Kolor
    Do Until temp$ = ""
        GetPoint temp$, x, y
        Line -(x, y), Kolor
    Loop
    GetPoint temp2$, x, y
    Paint (x, y), Kolor
    Do Until Left$(temp2$, 1) <> ","
        temp2$ = Mid$(temp2$, 2)
        GetPoint temp2$, x, y
        Paint (x, y), Kolor
    Loop
    _PutImage (0, 0), temp, d
    _Dest d
    _FreeImage temp
End Sub

Sub GetPoint (s$, x As Long, y As Long)
    l = InStr(s$, ")")
    l$ = LTrim$(Left$(s$, l - 1))
    s$ = Mid$(s$, l + 1)
    If Left$(l$, 1) = "-" Then l$ = Mid$(l$, 2)
    If Left$(l$, 1) = "(" Then l$ = Mid$(l$, 2)
    x = Val(l$)
    y = Val(Mid$(l$, InStr(l$, ",") + 1))
End Sub

It doesn't run too long so your time is not wasted ;-))
b = b + ...
Reply
#3
Star 
(08-12-2023, 08:33 AM)RhoSigma Wrote: As old Amiga user still until today I can tell your workaround is good for drawing the shape of a polygon.

However, the AREA statements were not to draw a shape but a filled polygon using the "Blitter" (abrev. for "Block image transferer") which was at that time (late 80s) blazingly fast processing upto 80 million pixels per second. So to emulate that you would also need a PSET anywere into the drawn shape and then do a PAINT. I tried that once too, but often had problems that PAINT was leaking over the shape and flooding the whole screen, so I was looking for an alternative.

The alternative I found was this http://alienryderflex.com/polygon_fill/

From the theory and sample described there I created my polygon.bm library which is part of my "Libraries Collection" here https://staging.qb64phoenix.com/showthread.php?tid=1033

The algorithm talked about in this post looks like it works well. In the least you should download RhoSigma's "QBLibrary" and study how he implemented it.
Reply
#4
(08-13-2023, 07:22 PM)mnrvovrfc Wrote:
(08-12-2023, 08:33 AM)RhoSigma Wrote: As old Amiga user still until today I can tell your workaround is good for drawing the shape of a polygon.

However, the AREA statements were not to draw a shape but a filled polygon using the "Blitter" (abrev. for "Block image transferer") which was at that time (late 80s) blazingly fast processing upto 80 million pixels per second. So to emulate that you would also need a PSET anywere into the drawn shape and then do a PAINT. I tried that once too, but often had problems that PAINT was leaking over the shape and flooding the whole screen, so I was looking for an alternative.

The alternative I found was this http://alienryderflex.com/polygon_fill/

From the theory and sample described there I created my polygon.bm library which is part of my "Libraries Collection" here https://staging.qb64phoenix.com/showthread.php?tid=1033

The algorithm talked about in this post looks like it works well. In the least you should download RhoSigma's "QBLibrary" and study how he implemented it.

Oooo, that's good stuff.

I was just going with best-case scenario polygons because I could not fathom the worst case senarios.

That's good reading.
Reply
#5
(08-13-2023, 08:16 PM)CharlieJV Wrote:
(08-13-2023, 07:22 PM)mnrvovrfc Wrote:
(08-12-2023, 08:33 AM)RhoSigma Wrote: As old Amiga user still until today I can tell your workaround is good for drawing the shape of a polygon.

However, the AREA statements were not to draw a shape but a filled polygon using the "Blitter" (abrev. for "Block image transferer") which was at that time (late 80s) blazingly fast processing upto 80 million pixels per second. So to emulate that you would also need a PSET anywere into the drawn shape and then do a PAINT. I tried that once too, but often had problems that PAINT was leaking over the shape and flooding the whole screen, so I was looking for an alternative.

The alternative I found was this http://alienryderflex.com/polygon_fill/

From the theory and sample described there I created my polygon.bm library which is part of my "Libraries Collection" here https://staging.qb64phoenix.com/showthread.php?tid=1033

The algorithm talked about in this post looks like it works well. In the least you should download RhoSigma's "QBLibrary" and study how he implemented it.

Oooo, that's good stuff.

I was just going with best-case scenario polygons because I could not fathom the worst case senarios.

That's good reading.

Simply go to Daryl's Main Tutorial index, scroll a bit down to the "Geometry/Math" entries and study.
http://alienryderflex.com/tutorials.shtml

It's all there, how to figure a point inside a polygon, filling, hatchline filling, shortest path, perimeter etc.
Reply
#6
On the way towards my algorithm, I usually wind up with big and ugly code to hash things out, see the pattern, and when I think I know how, I refactor the daylights out of the thing into some compact code.

Thanks all for the helpful resources.

For the giggles, here's the code I have tonight for tidying later:

Code: (Select All)
PSET (50,25) : AreaStartX = POINT(0) : AreaStartY = POINT(1)
LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
LastX = POINT(0): LastY = POINT(1)
LINE - (500,15),14
IF POINT(0) < LeftMostX THEN
  LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud1 = LastX : LeftMostYBud1 = LastY : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
ELSE
  IF LeftMostXBud2 = -1 THEN LeftMostXBud2 = POINT(0) : LeftMostYBud2 = POINT(1)
END IF
LastX = POINT(0): LastY = POINT(1)
LINE - (490,190),14
IF POINT(0) < LeftMostX THEN
  LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud1 = LastX : LeftMostYBud1 = LastY : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
ELSE
  IF LeftMostXBud2 = -1 THEN LeftMostXBud2 = POINT(0) : LeftMostYBud2 = POINT(1)
END IF
LastX = POINT(0): LastY = POINT(1)
LINE - (400,150),14
IF POINT(0) < LeftMostX THEN
  LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud1 = LastX : LeftMostYBud1 = LastY : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
ELSE
  IF LeftMostXBud2 = -1 THEN LeftMostXBud2 = POINT(0) : LeftMostYBud2 = POINT(1)
END IF
LastX = POINT(0): LastY = POINT(1)
LINE - (430,40),14
IF POINT(0) < LeftMostX THEN
  LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud1 = LastX : LeftMostYBud1 = LastY : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
ELSE
  IF LeftMostXBud2 = -1 THEN LeftMostXBud2 = POINT(0) : LeftMostYBud2 = POINT(1)
END IF
LastX = POINT(0): LastY = POINT(1)
LINE - (150,50),14
IF POINT(0) < LeftMostX THEN
  LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud1 = LastX : LeftMostYBud1 = LastY : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
ELSE
  IF LeftMostXBud2 = -1 THEN LeftMostXBud2 = POINT(0) : LeftMostYBud2 = POINT(1)
END IF
LastX = POINT(0): LastY = POINT(1)
LINE - (150,120),14
IF POINT(0) < LeftMostX THEN
  LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud1 = LastX : LeftMostYBud1 = LastY : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
ELSE
  IF LeftMostXBud2 = -1 THEN LeftMostXBud2 = POINT(0) : LeftMostYBud2 = POINT(1)
END IF
LastX = POINT(0): LastY = POINT(1)
LINE - (290,80),14
IF POINT(0) < LeftMostX THEN
  LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud1 = LastX : LeftMostYBud1 = LastY : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
ELSE
  IF LeftMostXBud2 = -1 THEN LeftMostXBud2 = POINT(0) : LeftMostYBud2 = POINT(1)
END IF
LastX = POINT(0): LastY = POINT(1)
LINE - (150,180),14
IF POINT(0) < LeftMostX THEN
  LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud1 = LastX : LeftMostYBud1 = LastY : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
ELSE
  IF LeftMostXBud2 = -1 THEN LeftMostXBud2 = POINT(0) : LeftMostYBud2 = POINT(1)
END IF
LastX = POINT(0): LastY = POINT(1)
LINE - (75,160),14
IF POINT(0) < LeftMostX THEN
  LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud1 = LastX : LeftMostYBud1 = LastY : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
ELSE
  IF LeftMostXBud2 = -1 THEN LeftMostXBud2 = POINT(0) : LeftMostYBud2 = POINT(1)
END IF
LastX = POINT(0): LastY = POINT(1)
LINE - (AreaStartX, AreaStartY), 14
IF POINT(0) = LeftMostX THEN LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud1 = LastX : LeftMostYBud1 = LastY
LastX = POINT(0): LastY = POINT(1)
IF LeftMostXBud1 < LeftMostXBud2 THEN PAINT ( (LeftMostX + LeftMostXBud1) / 2 + 1, (LeftMostY + LeftMostYBud1) / 2 ), 1, 14 ELSE PAINT ( (LeftMostX + LeftMostXBud2) / 2 + 1, (LeftMostY + LeftMostYBud2) / 2 ), 1, 14

   
Reply
#7
Refactor step 1:

Code: (Select All)
PSET (50,25) : AreaStartX = POINT(0) : AreaStartY = POINT(1)
LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
LastX = POINT(0): LastY = POINT(1)

SUB DoPostLine()
    IF POINT(0) < LeftMostX THEN
      LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud1 = LastX : LeftMostYBud1 = LastY : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
    ELSE
      IF LeftMostXBud2 = -1 THEN LeftMostXBud2 = POINT(0) : LeftMostYBud2 = POINT(1)
    END IF
    LastX = POINT(0): LastY = POINT(1)
END SUB

LINE - (500,15),14 : DoPostLine()

LINE - (490,190),14 : DoPostLine()

LINE - (400,150),14 : DoPostLine()

LINE - (430,40),14 : DoPostLine()

LINE - (150,50),14 : DoPostLine()

LINE - (150,120),14 : DoPostLine()

LINE - (290,80),14 : DoPostLine()

LINE - (150,180),14 : DoPostLine()

LINE - (75,160),14 : DoPostLine()

LINE - (AreaStartX, AreaStartY), 14
IF POINT(0) = LeftMostX THEN LeftMostXBud1 = LastX : LeftMostYBud1 = LastY
LastX = POINT(0): LastY = POINT(1)

IF LeftMostXBud1 < LeftMostXBud2 THEN PAINT ( (LeftMostX + LeftMostXBud1) / 2 + 1, (LeftMostY + LeftMostYBud1) / 2 ), 1, 14 ELSE PAINT ( (LeftMostX + LeftMostXBud2) / 2 + 1, (LeftMostY + LeftMostYBud2) / 2 ), 1, 14

IF LeftMostXBud1 < LeftMostXBud2 THEN CIRCLE ( (LeftMostX + LeftMostXBud1) / 2 + 1, (LeftMostY + LeftMostYBud1) / 2 ), 10, 12 ELSE CIRCLE ( (LeftMostX + LeftMostXBud2) / 2 + 1, (LeftMostY + LeftMostYBud2) / 2 ), 10, 12
Reply
#8
(08-14-2023, 02:55 AM)CharlieJV Wrote: Refactor step 1:

Code: (Select All)
PSET (50,25) : AreaStartX = POINT(0) : AreaStartY = POINT(1)
LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
LastX = POINT(0): LastY = POINT(1)...
Nice refactoring! Looking good.
grymmjack (gj!)
GitHubYouTube | Soundcloud | 16colo.rs
Reply
#9
(08-15-2023, 12:22 AM)grymmjack Wrote:
(08-14-2023, 02:55 AM)CharlieJV Wrote: Refactor step 1:

Code: (Select All)
PSET (50,25) : AreaStartX = POINT(0) : AreaStartY = POINT(1)
LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
LastX = POINT(0): LastY = POINT(1)...
Nice refactoring! Looking good.

Hey, thanks!

Too pooped today, maybe tomorrow: got to test this out with all kinds of polygons and see how robust this is.  Gotta find me some funky polygons and also test varying starting points for coordinates.

Strictly going by logic, I'm thinking math brains would run circles around this kid.

Meh: Slow and steady, iterative and incremental.  Find the patterns.  My kind of "brain-age" game.
Reply
#10
Sometimes, things have to get bigger and uglier before they can get compact and purty.

Program modified to redraw the polygon over and over again in an infinite loop, but changing the starting coordinate of the polygon every loop.

Code: (Select All)
TYPE a_point
x%
y%
END TYPE

DIM array(1 TO 10) AS a_point
DIM point_hold as a_point
DIM as integer LeftMostX, LeftMostY, LastX, LastY,  LeftMostXBud1, LeftMostYBud1, LeftMostXBud2, LeftMostYBud2, AreaStartX, AreaStartY

SUB DoPostLine()
_delay 0.25
    IF POINT(0) < LeftMostX THEN
      LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud1 = LastX : LeftMostYBud1 = LastY : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
    ELSE
      IF LeftMostXBud2 = -1 THEN LeftMostXBud2 = POINT(0) : LeftMostYBud2 = POINT(1)
    END IF
    LastX = POINT(0): LastY = POINT(1)
END SUB

FOR i = 1 TO 10
  READ array(i).x%, array(i).y%
NEXT i

DrawAgain:

CLS

PSET (array(1).x%,array(1).y%) : AreaStartX = POINT(0) : AreaStartY = POINT(1)
LeftMostX = POINT(0) : LeftMostY = POINT(1) : LeftMostXBud1 = -1 : LeftMostYBud1 = -1 : LeftMostXBud2 = -1 : LeftMostYBud2 = -1
LastX = POINT(0): LastY = POINT(1)

LINE - (array(2).x%,array(2).y%),14 : DoPostLine()

LINE - (array(3).x%,array(3).y%),14 : DoPostLine()

LINE - (array(4).x%,array(4).y%),14 : DoPostLine()

LINE - (array(5).x%,array(5).y%),14 : DoPostLine()

LINE - (array(6).x%,array(6).y%),14 : DoPostLine()

LINE - (array(7).x%,array(7).y%),14 : DoPostLine()

LINE - (array(8).x%,array(8).y%),14 : DoPostLine()

LINE - (array(9).x%,array(9).y%),14 : DoPostLine()

LINE - (array(10).x%,array(10).y%),14 : DoPostLine()

IF LeftMostXBud1 = -1 THEN LeftMostXBud1 = POINT(0) : LeftMostYBud1 = POINT(1)

LINE - (AreaStartX, AreaStartY), 14 : DoPostLine()

IF LeftMostXBud1 < LeftMostXBud2 THEN PAINT ( (LeftMostX + LeftMostXBud1) / 2 + 1, (LeftMostY + LeftMostYBud1) / 2 ), 1, 14 ELSE PAINT ( (LeftMostX + LeftMostXBud2) / 2 + 1, (LeftMostY + LeftMostYBud2) / 2 ), 1, 14

IF LeftMostXBud1 < LeftMostXBud2 THEN CIRCLE ( (LeftMostX + LeftMostXBud1) / 2 + 1, (LeftMostY + LeftMostYBud1) / 2 ), 10, 12 ELSE CIRCLE ( (LeftMostX + LeftMostXBud2) / 2 + 1, (LeftMostY + LeftMostYBud2) / 2 ), 10, 12

_DELAY 1

point_hold.x% = array(1).x% : point_hold.y% = array(1).y%
array(1).x% = array(2).x% : array(1).y% = array(2).y%
array(2).x% = array(3).x% : array(2).y% = array(3).y%
array(3).x% = array(4).x% : array(3).y% = array(4).y%
array(4).x% = array(5).x% : array(4).y% = array(5).y%
array(5).x% = array(6).x% : array(5).y% = array(6).y%
array(6).x% = array(7).x% : array(6).y% = array(7).y%
array(7).x% = array(8).x% : array(7).y% = array(8).y%
array(8).x% = array(9).x% : array(8).y% = array(9).y%
array(9).x% = array(10).x% : array(9).y% = array(10).y%
array(10).x% = point_hold.x% : array(10).y% = point_hold.y%

GOTO DrawAgain

END

DATA 50, 25
DATA 500,15
DATA 490,190
DATA 400, 150
DATA 430,40
DATA 150,50
DATA 150, 120
DATA 290, 80
DATA 150, 180
DATA 75, 160
Reply




Users browsing this thread: 4 Guest(s)