pbm2ZPL.pl

   1 #!/usr/bin/perl
   2 use warnings;
   3 use strict;
   4 use autodie;
   5 use Data::Dump qw(dump);
   6
   7 # DG compression is documented in ZPL II Programming Guide Volume Two, page 71-72
   8
   9 my $compress = $ENV{COMPRESS} || 1;
  10
  11 my $pnm_file = shift @ARGV || die "usage: $0 print.pnm";
  12
  13 open(my $fh, '<', $pnm_file);
  14 my $p4 = <$fh>; chomp $p4;
  15 die "no P4 header in [$p4] from $pnm_file" unless $p4 eq 'P4';
  16 my $size = <$fh>; chomp $size;
  17 my ( $w, $h ) = split(/ /,$size,$2);
  18 warn "WARNING: width of $pnm_file not 832 but $w !\n" if $w != 832;
  19 local $/ = undef;
  20 my $bitmap = <$fh>;
  21
  22
  23 print "^XA~TA000~JSN^LT18^MNW^MTD^PON^PMN^LH0,0^JMA^PR4,4^MD13^JUS^LRN^CI0^XZ";
  24
  25 printf "~DG000.GRF,%d,%d,\r\n", $w / 8 * $h, $w / 8;
  26
  27 my $last_line = '';
  28
  29 sub zpl_compress {
  30         my $compress = shift;
  31         my $repeat = length($compress);
  32         my $out;
  33         while ( $repeat >= 400 ) {
  34                 $out .= 'z';
  35                 $repeat -= 400;
  36         }
  37         if ( $repeat >= 20 ) {
  38                 $out .= chr( ord('f') + ( $repeat / 20 ) );
  39                 $repeat %= 20;
  40         }
  41         if ( $repeat > 0 ) {
  42                 $out .= chr( ord('F') + $repeat );
  43         }
  44         $out .= substr($compress,0,1); # char
  45         warn "## zpl_compress $repeat = $compress -> $out\n";
  46         return $out;
  47 }
  48
  49 foreach my $y ( 0 .. $h - 1 ) {
  50         my $line = substr( $bitmap, $y * ( $w / 8 ), $w / 8 );
  51         if ( $line eq $last_line ) {
  52                 print ":" && warn "# $y repeat previous line\n";
  53         } else {
  54                 my $hex = unpack('H*', $line);
  55                 if ( $compress ) {
  56 #                       $last_line = $line;
  57                         $hex =~ s/0+$/,/  && warn "# $y fill 0 to right\n";
  58                         $hex =~ s/F+$/!/i && warn "# $y fill 1 to right\n";
  59                         $hex =~ s/((.)\2+)/zpl_compress($1)/egs;
  60                 }
  61                 print $hex;
  62         }
  63 }
  64
  65 print "^XA\r\n^MMT\r\n^LL0328\r\n^PW831\r\n^LS0\r\n^FT0,352^XG000.GRF,1,1^FS\r\n^PQ1,0,1,Y^XZ\r\n^XA^ID000.GRF^FS^XZ";