5 use Data::Dump qw(dump);
7 # convert Zebra label printer ZPL to pbm image
9 my $file = shift @ARGV || die "usage: $0 dump.zpl > dump.pbm";
11 open(my $in, '<', $file);
15 $line =~ s/[\r\n]+$//;
16 warn "# line ",dump($line);
17 if ( $line =~ s/~DG(\w+:)?(.+)// ) {
18 my ( $name, $t,$w ) = split(/,/,$2,4);
20 warn "# ~DG$1 => [$name] t=$t w=$w\n";
28 foreach my $p ( 0 .. length($data) ) {
29 my $c = substr($data,$p,1);
31 my $l = ( $w * 2 ) - length($out) % ( $w * 2 );
32 $l = $w * 2 if $l == 0;
33 warn "# $p ZERO-to-EOL $c [$l]\n";
35 } elsif ( $c eq ':' ) {
36 $out .= length($out) > $w ? substr($out,-$w*2) : "00" x $w;
38 } elsif ( $c eq 'z' ) {
40 } elsif ( $c ge 'g' && $c le 'y' ) {
41 $repeat += 20 * ( ord($c) - ord('f') );
42 } elsif ( $c ge 'G' && $c le 'Y' ) {
43 $repeat += ord($c) - ord('F');
44 } elsif ( $c =~ m/[0-9A-F]/ ) {
46 warn "# $p $repeat $c\n";
54 warn "ABORT: offset $p data [$c]";
55 $line = $c . substr($data,$p);
59 warn "## $repeat [$c] out = ",length($out),$/;
62 my $bitmap = pack('H*', $out);
63 warn "# graphics of ",length($data)," bytes ZPL decompressed to ",length($out)," hex and ", length($bitmap), " bytes bitmap\n";
65 my $ph = int(length($bitmap) / $w);
66 print "P4\n$pw $ph\n", substr($bitmap,0,$ph*$w);
68 } elsif ( $line =~ s/^([~\^][^~\^]*)// ) {
72 $line = <$in> unless length $line > 0;