Roger Pepitone

An LZE / Le file consists of the following:
- A six byte header
- A series of blocks


The header consists of:
- 2 bytes: 0x4c, 0x65 ("Le" in ASCII)
- 4 bytes: the size of the uncompressed data in little-endian format

Each block consists of:
- 1 byte: the types for the following mini-records
      (2 bits per type, stored with the first type at the least
      significant bit)
- 4 mini-records


Each mini-record consists of:
- If its type is 0:
-- 2 bytes BYTE1 BYTE2: Write (3 + (BYTE2 >> 4)) bytes from
                        back (5 + (BYTE1 | ((BYTE2 & 0xf) << 8))) to output
- If its type is 1:
-- 1 byte BYTE1:  Write (2 + (BYTE >> 2)) bytes from
                  back (1 + (BYTE & 3)) to output
- If its type is 2:
-- 1 byte: (copied to output stream)
- If its type is 3:
-- 3 bytes: (copied to output stream)


The last block my go over the end; if so, ignore any excess data.


########################################################################

sub unlze {
    my @dat = unpack ("C*", ${$_[0]});
    if ($dat[0] != 0x4c || $dat[1] != 0x65) { return (0, "Not LZ4c65 format"); }
    my $size = unpack ("V", substr (${$_[0]}, 2, 4));
    print "Expecting a total of $size\n";
    my @out = ();
    my $in = 6;

    while ($in < @dat && @out < $size) {
	my $block_types = $dat[$in++];
	for (my $i = 0; $i < 4; ++ $i) {
	    my $this_type = $block_types & 0x3;
	    $block_types >>= 2;

	    if ($this_type == 0) {
		my $n = ($dat[$in]) | ($dat[$in + 1] << 8);
		$in += 2;
		my $bytes_copied = 3 + ($n >> 12);
		my $offset = 5 + ($n & 0xfff);
		if ($offset > @out) {
		    return (0, "Out of bounds backbuffer");
		}
		for (my $i = 0; $i < $bytes_copied; ++ $i) {
		    push @out, $out[-$offset];
		}
	    } elsif ($this_type == 1) {
		my $n = $dat[$in++];
		my $bytes_copied = 2 + ($n >> 2);
		my $offset = 1 + ($n & 3);
		if ($offset > @out) {
		    return (0, "Out of bounds backbuffer");
		}
		for (my $i = 0; $i < $bytes_copied; ++ $i) {
		    push @out, $out[-$offset];
		}
	    } elsif ($this_type == 2) {
		push @out, $dat[$in++];
	    } elsif ($this_type == 3) {
		push @out, $dat[$in++];
		push @out, $dat[$in++];
		push @out, $dat[$in++];
	    } else {
		return (0, "Logic error");
	    }
	}
    }
    if (@out >= $size && @out < $size + 16) {
	print "Success\n";
	return (1, pack ("C*", @out[0..$size-1]));
    }
    if (@out < $size) {
	return (0, "Output not big enough");
    }
    return (0, "Unknown error");
}

sub compress_lze {
    #my @dat = unpack ("C*", ${$_[0]});
    my @dat = split //, ${$_[0]};
    my $size = scalar @dat;
    my @out = ("Le".pack ("V", $size));

    my $in_ptr = 0;
    my @buffer = ();
    my %cache = ();
    while ($in_ptr < @dat) {
	my $next_in_ptr;
	my $ch = $dat[$in_ptr];
	my $ch3 = substr (${$_[0]}, $in_ptr, 3);
	my $lst = $cache{$ch3};
	my @lst = defined $lst ? @$lst : ();
	while (@lst > 0 && $lst[0] < $in_ptr - 0xfff - 5) {
	    shift @lst;
	}

	# Check for a one-byte backcopy (offset 1 to 4, length 2 to 41)
	my ($best_offA, $best_lenA) = (0, 0);
	my ($off, $len);
	for ($off = -4; $off < 0; ++ $off) {
	    next if ($off + $in_ptr < 0);
	    for ($len = 0; $len <= 0x41 && $len + $in_ptr < $size &&
		 $dat[$len + $in_ptr] eq $dat[$len + $off + $in_ptr]; ++ $len) {
		# Do Nothing
	    }
	    if ($len == 0x42) { -- $len; }
	    if ($len > 1 && $len > $best_lenA) { $best_offA = -$off; $best_lenA = $len; }
	}

	my ($best_offB, $best_lenB) = (0, 0);

	# Check for a two_byte backcopy (offset 5 to 5+0xfff, length 3 to 18)
	if ($best_lenA < 19) {
	    foreach my $x (@lst) {
		$off = $x - $in_ptr;
		for ($len = 0; $len <= 18 && $len + $in_ptr < $size &&
		     $dat[$len + $in_ptr] eq $dat[$len + $off + $in_ptr];
		     ++ $len) {
		    # Do nothing
		}
		if ($len == 19) { -- $len; last; }
	    }
	    if ($len > 2 && $len > $best_lenB) { $best_lenB = $len; $best_offB = -$off; }
	}

	if ($best_lenB >= 3 && $best_offB > 4 && $best_lenB > $best_lenA + 1) {
	    my $n = (($best_lenB - 3) << 12) | ($best_offB - 5);
	    push @buffer, [ 0, pack ('v', $n) ];
	    $next_in_ptr = $in_ptr + $best_lenB;
	} elsif ($best_lenA > 1) {
	    my $n = (($best_lenA - 2) << 2) | ($best_offA - 1);
	    push @buffer, [ 1, chr($n) ];
	    $next_in_ptr = $in_ptr + $best_lenA;
	} else {
	    if (@buffer > 2 && $buffer[-1][0] == 2 && $buffer[-2][0] == 2) {
		pop @buffer;
		pop @buffer;
		push @buffer, [ 3, join ('', @dat[$in_ptr-2..$in_ptr]) ];
	    } else {
		push @buffer, [ 2, $ch ];
	    }
	    $next_in_ptr = $in_ptr + 1;
	}
	push @lst, $in_ptr;
	$cache{$ch3} = \@lst;
	++ $in_ptr;
	while ($in_ptr < $next_in_ptr) {
	    push @{$cache{(substr (${$_[0]}, $in_ptr, 3))}}, $in_ptr;
	    ++ $in_ptr;
	}
    }
    while ((scalar @buffer) % 4 != 0) {
	push @buffer, [ 2, "\0" ];
    }
    for (my $k = 0; $k < @buffer; $k += 4) {
	my $type = 0;
	my $str = '';
	for (my $i = 0; $i < 4; ++ $i) {
	    $type |= ($buffer[$k + $i][0]) << (2*$i);
	    $str .= $buffer[$k+$i][1];
	}
	push @out, chr($type).$str;
    }
    return join ('', @out);
}