\ 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 ;