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;