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} || 0;
  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 foreach my $y ( 0 .. $h - 1 ) {
  30         my $line = substr( $bitmap, $y * ( $w / 8 ), $w / 8 );
  31         if ( $line eq $last_line ) {
  32                 print ":" && warn "# $y repeat previous line\n";
  33         } else {
  34                 my $hex = unpack('H*', $line);
  35                 if ( $compress ) {
  36 #                       $last_line = $line;
  37                         $hex =~ s/0+$/,/  && warn "# $y fill 0 to right\n";
  38                         $hex =~ s/F+$/!/i && warn "# $y fill 1 to right\n";
  39                 }
  40                 print $hex;
  41         }
  42 }
  43
  44 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";