Flood fill

Using bits and pieces from various other bitmap tasks.

class Pixel { has Int ($.R, $.G, $.B) }
class Bitmap {
    has Int ($.width, $.height);
    has Pixel @.data;

    method pixel(
	    $i where ^$!width,
	    $j where ^$!height
	    --> Pixel
      ) is rw { @!data[$i + $j * $!width] }
}

role PPM {
    method P6 returns Blob {
	"P6\n{self.width} {self.height}\n255\n".encode('ascii')
	~ Blob.new: flat map { .R, .G, .B }, self.data
    }
}

sub load-ppm ( $ppm ) {
    my $fh    = $ppm.IO.open( :enc('ISO-8859-1') );
    my $type  = $fh.get;
    my ($width, $height) = $fh.get.split: ' ';
    my $depth = $fh.get;
    Bitmap.new( width => $width.Int, height => $height.Int,
      data => ( $fh.slurp.ords.rotor(3).map:
        { Pixel.new(R => $_[0], G => $_[1], B => $_[2]) } )
    )
}

sub color-distance (Pixel $c1, Pixel $c2) {
    sqrt( ( ($c1.R - $c2.R)² + ($c1.G - $c2.G)² + ($c1.B - $c2.B)² ) / ( 255 * sqrt(3) ) );
}

sub flood ($img, $x, $y, $c1) {
    my $c2 = $img.pixel($x, $y);
    my $max-distance = 10;
    my @queue;
    my %checked;
    check($x, $y);
    for @queue -> [$x, $y] {
        $img.pixel($x, $y) = $c1.clone;
    }

    sub check ($x, $y) {
        my $c3 = $img.pixel($x, $y);

        if color-distance($c2, $c3) < $max-distance {
            @queue.push: [$x,$y];
            @queue.elems;
            %checked{"$x,$y"} = 1;
            check($x - 1, $y) if $x > 0               and %checked{"{$x - 1},$y"}:!exists;
            check($x + 1, $y) if $x < $img.width - 1  and %checked{"{$x + 1},$y"}:!exists;
            check($x, $y - 1) if $y > 0               and %checked{"$x,{$y - 1}"}:!exists;
            check($x, $y + 1) if $y < $img.height - 1 and %checked{"$x,{$y + 1}"}:!exists;
        }
    }
}

my $infile = './Unfilled-Circle.ppm';

my Bitmap $b = load-ppm( $infile ) but PPM;

flood($b, 5,     5, Pixel.new(:255R, :0G, :0B));
flood($b, 5,   125, Pixel.new(:255R, :0G, :0B));
flood($b, 125,   5, Pixel.new(:255R, :0G, :0B));
flood($b, 125, 125, Pixel.new(:255R, :0G, :0B));
flood($b, 50,   50, Pixel.new(:0R, :0G, :255B));

my $outfile = open('./Bitmap-flood-perl6.ppm', :w, :bin);

$outfile.write: $b.P6;

See output image Bitmap-flood-perl6 (offsite image file, converted to PNG for ease of viewing)

Last updated