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