GSM/SMS/Bitmap.pm

   1 package GSM::SMS::Bitmap;
   2 # Generic package for monochrome bitmaps
   3
   4 my $VERSION='0.1';
   5
   6 use strict;
   7 use warnings;
   8
   9 require Exporter;
  10 our @ISA=qw(Exporter);
  11 our @EXPORT=qw();
  12
  13 use Image::Magick;
  14 use Carp;
  15
  16
  17 sub new {
  18         my ($class, $arg, @rest) = @_;
  19         my $self={};
  20
  21         bless($self,$class);
  22
  23         my $img;
  24            if ("GSM::SMS::Bitmap" eq ref $arg) {
  25                 my($offset_x,$offset_y,$width,$height)=@rest;
  26                 $self->{"blob"  }="";
  27                 $self->{"width" }=$width;
  28                 $self->{"height"}=$height;
  29                 for my $y (0..$height-1) {
  30                         for my $x (0..$width-1) {
  31                                 ${$self->pixref($x,$y)}=$arg->pixget($offset_x+$x,$offset_y+$y);
  32                                 }
  33                         }
  34                 return $self;
  35                 }
  36         elsif ("Image::Magick" eq ref $arg) {
  37                 $img=$arg;
  38                 }
  39         else {
  40                 my $err;
  41                 $img=Image::Magick->new() or carp "Image::Magick->new(): $!" and return undef;
  42                 $err=$img->Read($arg) and carp "Image::Magick->Read(\"$arg\"): $err" and return undef;
  43                 }
  44
  45         $img->Set("magick"=>"mono");
  46         $self->{"blob"  }=$img->ImageToBlob();
  47         $self->{"width" }=$img->Get("columns");
  48         $self->{"height"}=$img->Get("height" );
  49         return $self;
  50 }
  51
  52 sub crop {
  53         my ($self, $width, $height) = @_;
  54
  55         if ($self->{"width"} > $width) {
  56                 carp "Cutting image width to $width pixels (from ".$self->{"width"}.")";
  57                 $self->{"width"}=$width;
  58         }
  59         if ($self->{"height"} > $height) {
  60                 carp "Cutting image height to $height pixels (from ".$self->{"height"}.")";
  61                 $self->{"height"}=$height;
  62         }
  63 }
  64
  65 sub pixref {
  66         my ($self, $x, $y) = @_;
  67         my $zero = 0;
  68
  69         return \$zero if 0  # out of bouds
  70                         || $x<0 || $x>=$self->{"width" }
  71                         || $y<0 || $y>=$self->{"height"}
  72                         ;
  73         return \vec($self->{"blob"},int(($self->{"width"}+7)/8)*8*$y + $x,1);
  74 }
  75
  76 sub pixget {
  77         my ($self, @rest) = @_;
  78
  79         return(${$self->pixref(@rest)});
  80 }
  81
  82 # Convert the bit stream to the list of byte values
  83 # Hmm, it is a back ineffective to unpack() it back but who cares
  84 # Two versions exist - FIXME: how to merge them?
  85
  86 sub pixlist_horiz {
  87         my ($self) = @_;
  88
  89         my $bits="";
  90         for my $y (0..$self->{"height"}-1) {
  91                 for my $x (0..int(($self->{"width"}+7)&~0x7)-1) {
  92                         $bits.=$self->pixget($x,$y);
  93                 }
  94         }
  95         return unpack("C*",pack("B*",$bits));
  96 }
  97
  98 sub pixlist_vert {
  99         my ($self) = @_;
 100
 101         my $bits="";
 102         for my $x (0..$self->{"width"}-1) {
 103                 for my $y (0..int(($self->{"height"}+7)&~0x7)-1) {
 104                         $bits.=$self->pixget($x,$y);
 105                 }
 106         }
 107         return unpack("C*",pack("B*",$bits));
 108 }
 109
 110 1;