#!/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;
}

# Convert ./B output format of telepen() into PBM graphics file
sub barcode2pbm
{
    my ($barcode) = @_;
    my $hborder = 10;
    my $vborder = 10;
    my $width = length($barcode) + 2*$hborder;
    my $rows = 30;
    my $height = $rows + 2*$vborder;

    $barcode =~ s/B/1 /g;
    $barcode =~ s/\./0 /g;
    $barcode = ('0 ' x $hborder) . $barcode . ('0 ' x $hborder);
    $barcode = "$barcode\n" x $rows;
    $barcode = (((("0 " x $width) . "\n") x $vborder) . $barcode .
		((("0 " x $width) . "\n") x $vborder));
    return "P1\n$width $height\n$barcode";
}


if ($#ARGV < 0) {
    print STDERR "Print Telepen barcode as PBM file.\n\n";
    print STDERR "Usage: telepen.pl <ascii-string>\n\n";
    exit 1;
};

print barcode2pbm(telepen($ARGV[0]));