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: