#!/usr/bin/perl
# sflist - what instruments does a soundfont file contain?
use 5.36.0;
use File::Format::RIFF;

my $show_header;
if ( @ARGV == 2 and $ARGV[0] eq '-h' ) {
    $show_header = 1;
    shift;
}
die "Usage: sflist [-h] soundfont-file\n" unless @ARGV == 1;

open my $fh, '<', $ARGV[0] or die "open failed '$ARGV[0]': $!\n";
my $ffr;
eval {
    $ffr = File::Format::RIFF->read($fh);
    1;
} or do {
    die "sflist: unable to parse '$ARGV[0]'\n";
};

if ($show_header) {
    my %info = (
        ICMT => 'Rem',
        ICRD => 'Date',
        IENG => 'Author',
        INAM => 'Name',
        IPRD => 'Product',
        ISFT => 'Tool',
        ifil => 'SFv',
        irom => 'ROM',
        isng => 'Engine',
        iver => 'ROMv',
    );
    my $list = getchunk( 3, sfbk => $ffr, 0 );
    my $type = $list->type;
    die "sflist: expected INFO chunk (got '$type')\n"
      unless $type eq 'INFO';
    my $count = $list->numChunks;
    die "sflist: unexpected INFO count $count\n" if $count <= 0;
    my $copyright;
    for my $i ( 0 .. $count - 1 ) {
        my $chunk = $list->at($i);
        my $id    = $chunk->id;
        if ( $id eq 'ifil' or $id eq 'iver' ) {
            my ( $major, $minor ) = unpack 'vv', $chunk->data;
            say "$info{$id}\t$major.$minor";
        } elsif ( $id eq 'ICOP' ) {
            # this one can spam the terminal so is shown last
            $copyright = unpack 'Z*', $chunk->data;
        } elsif ( $id =~ m/^(?:INAM|isng|IENG|ISFT|ICMT|IPRD|ICRD|irom)$/ ) {
            my $s = unpack 'Z*', $chunk->data;
            say "$info{$id}\t", $s if length $s;
        } else {
            say '??? ', $chunk->dump( $chunk->size );    # TODO
        }
    }
    say "\n", $copyright if defined $copyright and length $copyright;
    exit;
}

my $pdta = getchunk( 3, sfbk => $ffr,  2 );
my $phdr = getchunk( 9, pdta => $pdta, 0 );

my $id = $phdr->id;
die "sflist: unknown PHDR ID '$id' (want 'phdr')\n" if $id ne 'phdr';
my $phdr_size = $phdr->size;
die "sflist: invalid PHDR size $phdr_size\n"
  if $phdr_size < 76
  or $phdr_size % 38 != 0;

my %presets;
my $data = $phdr->data;
$phdr_size -= 38;    # last header is a "End Of Presets" terminator
my $offset = 0;
while ( $offset < $phdr_size ) {
    # full record is Z20vvvVVV
    my ( $name, $preset, $bank ) = unpack "x${offset}Z20vv", $data;
    $presets{$bank}{$preset} = $name;
    $offset += 38;
}

say "BANKS ", scalar keys %presets;
for my $bank ( sort { $a <=> $b } keys %presets ) {
    print "BNK $bank";
    my $ref = $presets{$bank};
    for my $preset ( sort { $a <=> $b } keys %$ref ) {
        say "\t$preset\t$ref->{$preset}";
    }
}

sub getchunk ( $wantcount, $wanttype, $object, $index ) {
    my $type = $object->type;
    die "sflist: unexpected type '$type' (want '$wanttype')\n"
      if $type ne $wanttype;
    my $count = $object->numChunks;
    die "sflist: unexpected count $count (want $wantcount)\n"
      if $count != $wantcount;
    return $object->at($index);
}