package ToyPPM;
use ToyArrayFold;
use overload ('@{}' => 'image',
              '""'  => 'ppm_data');

sub new_from_ppm_data {
    my($class,$ppm_data) = @_;
    my($header,$width,$height,$maxval) =
        ($ppm_data =~ /^(P6\s+(?:\#[^\n]*\n)*\s*(\d+)\s+(\d+)\s+(\d+)\s)/o);
    die "That doesn't look like (toy) PPM data." if !defined $header;
    my %self;
    @self{qw(offset width height maxval)} =
        (length($header),$width+0,$height+0,$maxval+0);
    $self{'ppm_data'} = \$ppm_data;
    $self{'bytes_per_sample'} = $maxval <= 255 ? 1 : die "toy failure";
    $self{'depth'} = 3;
    $self{'bytes_per_pixel'} = $self{'bytes_per_sample'} * $self{'depth'};
    $self{'sample_template'} = $self{'bytes_per_sample'} == 1 ? "C" : "S";
    $self{'sample_count'} = $self{'width'} * $self{'height'} * $self{'depth'};
    bless \%self,$class;
}

sub height { $_[0]->{'height'} }
sub width  { $_[0]->{'width'} }
sub depth  { $_[0]->{'depth'} }

sub ppm_data { ${$_[0]->{'ppm_data'}} }

sub samples {
    my($self) = @_;
    return $self->{'samples'} ||= ToyPPM::ArrayOfSamples->new_array($self);
}

sub image {
    my($self) = @_;
    return $self->{'image'}   ||= ToyArrayFold->new_array($self->samples(),
							  # shape:
							  [ $self->{'height'},
							    $self->{'width'},
							    $self->{'depth'} ]
							  );
}


# Defines a method get_toy_api_ImageCMacros(), to use when writing
# _fast_ C methods which access the image data directly.
use ToyDefineArrayMethods
    (get_toy_api_ImageCMacros =>
     toy_folded => { shape => [ '$self->{"height"}',
                                '$self->{"width"}',
                                '$self->{"depth"}' ] },
     size_is_fixed =>
     packed_substr => { strref => '$self->{"ppm_data"}',
                        offset => '$self->{"offset"}',
                        template => '"C"' });



package ToyPPM::ArrayOfSamples;

use ToyDefineArrayMethods
    (new_array => TIEARRAY =>
     size_is_fixed =>
     packed_substr => { strref => '$self->{STRREF}',
                        offset => '$self->{OFFSET}',
                        template => '"C"' });

sub new {
    my($class,$ppm) = @_;
    bless {
        STRREF => $ppm->{'ppm_data'},
        OFFSET => $ppm->{'offset'},
    }, $class;
}


1;