pixler/include/tools.bm
2026-05-20 10:39:08 +02:00

224 lines
6.7 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