implement ! fill one to end of line compression
[Printer-Zebra.git] / ZPL2pbm.pl
index 818198d..e439ae4 100755 (executable)
@@ -25,7 +25,7 @@ slurp_line;
 
 while( $line ) {
        $line =~ s/[\r\n]+$// && warn "## removed CR/LF\n";
-       warn "# line ",dump($line),$/;
+       warn "# line ",dump($line),$/ if length($line) < 80 or $ENV{DEBUG};
        if ( $line =~ s/~DG(\w+:)?(.+)// ) {
                my ( $name, $t,$w ) = split(/,/,$2,4);
 
@@ -37,13 +37,18 @@ while( $line ) {
                my $out;
                # ZPL decompress
                my $repeat = 1;
-               foreach my $p ( 0 .. length($data) ) {
+               foreach my $p ( 0 .. length($data) - 1 ) {
                        my $c = substr($data,$p,1);
                        if ( $c eq ',' ) {
                                my $l = ( $w * 2 ) - length($out) % ( $w * 2 );
                                $l = $w * 2 if $l == 0;
                                warn "# $p ZERO-to-EOL $c [$l]\n";
                                $out .= "0" x $l;
+                       } elsif ( $c eq '!' ) {
+                               my $l = ( $w * 2 ) - length($out) % ( $w * 2 );
+                               $l = $w * 2 if $l == 0;
+                               warn "# $p ONE-to-EOL $c [$l]\n";
+                               $out .= "1" x $l;
                        } elsif ( $c eq ':' ) {
                                $out .= length($out) > $w ? substr($out,-$w*2) : "00" x $w;
                                warn "# $p :\n";
@@ -53,7 +58,7 @@ while( $line ) {
                                $repeat += 20 * ( ord($c) - ord('f') );
                        } elsif ( $c ge 'G' && $c le 'Y' ) {
                                $repeat += ord($c) - ord('F');
-                       } elsif ( $c =~ m/[0-9A-F]/ ) {
+                       } elsif ( $c =~ m/[0-9A-F]/i ) {
                                if ( $repeat ) {
                                        warn "# $p $repeat $c\n";
                                        $out .= $c x $repeat;
@@ -86,6 +91,9 @@ while( $line ) {
                        warn "UNKNOWN: ",dump($1),$/;
                }
                $line =~ s/^[\r\n]+// && warn "## removed CR/LF\n";
+       } else {
+               my $unknown = $1 if $line =~ s/^(.)//; # printer seems to ignore invalid chars
+               warn "IGNORE: ",dump($unknown);
        }
 
        slurp_line;