09-26-2024, 02:14 AM
(This post was last modified: 09-26-2024, 03:54 AM by TerryRitchie.)
--------------------------------------------------------------------------------------
UPDATE: OK, code works now. Error fixed.
--------------------------------------------------------------------------------------
I have cleaned the code up considerably and made it much faster. The PAINT statement now only has to paint a small area on the mask image instead of painting out the entire image.
I also condensed everything into one subroutine, ClipPolygon.
GetPolygon and LineCollide% are only needed for demo purposes.
UPDATE: OK, code works now. Error fixed.
--------------------------------------------------------------------------------------
I have cleaned the code up considerably and made it much faster. The PAINT statement now only has to paint a small area on the mask image instead of painting out the entire image.
I also condensed everything into one subroutine, ClipPolygon.
GetPolygon and LineCollide% are only needed for demo purposes.
Code: (Select All)
' Clip a polygon from an image
OPTION _EXPLICIT ' declare those variables
TYPE TYPE_IPOINT ' X,Y INTEGER POINT PAIR
x AS INTEGER ' x value
y AS INTEGER ' y value
END TYPE
TYPE TYPE_LINE ' LINE SEGMENT DEFINITION
Start AS TYPE_IPOINT ' x,y start of line segment
Finish AS TYPE_IPOINT ' x,y end of line segment
END TYPE
REDIM Poly(0) AS TYPE_IPOINT ' polygon points
DIM Image AS LONG ' image to clip from
DIM Clip AS LONG ' clipped image
DIM sWidth AS INTEGER ' width of image
DIM sHeight AS INTEGER ' height of image
' -----------------
'| Begin demo code |
' -----------------
Image = _LOADIMAGE("canyon.png", 32) ' get image to clip from
sWidth = _WIDTH(Image) ' image width
sHeight = _HEIGHT(Image) ' image height
SCREEN _NEWIMAGE(sWidth, sHeight, 32) ' create graphics screen to hold image
_PUTIMAGE (0, 0), Image ' display the image
GetPolygon Image, Poly() ' get polygon using mouse
ClipPolygon Image, Poly(), Clip ' clip polygon from image
CLS
_PUTIMAGE (0, 0), Clip ' display the final polygon clipped from the image
'-----------------------------------------------------------------------------------------------------------------------------------------
SUB ClipPolygon (Image AS LONG, Poly() AS TYPE_IPOINT, Clip AS LONG)
' ---------------------------------------------
'| Clip an image contained in a polygon |
'| |
'| Image - the source image |
'| Poly() - the list of polygon points |
'| Clip - the returned clipped polygon image |
' ---------------------------------------------
CONST TRACE~& = _RGBA32(0, 0, 1, 255) ' polygon outline color
CONST OUTER~& = _RGBA32(255, 0, 255, 255) ' outside the polygon (bright magenta)
CONST INNER~& = _RGBA32(0, 0, 0, 0) ' inside the polygon (transparent black)
DIM Min AS TYPE_IPOINT ' minimum polygon x,y points seen (upper left boundary box)
DIM Max AS TYPE_IPOINT ' maximum polygon x,y points seen (lower right boundary box)
DIM ImageCopy AS LONG ' copy of image to work with
DIM Mask AS LONG ' image mask
DIM oDest AS LONG ' calling destination image
DIM m AS _MEM ' memory block holding image data
DIM e AS _OFFSET ' end of memory block
DIM o AS _OFFSET ' 4 byte pixel location within memory block
DIM p AS _UNSIGNED LONG ' individual pixel
' -------------------------------------
'| Create a copy of image to work with |
' -------------------------------------
oDest = _DEST ' save calling destination
ImageCopy = _COPYIMAGE(Image, 32) ' create a copy of image to work with
_DEST ImageCopy ' draw on the image copy
' --------------------------------------------------------
'| Get polygon bounding box while tracing polygon outline |
' --------------------------------------------------------
Min = Poly(0) ' seed minimum values
Max = Poly(0) ' seed maximum values
p = 0 ' reset point counter
PSET (Poly(0).x, Poly(0).y), TRACE ' set graphics cursor at first polypoint point
DO ' begin tracing loop
LINE -(Poly(p).x, Poly(p).y), TRACE ' draw a line to next polygon point
IF Poly(p).x < Min.x THEN ' is this the farthest left seen?
Min.x = Poly(p).x ' yes, record as minimum x
ELSEIF Poly(p).x > Max.x THEN ' no, is this the farthest right seen?
Max.x = Poly(p).x ' yes, record as maximum x
END IF
IF Poly(p).y < Min.y THEN ' if this the top-most seen?
Min.y = Poly(p).y ' yes, record as minimum y
ELSEIF Poly(p).y > Max.y THEN ' no, is this the bottom-most seen?
Max.y = Poly(p).y ' yes, record as maximum y
END IF
p = p + 1 ' increment point counter
LOOP UNTIL p > UBOUND(Poly) ' leave when all points examined
LINE -(Poly(0).x, Poly(0).y), TRACE ' connected last point of polygon to first point
' -------------------------------------
'| Create an image mask of the polygon |
' -------------------------------------
Mask = _NEWIMAGE(Max.x - Min.x + 3, Max.y - Min.y + 3, 32) ' create mask image holder
_PUTIMAGE (1, 1), ImageCopy, Mask, (Min.x, Min.y)-(Max.x, Max.y) ' copy polygon boundary to mask
_DEST Mask ' draw on mask
$CHECKING:OFF
PAINT (0, 0), OUTER, TRACE ' paint mask outside of polygon
m = _MEMIMAGE(Mask) ' create image memory buffer
o = m.OFFSET ' get start memory location
e = o + m.SIZE ' calculate end memory location
DO ' begin color replace loop
_MEMGET m, o, p ' get pixel at memory location
IF p <> OUTER THEN _MEMPUT m, o, INNER AS _UNSIGNED LONG ' if pixel is not outer color change to inner color
o = o + 4 ' advance 4 bytes (RGBA = 32 bits)
LOOP UNTIL o = e ' leave when end of memory reached
_MEMFREE m ' free memory buffer
$CHECKING:ON
' -----------------------------------
'| Apply the mask and clip the image |
' -----------------------------------
Clip = _NEWIMAGE(Max.x - Min.x, Max.y - Min.y, 32) ' create the clipped image holder
_PUTIMAGE (0, 0), Image, ImageCopy ' restore copy of image
_PUTIMAGE (Min.x - 1, Min.y - 1), Mask, ImageCopy ' place mask over image
_PUTIMAGE (0, 0), ImageCopy, Clip, (Min.x, Min.y)-(Max.x, Max.y) ' clip masked area from image
_CLEARCOLOR OUTER, Clip ' set outer mask color as transparent
_FREEIMAGE ImageCopy ' free image copy
_FREEIMAGE Mask ' free mask image
_DEST oDest ' restore calling destination
END SUB
'-----------------------------------------------------------------------------------------------------------------------------------------
SUB GetPolygon (Image AS LONG, Poly() AS TYPE_IPOINT)
' ---------------------------------------
'| Allow user to select a polygon region |
' ---------------------------------------
REDIM Poly(0) AS TYPE_IPOINT
DIM lStyle(1) AS _UNSIGNED INTEGER
DIM Style AS _BYTE
DIM c AS INTEGER
DIM Frame AS INTEGER
DIM NewLine AS TYPE_LINE
DIM PolyLine AS TYPE_LINE
DIM Intersection AS TYPE_IPOINT
lStyle(0) = &B1111000011110000 ' moving selection line styles
lStyle(1) = &B0000111100001111
' --------------------------------
'| wait for first point selection |
' --------------------------------
DO
_LIMIT 60
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) THEN
Poly(0).x = _MOUSEX
Poly(0).y = _MOUSEY
EXIT DO
END IF
LOOP
' ---------------------------------
'| Get subsequent point selections |
' ---------------------------------
DO
_LIMIT 60
_PUTIMAGE (0, 0), Image
WHILE _MOUSEINPUT: WEND
IF _MOUSEBUTTON(1) THEN
' -------------------------------------------------------------------------
'| User clicked left mouse button. Add x,y location to polygon point list. |
' -------------------------------------------------------------------------
REDIM _PRESERVE Poly(UBOUND(Poly) + 1) AS TYPE_IPOINT
Poly(UBOUND(Poly)).x = _MOUSEX
Poly(UBOUND(Poly)).y = _MOUSEY
' -------------------------------------------------
'| Get the line that creates this new polygon side |
' -------------------------------------------------
NewLine.Start.x = Poly(UBOUND(Poly) - 1).x
NewLine.Start.y = Poly(UBOUND(Poly) - 1).y
NewLine.Finish.x = _MOUSEX
NewLine.Finish.y = _MOUSEY
' ---------------------------------------------------------------
'| Check if polygon side collides with any existing polygon side |
' ---------------------------------------------------------------
FOR c = 1 TO UBOUND(Poly) - 1
IF c > 1 THEN
PolyLine.Start.x = Poly(c - 1).x
PolyLine.Start.y = Poly(c - 1).y
PolyLine.Finish.x = Poly(c).x
PolyLine.Finish.y = Poly(c).y
IF LineCollide(NewLine, PolyLine, Intersection) THEN
IF Intersection.x <> PolyLine.Finish.x AND Intersection.y <> PolyLine.Finish.y THEN
Poly(UBOUND(Poly)) = Poly(0)
EXIT SUB
END IF
END IF
END IF
NEXT c
ELSEIF _MOUSEBUTTON(2) THEN
' -----------------------------------------------------
'| User clicked right mouse button. Close the polygon. |
' -----------------------------------------------------
REDIM _PRESERVE Poly(UBOUND(Poly) + 1) AS TYPE_IPOINT
Poly(UBOUND(Poly)).x = _MOUSEX
Poly(UBOUND(Poly)).y = _MOUSEY
EXIT SUB
END IF
' -----------------------------------------
'| Draw the polygon selected to this point |
' -----------------------------------------
Frame = Frame + 1
IF Frame = 61 THEN Frame = 1
IF Frame MOD 15 = 0 THEN Style = 1 - Style
PSET (Poly(0).x, Poly(0).y)
FOR c = 1 TO UBOUND(Poly)
LINE -(Poly(c).x, Poly(c).y), , , lStyle(Style)
NEXT c
LINE -(_MOUSEX, _MOUSEY), , , lStyle(Style)
_DISPLAY
LOOP
END SUB
'-----------------------------------------------------------------------------------------------------------------------------------------
FUNCTION LineCollide% (L1 AS TYPE_LINE, L2 AS TYPE_LINE, Collide AS TYPE_IPOINT)
'https://www.jeffreythompson.org/collision-detection/line-line.php
DIM uA AS SINGLE
DIM uB AS SINGLE
LineCollide% = 0 ' assume no collision (FALSE)
Collide.x = -32767
Collide.y = -32767
' calculate the distance to intersection point
uA = ((L2.Finish.x - L2.Start.x) * (L1.Start.y - L2.Start.y) - (L2.Finish.y - L2.Start.y) * (L1.Start.x - L2.Start.x)) / _
((L2.Finish.y - L2.Start.y) * (L1.Finish.x - L1.Start.x) - (L2.Finish.x - L2.Start.x) * (L1.Finish.y - L1.Start.y))
uB = ((L1.Finish.x - L1.Start.x) * (L1.Start.y - L2.Start.y) - (L1.Finish.y - L1.Start.y) * (L1.Start.x - L2.Start.x)) / _
((L2.Finish.y - L2.Start.y) * (L1.Finish.x - L1.Start.x) - (L2.Finish.x - L2.Start.x) * (L1.Finish.y - L1.Start.y))
IF (uA >= 0) AND (uA <= 1) AND (uB >= 0) AND (uB <= 1) THEN ' are uA and uB both between 0 and 1?
LineCollide% = -1 ' yes, a collision occurred (TRUE)
Collide.x = L1.Start.x + (uA * (L1.Finish.x - L1.Start.x)) ' record collision point
Collide.y = L1.Start.y + (uA * (L1.Finish.y - L1.Start.y))
END IF
END FUNCTION