Telepen Barcode

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:

• http://www.telepen-barcode.co.uk/images/downloads/BarcodeSymbology.pdf Specs for the Telepen Barcode system.+\
• http://lists.linux.it/pipermail/barcode/2002-November/000136.html Perl script to produce the barcode.+

  .