aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Family Day update

Browse source
This commit is contained in:
Ingy döt Net 2020-02-17 23:21:07 -08:00
parent aac6731f2c
commit 9ad63ea473
2442 changed files with 39761 additions and 8255 deletions
Download patch file Download diff file Expand all files Collapse all files

72
Task/Bitmap-Flood-fill/Perl-6/bitmap-flood-fill.pl6 Normal file
View file

@ -0,0 +1,72 @@
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;

20
Task/Bitmap-Flood-fill/REXX/bitmap-flood-fill.rexx
View file

@ -4,22 +4,22 @@ red = '000000000000000011111111'b /* " " red " "
green= '000000001111111100000000'b /* " " green " " " */
white= '111111111111111111111111'b /* " " white " " " */
/*image is defined to the test image. */
hx=125; hy=125 /*define limits (X,Y) for the image. */
area=white; call fill 125, 25, red /*fill the white area in red. */
area=black; call fill 125, 125, green /*fill the center orb in green. */
hx= 125; hy= 125 /*define limits (X,Y) for the image. */
area= white; call fill 125, 25, red /*fill the white area in red. */
area= black; call fill 125, 125, green /*fill the center orb in green. */
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fill: procedure expose image. hx hy area; parse arg x,y,fill_color /*obtain the args.*/
if x<1 | x>hx | y<1 | y>hy then return /*X or Y are outside of the image area*/
pixel=image.x.y /*obtain the color of the X,Y pixel. */
if pixel\==area then return /*the pixel has already been filled */
pixel= image.x.y /*obtain the color of the X,Y pixel. */
if pixel \== area then return /*the pixel has already been filled */
/*with the fill_color, or we are not */
/*within the area to be filled. */
image.x.y=fill_color /*color desired area with fill_color. */
pixel=@(x , y-1); if pixel==area then call fill x , y-1, fill_color /*north*/
pixel=@(x-1, y ); if pixel==area then call fill x-1, y , fill_color /*west */
pixel=@(x+1, y ); if pixel==area then call fill x+1, y , fill_color /*east */
pixel=@(x , y+1); if pixel==area then call fill x , y+1, fill_color /*south*/
image.x.y= fill_color /*color desired area with fill_color. */
pixel= @(x , y-1); if pixel==area then call fill x , y-1, fill_color /*north*/
pixel= @(x-1, y ); if pixel==area then call fill x-1, y , fill_color /*west */
pixel= @(x+1, y ); if pixel==area then call fill x+1, y , fill_color /*east */
pixel= @(x , y+1); if pixel==area then call fill x , y+1, fill_color /*south*/
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
@: parse arg $x,$y; return image.$x.$y /*return with color of the X,Y pixel.*/