diff options
author | Jesse Luehrs <doy@tozt.net> | 2014-10-07 15:43:18 -0400 |
---|---|---|
committer | Jesse Luehrs <doy@tozt.net> | 2014-10-07 15:43:18 -0400 |
commit | c58bbc3a8368dc96f1a07e2ee3bf0825c9e2af34 (patch) | |
tree | 6ef718fb22f4a48df82d47897c9140595efda715 | |
parent | 12392181b58a25b8f63410d10759457e070ad24e (diff) | |
download | image-pnm-c58bbc3a8368dc96f1a07e2ee3bf0825c9e2af34.tar.gz image-pnm-c58bbc3a8368dc96f1a07e2ee3bf0825c9e2af34.zip |
implement P4
-rw-r--r-- | lib/Image/PNM.pm | 79 | ||||
-rw-r--r-- | t/P1.t | 6 | ||||
-rw-r--r-- | t/P2.t | 6 | ||||
-rw-r--r-- | t/P3.t | 6 | ||||
-rw-r--r-- | t/P4.t | 63 | ||||
-rw-r--r-- | t/data/P4.pbm | bin | 0 -> 54 bytes |
6 files changed, 160 insertions, 0 deletions
diff --git a/lib/Image/PNM.pm b/lib/Image/PNM.pm index 5136220..b927b44 100644 --- a/lib/Image/PNM.pm +++ b/lib/Image/PNM.pm @@ -138,6 +138,36 @@ HEADER return $data; } +sub _as_string_P4 { + my $self = shift; + + my $data = <<HEADER; +P4 +$self->{w} $self->{h} +HEADER + + for my $row (@{ $self->{pixels} }) { + my @vals = map { + my $val; + if (ref($_)) { + $val = $self->_to_greyscale(@$_); + } + else { + $val = $_; + } + $val * 2 > $self->{max} ? '0' : '1' + } @$row; + push @vals, '0' until @vals % 8 == 0; + while (@vals) { + my $bits = join('', splice(@vals, 0, 8)); + my $byte = oct("0b$bits"); + $data .= pack("C", $byte); + } + } + + return $data; +} + sub _parse_string { my $self = shift; my ($string) = @_; @@ -253,6 +283,24 @@ sub _parse_pnm_P3 { } } +sub _parse_pnm_P4 { + my $self = shift; + my ($next_line) = @_; + + $self->{max} = 1; + + my $next_word = $self->_make_next_bitfield($next_line, 1); + + $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 _make_next_word { my $self = shift; my ($next_line, $ws) = @_; @@ -277,6 +325,37 @@ sub _make_next_word { }; } +sub _make_next_bitfield { + my $self = shift; + my ($next_line, $bits) = @_; + + my @words; + return sub { + if (!@words) { + my $line = $next_line->(); + return unless $line; + if ($bits) { + my $padding = 8 - ($self->{w} % 8); + my $per = int($self->{w} / 8) + 1; + while (length($line)) { + my $chunk = substr($line, 0, $per, ''); + push @words, map { + split '', sprintf("%08b", $_) + } unpack("C*", $chunk); + pop @words for 1..$padding; + } + } + else { + @words = unpack("C*", $line); + } + } + my $word = shift @words; + die "Invalid color: $word" + unless $word =~ /^[0-9]+$/ && $word >= 0 && $word <= $self->{max}; + return $word; + }; +} + sub _to_greyscale { my $self = shift; my ($r, $g, $b) = @_; @@ -54,4 +54,10 @@ P3 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 IMAGE +is($image->as_string('P4') . "\n", <<IMAGE); +P4 +6 8 +\x00\x30\x48\x84\xfc\x84\x84\x00 +IMAGE + done_testing; @@ -54,4 +54,10 @@ P3 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 IMAGE +is($image->as_string('P4') . "\n", <<IMAGE); +P4 +6 8 +\x00\x30\x48\x84\xfc\x84\x84\x00 +IMAGE + done_testing; @@ -54,4 +54,10 @@ P3 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 255 IMAGE +is($image->as_string('P4') . "\n", <<IMAGE); +P4 +6 8 +\x00\x30\x48\x84\xfc\x84\x84\x00 +IMAGE + done_testing; @@ -0,0 +1,63 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Test::More; + +use Image::PNM; + +my $image = Image::PNM->new('t/data/P4.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 + +is($image->as_string('P2'), <<IMAGE); +P2 +6 8 +1 +1 1 1 1 1 1 +1 1 0 0 1 1 +1 0 1 1 0 1 +0 1 1 1 1 0 +0 0 0 0 0 0 +0 1 1 1 1 0 +0 1 1 1 1 0 +1 1 1 1 1 1 +IMAGE + +is($image->as_string('P3'), <<IMAGE); +P3 +6 8 +1 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +1 1 1 1 1 1 0 0 0 0 0 0 1 1 1 1 1 1 +1 1 1 0 0 0 1 1 1 1 1 1 0 0 0 1 1 1 +0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 +0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 +0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 +0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 +1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 +IMAGE + +is($image->as_string('P4') . "\n", <<IMAGE); +P4 +6 8 +\x00\x30\x48\x84\xfc\x84\x84\x00 +IMAGE + +done_testing; diff --git a/t/data/P4.pbm b/t/data/P4.pbm Binary files differnew file mode 100644 index 0000000..3512376 --- /dev/null +++ b/t/data/P4.pbm |