Posts: 597
Threads: 110
Joined: Apr 2022
Reputation:
34
08-13-2023, 05:43 PM
(This post was last modified: 08-13-2023, 05:48 PM by CharlieJV.)
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.
Posts: 3,973
Threads: 177
Joined: Apr 2022
Reputation:
219
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 + ...
Posts: 1,586
Threads: 59
Joined: Jul 2022
Reputation:
52
08-13-2023, 07:22 PM
(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://qb64phoenix.com/forum/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.
Posts: 597
Threads: 110
Joined: Apr 2022
Reputation:
34
(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://qb64phoenix.com/forum/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.
Posts: 207
Threads: 13
Joined: Apr 2022
Reputation:
52
(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://qb64phoenix.com/forum/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.
Posts: 597
Threads: 110
Joined: Apr 2022
Reputation:
34
08-14-2023, 02:41 AM
(This post was last modified: 08-14-2023, 02:45 AM by CharlieJV.)
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
Posts: 597
Threads: 110
Joined: Apr 2022
Reputation:
34
08-14-2023, 02:55 AM
(This post was last modified: 08-14-2023, 03:31 AM by CharlieJV.)
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
Posts: 476
Threads: 25
Joined: Nov 2022
Reputation:
45
(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.
Posts: 597
Threads: 110
Joined: Apr 2022
Reputation:
34
08-15-2023, 12:42 AM
(This post was last modified: 08-15-2023, 12:42 AM by CharlieJV.)
(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.
Posts: 597
Threads: 110
Joined: Apr 2022
Reputation:
34
08-17-2023, 10:03 PM
(This post was last modified: 08-17-2023, 10:05 PM by CharlieJV.)
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
|