From 64157f5b6f4649f7ca845cb119535863dd221822 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Tue, 7 Oct 2014 14:06:09 -0400 Subject: add P1 format --- lib/Image/PNM.pm | 68 +++++++++++++++++++++++++++++++++++++++++++++++--------- t/P1.t | 29 ++++++++++++++++++++++++ t/data/P1.pbm | 4 ++++ 3 files changed, 91 insertions(+), 10 deletions(-) create mode 100644 t/P1.t create mode 100644 t/data/P1.pbm 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 = <{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'), <