File Coverage

blib/lib/Data/Petitcom/Resource/COL.pm

Criterion	Covered	Total	%
statement	50	50	100.0
branch			n/a
condition	1	2	50.0
subroutine	13	13	100.0
pod	0	2	0.0
total	64	67	95.5

package Data::Petitcom::Resource::COL;

use strict;
use warnings;

use parent qw{ Data::Petitcom::Resource };

use bytes ();
use Data::Petitcom::PTC;
use Data::Petitcom::BMP qw{ Load Dump RGB555toRGB888 RGB888toRGB555 };

use constant RESOUECE            => 'COL';
use constant PTC_OFFSET_DATA     => 0x0C;
use constant PTC_COLORMAP_LENGTH => 512;     # RGB555(16bit) x 256colors
use constant COLORMAP_COLS       => 16;
use constant PTC_NAME            => 'DPTC_COL';

sub save {
    my $self = shift;
    my %opts = @_;
    my $name = delete $opts{name};
    my $ptc  = Data::Petitcom::PTC->new(
        resource => RESOUECE,
        name     => $name || PTC_NAME,
        version  => 'PETC0100',
    );
    my $bmp    = Load( $self->data );
    my $rgb555 = RGB888toRGB555( $bmp->{colormap} );
    $ptc->data( pack 'v*', @$rgb555 );
    return $ptc;
}

sub load {
    my $self = shift;
    my $ptc  = shift;
    my $raw_colormap
        = bytes::substr( $ptc->data, PTC_OFFSET_DATA, PTC_COLORMAP_LENGTH );
    my @rgb555  = unpack 'v*', $raw_colormap;    # LE-short
    my $rgb888  = RGB555toRGB888(@rgb555);
    my $raw_bmp = Dump(
        width    => COLORMAP_COLS,
        height   => COLORMAP_COLS,
        colormap => $rgb888,
        pixels => [ map {
            ( (COLORMAP_COLS - 1) - int( $_ / COLORMAP_COLS ) ) * COLORMAP_COLS + $_ % COLORMAP_COLS
        } ( 0 .. 255 ) ],
    );
    $self->data($raw_bmp);
    return $self;
}

1;