alttpdecompression.p6

enum Command (
    CMD_Copy => 0,
    CMD_ByteRepeat => 1,
    CMD_WordRepeat => 2,
    CMD_ByteInc => 3,
    CMD_CopyExisting => 4
);

grammar AlttpDecompression {
    multi method parsebuf(Buf $buf) {
        self.parse($buf.decode("latin1"));
    }
    token TOP {
        <chunk>+? <stop>
    }
    token chunk {
        <header> 
        {}
        <data(|$<header>.ast<cmd lenght>)>
        {say $<header>.ast<cmd lenght>, $<data>.Str.chars}
    }
    token stop {
        \xFF
    }
    token header { 
        # header is split into CMD (3 bits) and lenght (5 bits)
        # if CMD is 7 it's an extended header, to have a bigger lenght
        [ <normal-header> | <extended-header> ]
        { make ($<normal-header> // $<extended-header> ).ast 
        }
    }
    token normal-header {
        $<mheader> = . <?{ $/.ord < 0b11100000 }>
        { make {
            cmd => Command($<mheader>.ord +> 5),
            lenght => $<mheader>.ord +& 0b00011111 + 1;
        } }
    }
    # // The command are the next 3 bits
            #command = (header >> 2 ) & 7;
            #length = ((int)((header & 3) << 8)) + (unsigned char) c_data[c_data_pos + 1];
    token extended-header {
        $<mheader> = . ** 2 <?{ ($/.comb[0].ord +& 0b11100000) == 0b11100000 }>
        {make {
            cmd => Command(($<mheader>.comb[0].ord +> 2) +& 7),
            lenght => (($<mheader>.comb[0].ord +& 3) +< 8) + $<mheader>.comb[1].ord + 1
        } }
    }
    multi token data(CMD_Copy, $lenght) {
        . ** {$lenght}
    }
    multi token data($cmd where $cmd == CMD_ByteRepeat | CMD_ByteInc, $lenght) {
        .
    }
    multi token data($cmd where $cmd == CMD_WordRepeat | CMD_CopyExisting, $lenght) {
        . ** 2
    }
}

class DecompressAction {
    has buf8 $.result .= new;
    method chunk($/) {
        say "Chunk : ", $/<header>.ast<cmd>, " ", $/<header>.ast<lenght> , " : ", $/<data>.Str.encode("latin1");
        self.process-cmd($/<header>.ast<cmd>, $/<header>.ast<lenght>, $/<data>.Str.encode("latin1"));
        say '$.result : ', $!result;
    }
    multi method process-cmd(CMD_Copy, $lenght, $data) {
        $!result.append($data)
    }
    multi method process-cmd(CMD_ByteRepeat, $lenght, $data) {
        $!result.append($data) for ^$lenght;
    }
    multi method process-cmd(CMD_WordRepeat, $lenght, $data) {
        loop (my $i = 0; $i < $lenght; $i += 2) {
            $!result.append($data[0]);
            $!result.append($data[1]) if $i + 1 < $lenght;
        }
    }
    multi method process-cmd(CMD_ByteInc, $lenght, $data) {
        $!result.append(($data[0] .. $data[0] + $lenght).join)
    }
    multi method process-cmd(CMD_CopyExisting, $lenght, $data) {
        $!result.append($!result.subbuf($data.read-uint16(0, LittleEndian), $lenght))
    }
}

sub BUILD_SHEADER(Command $cmd, $lenght) returns uint8
{
    return ($cmd.value +< 5) + $lenght - 1
}

my Buf $alttprom = "/mnt/f/Emulation/Zelda - A Link to the Past/Zelda - A Link to the Past.smc".IO.slurp(:bin);
my $action-sprite = $alttprom.subbuf(0xc0f64, 1534);
my $action = DecompressAction.new;
AlttpDecompression.parse($action-sprite.decode("latin1"), :actions($action));
say $action.result;
 
 "/mnt/f/Project/Perl6/grammar/action.gfx".IO.spurt($action.result);

 say "Done";