pass args as one or multiple arguments delimited by spaces
[Printer-Zebra.git] / 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";