#!/usr/bin/perl
#
#
# perl reference implimentation - just the algorythm


@hamming = 
(
  0x00,  0x03,  0x05,  0x06,  0x06,  0x05,  0x03,  0x00,
  0x07,  0x04,  0x02,  0x01,  0x01,  0x02,  0x04,  0x07,
  0x09,  0x0A,  0x0C,  0x0F,  0x0F,  0x0C,  0x0A,  0x09,
  0x0E,  0x0D,  0x0B,  0x08,  0x08,  0x0B,  0x0D,  0x0E,
  0x0A,  0x09,  0x0F,  0x0C,  0x0C,  0x0F,  0x09,  0x0A,
  0x0D,  0x0E,  0x08,  0x0B,  0x0B,  0x08,  0x0E,  0x0D,
  0x03,  0x00,  0x06,  0x05,  0x05,  0x06,  0x00,  0x03,
  0x04,  0x07,  0x01,  0x02,  0x02,  0x01,  0x07,  0x04,
  0x0B,  0x08,  0x0E,  0x0D,  0x0D,  0x0E,  0x08,  0x0B,
  0x0C,  0x0F,  0x09,  0x0A,  0x0A,  0x09,  0x0F,  0x0C,
  0x02,  0x01,  0x07,  0x04,  0x04,  0x07,  0x01,  0x02,
  0x05,  0x06,  0x00,  0x03,  0x03,  0x00,  0x06,  0x05,
  0x01,  0x02,  0x04,  0x07,  0x07,  0x04,  0x02,  0x01,
  0x06,  0x05,  0x03,  0x00,  0x00,  0x03,  0x05,  0x06,
  0x08,  0x0B,  0x0D,  0x0E,  0x0E,  0x0D,  0x0B,  0x08,
  0x0F,  0x0C,  0x0A,  0x09,  0x09,  0x0A,  0x0C,  0x0F,
  0x0C,  0x0F,  0x09,  0x0A,  0x0A,  0x09,  0x0F,  0x0C,
  0x0B,  0x08,  0x0E,  0x0D,  0x0D,  0x0E,  0x08,  0x0B,
  0x05,  0x06,  0x00,  0x03,  0x03,  0x00,  0x06,  0x05,
  0x02,  0x01,  0x07,  0x04,  0x04,  0x07,  0x01,  0x02,
  0x06,  0x05,  0x03,  0x00,  0x00,  0x03,  0x05,  0x06,
  0x01,  0x02,  0x04,  0x07,  0x07,  0x04,  0x02,  0x01,
  0x0F,  0x0C,  0x0A,  0x09,  0x09,  0x0A,  0x0C,  0x0F,
  0x08,  0x0B,  0x0D,  0x0E,  0x0E,  0x0D,  0x0B,  0x08,
  0x07,  0x04,  0x02,  0x01,  0x01,  0x02,  0x04,  0x07,
  0x00,  0x03,  0x05,  0x06,  0x06,  0x05,  0x03,  0x00,
  0x0E,  0x0D,  0x0B,  0x08,  0x08,  0x0B,  0x0D,  0x0E,
  0x09,  0x0A,  0x0C,  0x0F,  0x0F,  0x0C,  0x0A,  0x09,
  0x0D,  0x0E,  0x08,  0x0B,  0x0B,  0x08,  0x0E,  0x0D,
  0x0A,  0x09,  0x0F,  0x0C,  0x0C,  0x0F,  0x09,  0x0A,
  0x04,  0x07,  0x01,  0x02,  0x02,  0x01,  0x07,  0x04,
  0x03,  0x00,  0x06,  0x05,  0x05,  0x06,  0x00,  0x03,
);


@corrections = 
(
  0x00,   #* 0 result means no error  */
  0x00,   #*  C1 is a Hamming bit, not a data bit */
  0x00,   #*  C2 is a Hamming bit, not a data bit */
  0x01,   #*  C3 is data bit D0                   */
  0x00,   #*  C4 is a Hamming bit, not a data bit */
  0x02,   #*  C5 is data bit D1                   */
  0x04,   #*  C6 is data bit D2                   */
  0x08,   #*  C7 is data bit D3                   */
  0x00,   #*  C8 is a Hamming bit, not a data bit */
  0x10,   #*  C9 is data bit D4                   */
  0x20,   #* C10 is data bit D5                   */
  0x40,   #* C11 is data bit D6                   */
  0x80,   #* C12 is data bit D7                   */
);


@foo = encode(1,2);

foreach $bar (@foo) {
	print "E:$bar\n";
}

$foo[1] |= 8; # noise

@baz = decode(@foo);

foreach $biz (@baz) {
	print "D:$biz\n";
}

sub encode_f {
	my $b1 = shift;
	my $b2 = shift;
	my @ret;
	my $ham = ($hamming[$b1] << 4) + $hamming[$b2];

	push(@ret,$b1);
	push(@ret,$b2);
	push(@ret,$ham);
	return(@ret);

}

sub encode {
	my $bufsize = @_;
	my $a, $b, $c, @ret;


	return undef if ($bufsize % 2);

	while((defined($a = shift)) && (defined($b = shift))) {
		push(@ret, $a);
		push(@ret, $b);
		push(@ret, (($hamming[$a] << 4) + $hamming[$b]));
	}

	return(@ret);
}

sub decode {
	my $bufsize = @_;
	my $a, $b, $c, @ret;
	my $mod_ham, $ham;

	@ret = ();

	return undef if ($bufsize % 3);

	while((defined($a = shift)) && (defined($b = shift)) && (defined($c = shift))) {
       	 	$mod_ham = $hamming[$a];
       	 	$ham = ($c & 0xF0) >> 4;
       		push(@ret, ($a ^ $corrections[$ham ^ $mod_ham]));

        	$mod_ham = $hamming[$b];
        	$ham = ($c & 0x0F);
        	push(@ret, ($b ^ $corrections[$ham ^ $mod_ham]));
	}

	return(@ret);
}

sub decode_f {
	my $b1 = shift;
	my $b2 = shift;
	my $bh = shift;

	my $mod_ham, $ham;
	my @ret;

	$mod_ham = $hamming[$b1];
	$ham = ($bh & 0xF0) >> 4;
	my $r1 = $b1 ^ $corrections[$ham ^ $mod_ham];

	$mod_ham = $hamming[$b2];
	$ham = ($bh & 0x0F);
	my $r2 = $b2 ^ $corrections[$ham ^ $mod_ham];

	push(@ret, $r1);
	push(@ret, $r2);
	return(@ret);
}
