#Perl, 276 287 (289 300 - 13) #

Perl, 276 287 (289 300 - 13)

Regex to the Rescue! Perl, 276 287 (289 300 - 13)

use strict;
use warnings;

# Read in the image file
local $/ = undef;

open IMAGEIN, '<', "in.pbm" or die "Can't read 'in.pbm': $!";
my $image_data = <IMAGEIN>;
close IMAGEIN;

# Remove the header and any comments
$_ = $image_data;
s/(P1)|(#.*\n)//g;

# Divide into width, height, and pixels
/^\s*(\d+)\s+(\d+)([\s\S]*)$/;
(my $width, my $height, $_) = ($1, $2, $3);

# Remove anything that isn't a number from the pixel data
s/\D//g;
my $pixels = $_;

# Determine the new dimensions
my $crop = $width < $height ? $width : $height;

# Calculate total to remove along each axis
my $drop_width  = $width  - $crop;
my $drop_height = $height - $crop;

# Calculate how much to remove from the first side along each axis
my $initial_drop_width  = int($drop_width  / 2);
my $initial_drop_height = int($drop_height / 2);

# Calculate total pixels to the new top-left corner
my $initial_drop = $width * $initial_drop_height + $initial_drop_width;

# Remove the pixels preceding the corner
$_ = $pixels;
while (32760 < $initial_drop)  # Stay under regex limit
{
    s/^\d{32760}//;
    $initial_drop -= 32760;
}
s/^\d{$initial_drop}//;

# Take *crop* rows of *crop* pixels
$pixels = "";
for (my $i=0; $i<$crop; $i++)
{
    /^(\d{$crop})(\d{$drop_width})(.*)/;
    $pixels .= $1 . "\n";
    $_ = $3 . "0"x$width;  # Add some 0s to ensure final match
}

# Construct the new, cropped image
my $cropped_image = "P1\n$crop $crop\n$pixels";

# Write out the image file
open IMAGEOUT, '>', "out.pbm" or die "Can't write 'out.pbm': $!";
print IMAGEOUT $cropped_image;
close IMAGEOUT;

#Perl, 276 287 (289 300 - 13) #

Regex to the Rescue!

use strict;
use warnings;

# Read in the image file
local $/ = undef;

open IMAGEIN, '<', "in.pbm" or die "Can't read 'in.pbm': $!";
my $image_data = <IMAGEIN>;
close IMAGEIN;

# Remove the header and any comments
$_ = $image_data;
s/(P1)|(#.*\n)//g;

# Divide into width, height, and pixels
/^\s*(\d+)\s+(\d+)([\s\S]*)$/;
(my $width, my $height, $_) = ($1, $2, $3);

# Remove anything that isn't a number from the pixel data
s/\D//g;
my $pixels = $_;

# Determine the new dimensions
my $crop = $width < $height ? $width : $height;

# Calculate total to remove along each axis
my $drop_width  = $width  - $crop;
my $drop_height = $height - $crop;

# Calculate how much to remove from the first side along each axis
my $initial_drop_width  = int($drop_width  / 2);
my $initial_drop_height = int($drop_height / 2);

# Calculate total pixels to the new top-left corner
my $initial_drop = $width * $initial_drop_height + $initial_drop_width;

# Remove the pixels preceding the corner
$_ = $pixels;
while (32760 < $initial_drop)  # Stay under regex limit
{
    s/^\d{32760}//;
    $initial_drop -= 32760;
}
s/^\d{$initial_drop}//;

# Take *crop* rows of *crop* pixels
$pixels = "";
for (my $i=0; $i<$crop; $i++)
{
    /^(\d{$crop})(\d{$drop_width})(.*)/;
    $pixels .= $1 . "\n";
    $_ = $3 . "0"x$width;  # Add some 0s to ensure final match
}

# Construct the new, cropped image
my $cropped_image = "P1\n$crop $crop\n$pixels";

# Write out the image file
open IMAGEOUT, '>', "out.pbm" or die "Can't write 'out.pbm': $!";
print IMAGEOUT $cropped_image;
close IMAGEOUT;

Regex to the Rescue! Perl, 287 (300 - 13)

local$/;open I,"in.pbm";$_=<I>;s/(P1)|(#.*\n)//g;/^\s*(\d+)\s+(\d+)([\s\S]*)$/;($w,$h,$_)=($1,$2,$3);$c=$w<$h?$w:$h;s/\D//g;$d=$w-$c;$z=$w*int(($h-$c)/2)+int($d/2);while(0<$z){s/^\d//;$z--};while($i<$c){/^(\d{$c})(\d{$d})(.*)/;$p.=$1."\n";$_=$3."0"x$w;$i++}open O,'>',"out.pbm";print O"P1\n$c $c\n$p"

Regex to the Rescue! Perl, 276 287 (289 300 - 13)

local$/;open I,"in.pbm";$_=<I>;s/(P1)|(#.*\n)//g;/^\s*(\d+)\s+(\d+)([\s\S]*)$/;($w,$h,$_)=($1,$2,$3);$c=$w<$h?$w:$h;s/\D//g;$d=$w-$c;while($z++<$w*int(($h-$c)/2)+int($d/2)){s/^\d//};while($i++<$c){/^(\d{$c})(\d{$d})(.*)/;$p.=$1."\n";$_=$3."0"x$w}open O,'>',"out.pbm";print O"P1\n$c $c\n$p"