| Subject: | optimize encoding |
The encoder doesn't always produce the shortest possible encoding. Here's a nifty optimizing encoder. Use it if you like.
| Subject: | encode.pl |
use strict;
use warnings;
for my $str (
"12", # use Code C
"123", # don't use Code C
"1234", # use C
"12345", # use C (odd length)
"abc1234", # C at end
"abc12345", # C at end (odd length)
"1234abc", # C at beginning
"abc1234def", # no C in middle
"abc123456def", # C in middle
"abc1234\n", # C in middle
"abc\ndef", # shift to Code A
) {
my @code = encode128($str);
my $len = @code;
print "$str => @code ($len)\n";
}
sub encode128 {
# find an optimal Code128 encoding for $str
my ($str) = @_;
my $a = { code => 103, len => 1 };
my $b = { code => 104, len => 1 };
my $c = { code => 105, len => 1 };
my ($hold, $digit);
for my $s (unpack 'C*', $str) {
if ($s >= 48 && $s <= 57) { # try code C
($hold, $c) = (
$c || extend($a->{len} <= $b->{len} ? $a : $b, 99),
$hold && extend($hold, $digit*10 + $s - 528) );
$digit = $s;
}
elsif ($s == 0xf1) {
$c = extend($c, 102) if $c;
$hold = $digit = undef;
}
else {
$c = $hold = $digit = undef;
}
if ($s >= 32 && $s <= 95) {
# Code A or Code B
$a = extend($a, $s - 32);
$b = extend($b, $s - 32);
}
elsif ($s <= 31) {
# Code A only
$a = extend($a, $s + 64);
$b = $a->{len} <= $b->{len}
? extend($a, 100) : extend($b, 98, $s + 64);
}
elsif ($s >= 96 && $s <= 127) {
# Code B only
$b = extend($b, $s - 32);
$a = $b->{len} <= $a->{len}
? extend($b, 101) : extend($a, 98, $s - 32);
}
elsif ($s == 0xf1) {
$a = extend($a, 102);
$b = extend($b, 102);
}
elsif ($s == 0xf2) {
$a = extend($a, 97);
$b = extend($b, 97);
}
elsif ($s == 0xf3) {
$a = extend($a, 96);
$b = extend($b, 96);
}
elsif ($s == 0xf4) {
$a = extend($a, 101);
$b = extend($b, 100);
}
else {
die "Illegal character in string: $s";
}
if ($c) {
$a = extend($c, 101) if $c->{len} + 1 < $a->{len};
$b = extend($c, 100) if $c->{len} + 1 < $b->{len};
}
}
# pick best encoding
$a = $b if $b->{len} < $a->{len};
$a = $c if $c && $c->{len} < $a->{len};
my @codes;
while ($a) {
unshift @codes, $a->{code};
$a = $a->{next};
}
# calculate checksum
my $sum = $codes[0];
$sum += $codes[$_] * $_ for 1 .. $#codes;
push @codes, $sum % 103, 106;
return wantarray ? @codes : \@codes;
}
sub extend {
my ($node, @codes) = @_;
foreach my $c (@codes) {
$node = { next => $node, len => $node->{len}+1, code => $c };
}
return $node;
}