pixler/include/tools.bm
2026-05-12 11:47:31 +02:00

224 lines
7.3 KiB
Text

sub thickbox(sx,sy,ex,ey,col as long)
thickline sx, sy, ex, sy, col
thickline ex, sy, ex, ey, col
thickline ex, ey, sx, ey, col
thickline sx, ey, sx, sy, col
end sub
sub filledbox(sx,sy,ex,ey,col as long)
line(sx,sy)-(ex,ey),col,bf
end sub
sub filledPolygon (Points() as long, col as long)
dim i as integer, j as integer
dim x1 as single, y1 as single, x2 as single, y2 as single
dim intersectX as single
' get the number of points from the upper bound of the array
' divide by 2 since we have x,y pairs
dim numPoints as integer
numPoints = (ubound(Points) + 1) \ 2
' loop through each scanline (rows of pixels)
dim intersections(100) as single
dim numIntersections as integer
for y = 0 to _height ' adjust for screen height
numIntersections = 0
' check for intersections between the polygon edges and this scanline
for i = 0 to numPoints - 1
x1 = Points(i * 2)
y1 = Points(i * 2 + 1)
x2 = Points(((i + 1) mod numPoints) * 2)
y2 = Points(((i + 1) mod numPoints) * 2 + 1)
' check if the scanline intersects with the edge of the polygon
if ((y1 > y and y2 <= y) or (y2 > y and y1 <= y)) then
' calculate intersection point with the scanline
intersectX = x1 + (y - y1) * (x2 - x1) / (y2 - y1)
intersections(numIntersections) = intersectX
numIntersections = numIntersections + 1
end if
next i
' sort the intersections (sort by x-coordinates)
for i = 0 to numIntersections - 1
for j = i + 1 to numIntersections - 1
if intersections(i) > intersections(j) then
swap intersections(i), intersections(j)
end if
next j
next i
' fill the area between pairs of intersections
for i = 0 to numIntersections - 1 step 2
line(intersections(i),y)-(intersections(i+1),y),col
next i
next y
end sub
sub thickpixel(x,y,col as long)
if state.brushsize=1 then
pset(x,y),col
else
line(x-0.5 * state.brushsize,y-0.5 * state.brushsize)-(x+0.5 * state.brushsize,y+0.5 * state.brushsize),col,bf
end if
end sub
sub thickline(x1,y1,x2,y2, col as long)
if state.brushsize=1 then
line(x1,y1)-(x2,y2),col
else
dim tempimg as long
dim od as long
tempimg=_newimage(1,1,32)
od =_dest
_dest tempimg
pset(0,0),col
_dest od
a = _Atan2(y2 - y1, x2 - x1)
a = a + _Pi / 2
x0 = 0.5 * state.brushsize * Cos(a)
y0 = 0.5 * state.brushsize * Sin(a)
_maptriangle _seamless(0,0)-(0,0)-(0,0),tempimg to(x1-x0, y1-y0)-(x1+x0,y1+y0)-(x2+x0,y2+y0),,_smooth
_maptriangle _seamless(0,0)-(0,0)-(0,0),tempimg to(x1-x0, y1-y0)-(x2+x0,y2+y0)-(x2-x0,y2-y0),,_smooth
_freeimage tempimg
end if
end sub
Sub polygon (pa() As Long,col as long)
For i = 2 To UBound(pa) Step 2
thickLine pa(i - 2), pa(i - 1),pa(i), pa(i + 1),col
Next i
thickLine pa(ubound(pa)-1), pa(ubound(pa)),pa(0), pa(1),col
End Sub
sub thickcircle(x, y, r, col as long)
if state.brushsize <= 1 then
circle (x, y), r, col
else
dim rp as single, rm as single, rp2 as single, rm2 as single
dim rpi2 as single, rmi2 as single, sp as single, sm as single
dim i as single
rp = r + state.brushsize / 2
rm = r - state.brushsize / 2
' If the brush is thicker than the circle, it's just a filled circle
if rm < 0 then
filledcircle x, y, rp, col
exit sub
end if
rp2 = rp ^ 2
rm2 = rm ^ 2
' Outer edges (Top/Bottom caps)
for i = -rp to -rm step .2
rpi2 = rp2 - i ^ 2
if rpi2 < 0 then rpi2 = 0 ' Safety Gate
sp = sqr(rpi2)
line (x + i, y - sp)-(x + i, y + sp), col, bf
next
' Side rings (where the hole in the middle exists)
for i = -rm to rm step .2
rpi2 = rp2 - i ^ 2
rmi2 = rm2 - i ^ 2
if rpi2 < 0 then rpi2 = 0 ' Safety Gate
if rmi2 < 0 then rmi2 = 0 ' Safety Gate
sp = sqr(rpi2)
sm = sqr(rmi2)
' Draw the top and bottom segments only
line (x + i, y + sm)-(x + i, y + sp), col, bf
line (x + i, y - sm)-(x + i, y - sp), col, bf
next
' Outer edges (Right cap)
for i = rm to rp step .2
rpi2 = rp2 - i ^ 2
if rpi2 < 0 then rpi2 = 0 ' Safety Gate
sp = sqr(rpi2)
line (x + i, y - sp)-(x + i, y + sp), col, bf
next
end if
end sub
sub filledcircle(x,y,r,col as long)
dim __radius as integer, radiuserror as integer
dim tx as integer, ty as integer
__radius=abs(r)-1
radiuserror=-__radius
tx=__radius
ty=0
line (x-tx,y)-(x+tx,y),col
while tx>ty
radiuserror=radiuserror+ty*2+1
if radiuserror >= 0 then
if tx<>ty+1 then
line (x-ty,y-tx)-(x+ty,y-tx),col
line (x-ty,y+tx)-(x+ty,y+tx),col
end if
tx=tx-1
radiuserror=radiuserror-tx*2
end if
ty=ty+1
line (x-tx,y-ty)-(x+tx,y-ty),col
line (x-tx,y+ty)-(x+tx,y+ty),col
wend
end sub
SUB FloodFill (startX, startY, fillColor~&)
' We use a simple array as a stack for (x, y) pairs
' For large images, you may need to increase this size
DIM stackX(2000) AS INTEGER
DIM stackY(2000) AS INTEGER
targetColor~&=point(startX,startY)
if targetColor~&=fillColor~& then exit sub
stackPtr = 1
stackX(stackPtr) = startX
stackY(stackPtr) = startY
WHILE stackPtr > 0
curX = stackX(stackPtr)
curY = stackY(stackPtr)
stackPtr = stackPtr - 1
' Move to the left edge of the span
x = curX
WHILE POINT(x, curY) = targetColor~& AND x >= 0
x = x - 1
WEND
x = x + 1
spanAbove = 0
spanBelow = 0
' Process the span moving right
WHILE POINT(x, curY) = targetColor~& AND x < _WIDTH
PSET (x, curY), fillColor~&
' Check row above
IF curY > 0 THEN
IF spanAbove = 0 AND POINT(x, curY - 1) = targetColor~& THEN
stackPtr = stackPtr + 1
stackX(stackPtr) = x
stackY(stackPtr) = curY - 1
spanAbove = 1
ELSEIF spanAbove = 1 AND POINT(x, curY - 1) <> targetColor~& THEN
spanAbove = 0
END IF
END IF
' Check row below
IF curY < _HEIGHT - 1 THEN
IF spanBelow = 0 AND POINT(x, curY + 1) = targetColor~& THEN
stackPtr = stackPtr + 1
stackX(stackPtr) = x
stackY(stackPtr) = curY + 1
spanBelow = 1
ELSEIF spanBelow = 1 AND POINT(x, curY + 1) <> targetColor~& THEN
spanBelow = 0
END IF
END IF
x = x + 1
WEND
WEND
END SUB