#!/usr/bin/perl -w
$/=undef;#slurp
$xm=<>;

#$id=substr($xm,0,60);
$hlen=unpack'V',substr($xm,60,4);
$header=substr($xm,60,$hlen);
$npatts=unpack'v',substr($header,10,2);
$nchan=unpack'v',substr($header,8,2);

my $seqlen=unpack"v",substr($header,4,2);
my @seq=unpack"C$seqlen",substr($header,20);

use Data::Dumper;

print Dumper \@seq;

print "$npatts patterns, $nchan channels\n";
$offset=60+$hlen;
my @patts;
my %notesused;

for (0..$npatts-1) {
    $plen=unpack'V',substr($xm,$offset,4);
    $patt=substr($xm,$offset,$plen);
    $nrows=unpack'v',substr($patt,5,2);
    $dlen=unpack'v',substr($patt,7,2);
    $data=substr($xm,$offset+$plen,$dlen);
    $poff=0;
    print "pattern $_, length $nrows\n";
    push @pattlen, $nrows;
    my @patt;
    for my $row (1..$nrows) {
	for my $chan (0..$nchan-1) {
	    my $newdata='';
	    $note=unpack'C',substr($data,$poff,1);
	    if ($note & 0x80) {
		$poff++;
		for(1..5) {
		    if ($note &1) {
			$foo=unpack'C',substr($data,$poff++,1);
			$newdata.=chr$foo;
		    } else {
			$newdata.="\0";
		    }
		    $note>>=1;
		}
	    } else {
		$newdata=substr($data,$poff,5);
		$poff+=5;
	    }
	    push @{$patt[$chan]},$newdata;
#	    printf "%02x%02x%02x%02x%02x ", unpack"C5",$newdata;
	}
#	print "\n";
    }
    push @patts, \@patt;
    $offset+=$plen+$dlen;
}

my $speed=2;
my $pattsize=16;
my @out;

my @vol;
my @scvol;

for my $seq (0..$seqlen-1) {
    my $patt=$seq[$seq];
    my @patt=@{$patts[$patt]};
    print "seq $seq patt $patt\n";
    
    for my $row (0..$pattlen[$seq[$seq]]) {
	my @newrow;
	for my $chan (0..$nchan-1) {
	    my @event=unpack"C5", $patts[$patt][$chan][$row];
	    printf "%02x%02x%02x%02x%02x ",@event;
	    $notesused{$event[0]}++ if $chan!=3;
	    my @newevent=(255,255,255,255);
	    if ($event[0]) {
		$newevent[0]=$event[0];
		$vol[$chan]=64;
	    }
	    if ($event[3]==12) {
		$vol[$chan]=$event[4];
	    }
	    if ($event[2]>=0x10 && $event[2]<=0x50) {
		$vol[$chan]=$event[2]-16;
	    }
	    
	    my $scvol=15-int($vol[$chan]*15/64+.4);
	    if ($scvol!=$scvol[$chan]) {
		$newevent[1]=$scvol[$chan]=$scvol;
	    }

	    if ($event[3]==0 && $event[4]) {
		die unless $event[0];
		$newevent[2]=$event[0]+($event[4]>>4);
	    }
	    if ($event[3]==10) {
		die unless $event[4];
		$vol[$chan]-=$event[4];
		$vol[$chan]=0 if $vol[$chan]<0;
		
		my $scvol=15-int($vol[$chan]*15/64+.4);
		if ($scvol!=$scvol[$chan]) {
		    $newevent[3]=$scvol[$chan]=$scvol;
		}
	    }
	    push @newrow, \@newevent;
	    $out[$chan].=pack "C4",@newevent;

	}
	for my $chan (0..$nchan-1) {
	    printf "%02x%02x%02x%02x ", @{$newrow[$chan]};
	}
	print "\n";
    }
}

print (scalar keys %notesused," notes used\n");

$evlen=length($out[0]);
print "$evlen events used\n";
$evlen/=$pattsize;

#print $out[0];
#__END__

# RLE
for my $chan (0..$nchan-1) {
}

# chunk
my %chunks;
for my $chan (0..$nchan-1) {
    my $offset=0;
    my $ptr=0;
    my $last;
    my %chlen;
    while ($offset < length($out[$chan])) {
	my $chunk=substr($out[$chan], $offset, $pattsize);
	$offset+=$pattsize;
	$inchunks++;
	if ($chunks{$chunk}) {
	    if ($last && $chend{$last}==$chunks{$chunk}) {
		$table[$chan].=pack"C",255;
	    } else {
		$table[$chan].=pack"v",$chunks{$chunk};
	    }
	} else {
	    # RLE
	    my @data=unpack"C*",$chunk;
	    my $count=0;
	    my $data;
	    for my $byte (@data) {
		if ($byte==255) {
		    $count++;
		    my $a=unpack"C",substr($data,-1,1);
		    if ($count==8) {
			$data.=pack"C",0x87;
			$count=0;
		    } elsif ($a && $a>0 && $a<=0xf && $count==7) {
			chop $data;
			$data.=pack"C",0x87|($a<<3);
#			print "7 mini!\n";
			$count=0;
		    }
		} else {
		    die if $byte & 0x80;
		    if ($count) {
			die if $count>7;
#			if ($byte>0 && $byte<=0xf && $count<7) {
#			    $data.=pack"C",0x80|($byte<<3)|($count);
#			} else 

			my $a=unpack"C",substr($data,-1,1);
			if ($a && $a>0 && $a<=0xf) {
			    chop $data;
			    $data.=pack"C",0x80|($a<<3)|($count);
			} else {
			    $data.=pack"C",0x80|($count-1);
			}
			$count=0;
		    }
		    $data.=pack"C",$byte;
		}
	    }

	    if ($count) {
		die if $count>7;
		my $a=unpack"C",substr($data,-1,1);
		if ($a && $a>0 && $a<=0xf) {
		    chop $data;
		    $data.=pack"C",0x80|($a<<3)|($count);
		} else {
		    $data.=pack"C",0x80|($count-1);
		}
	    }

	    my $hole=0;
	    $chunks{$chunk}=length($pattdata);
	    if ($last && $chend{$last}==$chunks{$chunk}) {
		$table[$chan].=pack"C",255;
	    } else {
		$table[$chan].=pack"v",$chunks{$chunk};
	    }
#	    $table[$chan].=pack"C",$chunks{$chunk}/8;
	    $pattdata.=$data;
	    while ((length($pattdata) & 255)==255) {
		$pattdata.="\0";
		$hole=1;
	    }
	    $chend{$chunk}=length($pattdata);
	}
	$last=$chunk;
    }
}
print "$inchunks chunks in, ".(scalar keys %chunks)." chunks out, size=$pattsize\n";
my $plen=length $pattdata;
my $tlen=length(join'',@table);
my $len=length(@table[0])/2;
print "table len $tlen, pattern data $plen, total ".($tlen+$plen)."\n";
print "len%=$len\n";
print "pattsize%=".$pattsize/$speed."\n";

$offset=0x3000;
for (0..$nchan) {
    printf "$_: %x\n",$offset;
    $offset+=length($table[$_]);
}

#print "note range: ",(sort {$a<=>$b} keys %notesused)[0,-1];

for (0..$nchan-1) {
    open my $file, ">psgtable$_";
    print $file $table[$_];
}
open my $file, ">psgpattdata";
print $file $pattdata;
