\ floodfill 3/16/00 10:29 am NAB
\ A non-recursive flood fill algorithm.
\ Fills any bounded area with the
\ current drawing color.
\ Do not fill any unbounded area,
\ or area right on the edge of the
\ screen.
\ OS3.5 required.
needs graphics
needs core-ext
needs color
\ OS3.5 call (WinRGBToIndex):
: current-color ( -- color )
get-colors 2drop sp@ 41886 systrap
2drop 2drop d0 drop ;
\ OS3.5 call (WinGetPixel):
: get-pixel ( y x -- color )
41857 systrap 2drop d0 drop ; inline
variable fill-color
: clear? ( y x -- flag )
get-pixel fill-color @ = ; inline
: border? ( y x -- flag )
clear? invert ; inline
: fill-line ( y x -- left right )
2dup ( y x y x)
begin 1+ 2dup border? until
( y x y end)
1- >r drop 1+ ( y x-1 )
begin 1- 2dup border? until
1+ ( y begin)
over r> ( y begin y end )
2over 2over line
nip rot drop ;
: testpair ( y x -- flag )
2dup clear? >r 1+ border? r> and ;
variable points
: add-point ( -- ) 1 points +! ;
: scanline
( y left right -- y | y x1 [... y xn] y )
1+ swap ( right+1 left ) ?do
i 2dup testpair if
add-point over
else drop then
loop ;
: scanlast ( y y right -- y | y right y )
2dup clear? if add-point rot
else 2drop then ;
: pour ( y x -- )
1 points !
begin
2dup clear? if
over swap ( y y x ) fill-line 2>r
1- 2r@ scanline dup r@ scanlast
2 + 2r@ scanline dup r> scanlast
r> 2drop
else 2drop
then ( )
-1 points +! points @ 0= until ;
: floodfill ( y x -- )
2dup get-pixel dup fill-color !
current-color <> if pour
else 2drop then ;