summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2014-10-07 14:06:09 -0400
committerJesse Luehrs <doy@tozt.net>2014-10-07 14:11:00 -0400
commit64157f5b6f4649f7ca845cb119535863dd221822 (patch)
treede45a4943ae8edf39097a866d346dd6b771b4b9d
parentffcd82f3b5f1fb197550b005b11cae1651a8fe34 (diff)
downloadimage-pnm-64157f5b6f4649f7ca845cb119535863dd221822.tar.gz
image-pnm-64157f5b6f4649f7ca845cb119535863dd221822.zip
add P1 format
-rw-r--r--lib/Image/PNM.pm68
-rw-r--r--t/P1.t29
-rw-r--r--t/data/P1.pbm4
3 files changed, 91 insertions, 10 deletions
diff --git a/lib/Image/PNM.pm b/lib/Image/PNM.pm
index 793750d..7302683 100644
--- a/lib/Image/PNM.pm
+++ b/lib/Image/PNM.pm
@@ -73,6 +73,21 @@ sub raw_pixel {
return $pixel;
}
+sub _as_string_P1 {
+ my $self = shift;
+
+ my $data = <<HEADER;
+P1
+$self->{w} $self->{h}
+HEADER
+
+ for my $row (@{ $self->{pixels} }) {
+ $data .= join(' ', map { $_ ? '0' : '1' } @$row) . "\n";
+ }
+
+ return $data;
+}
+
sub _as_string_P3 {
my $self = shift;
@@ -140,6 +155,24 @@ sub _parse_pnm {
return $self->$method($next_line_nocomments);
}
+sub _parse_pnm_P1 {
+ my $self = shift;
+ my ($next_line) = @_;
+
+ $self->{max} = 1;
+
+ my $next_word = $self->_make_next_word($next_line, 0);
+
+ $self->{pixels} = [];
+ for my $i (1..$self->{h}) {
+ my $row = [];
+ for my $j (1..$self->{w}) {
+ push @$row, $next_word->() ? '0' : '1';
+ }
+ push @{ $self->{pixels} }, $row;
+ }
+}
+
sub _parse_pnm_P3 {
my $self = shift;
my ($next_line) = @_;
@@ -149,16 +182,7 @@ sub _parse_pnm_P3 {
unless $max =~ /^[0-9]+$/ && $max > 0;
$self->{max} = $max;
- my @words;
- my $next_word = sub {
- if (!@words) {
- chomp(my $line = $next_line->());
- @words = split ' ', $line;
- }
- my $word = shift @words;
- die "Invalid color: $word" unless $word =~ /^[0-9]+$/;
- return $word;
- };
+ my $next_word = $self->_make_next_word($next_line, 1);
$self->{pixels} = [];
for my $i (1..$self->{h}) {
@@ -174,4 +198,28 @@ sub _parse_pnm_P3 {
}
}
+sub _make_next_word {
+ my $self = shift;
+ my ($next_line, $ws) = @_;
+
+ my @words;
+ return sub {
+ if (!@words) {
+ my $line = $next_line->();
+ return unless $line;
+ chomp($line);
+ if ($ws) {
+ @words = split ' ', $line;
+ }
+ else {
+ @words = split '', $line;
+ }
+ }
+ my $word = shift @words;
+ die "Invalid color: $word"
+ unless $word =~ /^[0-9]+$/ && $word >= 0 && $word <= $self->{max};
+ return $word;
+ };
+}
+
1;
diff --git a/t/P1.t b/t/P1.t
new file mode 100644
index 0000000..3fbfb04
--- /dev/null
+++ b/t/P1.t
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+use Test::More;
+
+use Image::PNM;
+
+my $image = Image::PNM->new('t/data/P1.pbm');
+
+is($image->width, 6);
+is($image->height, 8);
+is($image->max_pixel_value, 1);
+is_deeply($image->raw_pixel(1, 2), [0, 0, 0]);
+is_deeply($image->pixel(4, 1), [0, 0, 0]);
+
+is($image->as_string('P1'), <<IMAGE);
+P1
+6 8
+0 0 0 0 0 0
+0 0 1 1 0 0
+0 1 0 0 1 0
+1 0 0 0 0 1
+1 1 1 1 1 1
+1 0 0 0 0 1
+1 0 0 0 0 1
+0 0 0 0 0 0
+IMAGE
+
+done_testing;
diff --git a/t/data/P1.pbm b/t/data/P1.pbm
new file mode 100644
index 0000000..276a9d8
--- /dev/null
+++ b/t/data/P1.pbm
@@ -0,0 +1,4 @@
+P1
+# CREATOR: GIMP PNM Filter Version 1.1
+6 8
+000000001100010010100001111111100001100001000000