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;