Perl code to generate a Telepen barcode by Markus Kuhn
Code:
#!/usr/bin/perl
# Markus.Kuhn@cl.cam.ac.uk, 2002-11-22
# Encode 7-bit ASCII string into Telepen barcode
# http://www.telepen-barcode.co.uk/barcode_symbol.asp
# Output: string in which '.' and 'B' represent equally wide white and
# black vertical strokes.
sub telepen
{
my ($text) = @_;
my $bits;
my $barcode;
my $checksum = 0;
# Append checksum byte to $text
for ($i = 0; $i < length($text); $i++) {
$checksum += ord(substr($text, $i, 1)) & 0x7f;
}
$text .= chr(~($checksum % 127) & 0x7f);
# Convert $text to LSB-first bit sequence with even parity
while (length($text) > 0) {
my $char = ord($text);
my $ones = 0;
$text = substr($text, 1);
$checksum += $char;
for ($i = 0; $i < 7; $i++) {
$ones += ($char >> $i) & 1;
$bits .= (($char >> $i) & 1) ? '1' : '0';
}
$bits .= ($ones & 1) ? '1' : '0';
};
# Add start and stop codes
$bits = "11111010${bits}01011111";
# Now apply Telepen encoding state machine
my $state = 0;
while (length($bits) > 0) {
if ($bits =~ /^010/ && $state == 0) {
$barcode .= 'BBB...';
$bits = $';
} elsif ($bits =~ /^00/ && $state == 0) {
$barcode .= 'BBB.';
$bits = $';
} elsif ($bits =~ /^01/ && $state == 0) {
$barcode .= 'B...';
$bits = $';
$state = 1;
} elsif ($bits =~ /^10/ && $state == 1) {
$barcode .= 'B...';
$bits = $';
$state = 0;
} elsif ($bits =~ /^1/) {
$barcode .= 'B.';
$bits = $';
} else {
die("Oops, something impossible happend!\n$bits\n");
}
}
return $barcode;
}
See also: