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 $size = <$fh>; chomp $size if $size =~ m/^#/;
  18 my ( $w, $h ) = split(/ /,$size,$2);
  19 warn "WARNING: width of $pnm_file not 832 but $w !\n" if $w != 832;
  20 local $/ = undef;
  21 my $bitmap = <$fh>;
  22
  23
  24 print '^XA';
  25 printf '~TA%03d', 0; # tear-off
  26 print '~JSN'; # sensor detect N = normal, 90%
  27 print '^LT18'; # label top -120 .. 120
  28 print '^MNW'; # media tracking N = continuous Y/W = web sensing M = mark sensing
  29 print '^MTD'; # media type T = termal D = direct (ribbon!)
  30 print '^PON'; # print orientation N = normal I = invert
  31 print '^PMN'; # print mirror Y/N
  32 print '^LH0,0'; # label home x,y
  33 print '^JMA'; # dots/mm A = 24/12/8/6 B = 12/6/4/3
  34 print '^PR4,4'; # print,slew,backfeed speed in inch/s 2 .. 12 [default: 2,6,2]
  35 print '^MD13'; # media darkness -30 .. 30 / XiIIIPlus 0..30/0.1 increments
  36 print '^JUS'; # configuration update F = factory default R = recall S = save
  37 print '^LRN'; # label reverse Y/N
  38 print '^CI0'; # change international font 0..255
  39 print '^XZ';
  40
  41 printf "~DG000.GRF,%d,%d,\r\n", $w / 8 * $h, $w / 8;
  42
  43 my $last_line = '';
  44
  45 sub zpl_compress {
  46         my $compress = shift;
  47         my $repeat = length($compress);
  48         my $out;
  49         while ( $repeat >= 400 ) {
  50                 $out .= 'z';
  51                 $repeat -= 400;
  52         }
  53         if ( $repeat >= 20 ) {
  54                 $out .= chr( ord('f') + ( $repeat / 20 ) );
  55                 $repeat %= 20;
  56         }
  57         if ( $repeat > 0 ) {
  58                 $out .= chr( ord('F') + $repeat );
  59         }
  60         $out .= substr($compress,0,1); # char
  61         warn "## zpl_compress $repeat = $compress -> $out\n";
  62         return $out;
  63 }
  64
  65 foreach my $y ( 0 .. $h - 1 ) {
  66         my $line = substr( $bitmap, $y * ( $w / 8 ), $w / 8 );
  67         if ( $line eq $last_line ) {
  68                 print ":" && warn "# $y repeat previous line\n";
  69         } else {
  70                 my $hex = unpack('H*', $line);
  71                 if ( $compress ) {
  72 #                       $last_line = $line;
  73                         $hex =~ s/0+$/,/  && warn "# $y fill 0 to right\n";
  74                         $hex =~ s/F+$/!/i && warn "# $y fill 1 to right\n";
  75                         $hex =~ s/((.)\2+)/zpl_compress($1)/egs;
  76                 }
  77                 print $hex;
  78         }
  79 }
  80
  81 print '^XA';
  82 print '^MMT'; # print mode,prepeel T=tear-off P=peel-off R=rewind A=applicator C=cutter, Y/N
  83 printf '^LL%d', $h; # label length FIXME ignore empty bottom
  84 printf '^PW%d', $w; # print width
  85 print '^LS0'; # label shift -9999..9999
  86 printf '^FT%d,%d', 0, $h; # field typeset x,y graphic origin is bottom-left
  87 print '^XG000.GRF,1,1^FS'; # recall grapmic source/name,magnification_x,magnification_y
  88 print '^PQ1,0,1,Y'; # print quantity total,pause/cut,replicates,no_pause
  89 print '^XZ';
  90
  91 print '^XA';
  92 print '^ID000.GRF^FS'; # object delete
  93 print '^XZ';
  94