#! /usr/bin/perl
#########################################################################
#        This Perl script is Copyright (c) 2012, Peter J Billam         #
#                          www.pjb.com.au                               #
#                                                                       #
#     This script is free software; you can redistribute it and/or      #
#            modify it under the same terms as Perl itself.             #
#########################################################################

use MIDI::SoundFont();
eval 'require Term::Clui'; if ($@) {
	die "you'll need to install the Term::Clui module from www.cpan.org\n";
}
use Data::Dumper(Dumper);
$Data::Dumper::Indent = 1;  $Data::Dumper::Sortkeys = 1;
use bytes;
my $Version       = '1.03';
my $VersionDate   = '19mar2012';

my @Banks = ();
while ($ARGV[$[] =~ /^-([a-z])/) {
	if ($1 eq 'v')      { shift;
		my $n = $0; $n =~ s{^.*/([^/]+)$}{$1};
		print "$n version $Version $VersionDate\n";
		exit 0;
	} elsif ($1 eq 'b') { shift; @Banks = split ',', shift;
	} else {
		print "usage:\n";  my $synopsis = 0;
		while (<DATA>) {
			if (/^=head1 SYNOPSIS/)     { $synopsis = 1; next; }
			if ($synopsis && /^=head1/) { last; }
			if ($synopsis && /\S/)      { s/^\s*/   /; print $_; next; }
		}
		exit 0;
	}
}
my $file = $ARGV[$[];
my $file_type = filetype($file);
my $Saved = 1;
my $SavedFile = $file;

if ($file_type eq 'sf2') {
	my %sf = MIDI::SoundFont::file2sf($file);
	print "$sf{'INAM'}\n$sf{'IENG'}\n";
	if ($sf{'ICRD'}) { print "$sf{'ICRD'}\n"; }
	my @tasks = sort ('Move bank', 'Move patch', 'Copy patch', 'Edit',
	   'Edit INFO', 'Import gravis', 'Import wav', 'List', 'Delete bank',
	   'Delete patch', 'Write', 'Config', 'Quit');
	Term::Clui::set_default("do what with $file ?", 'List');
	while (1) {
		my $task = Term::Clui::choose("do what with $file ?", @tasks);
		if (! $task or $task eq 'Quit')    { last; }
		if ($task eq 'Move bank')          { sf_move_bank(%sf);
		} elsif ($task eq 'Move patch')    {
		} elsif ($task eq 'Copy patch')    {
		} elsif ($task eq 'Edit')          { sf_edit_dump(\%sf);
		} elsif ($task eq 'Edit INFO')     { sf_edit_info(\%sf);
		} elsif ($task eq 'Import gravis') {
		} elsif ($task eq 'Import wav')    {
		} elsif ($task eq 'List')          { sf_list(%sf);
		} elsif ($task eq 'Delete bank')   { sf_delete_bank(%sf);
		} elsif ($task eq 'Delete patch')  {
		} elsif ($task eq 'Write')         { sf_write(%sf);
		} elsif ($task eq 'Config')        { config(%sf);
		}
	}
	if ((! $Saved) && Term::Clui::confirm(" save file ?")) { sf_write(%sf) }
	exit;
} elsif ($file_type eq 'pat') {
	my %gr = MIDI::SoundFont::file2gravis($file);
	my @tasks = sort ('Edit INFO', 'Edit', 'List', 'Write', 'Config', 'Quit');
	Term::Clui::set_default("do what with $file ?", 'List');
	while (1) {
		my $task = Term::Clui::choose("do what with $file ?", @tasks);
		if (! $task or $task eq 'Quit')    { last; }
		if      ($task eq 'Edit INFO')     { gr_edit_info(\%gr);
		} elsif ($task eq 'Edit')          { deep_edit(\%gr);
		} elsif ($task eq 'List')          { gr_list(%gr);
		} elsif ($task eq 'Write')         { gr_write(%gr);
		} elsif ($task eq 'Config')        { config(%gr);
		}
	}
	if ((! $Saved) && Term::Clui::confirm(" save file ?")) {gr_write(%gr);}
	exit;
} elsif ($file_type eq 'zip') {
	my %gr = MIDI::SoundFont::file2gravis($file);
	my @tasks = sort ( 'Edit INFO', 'Edit', 'Import sf2', 'Import wav',
	  'List', 'Delete patch', 'Write', 'Config', 'Quit');
	while (1) {
		my $task = Term::Clui::choose("do what with $file ?", @tasks);
		if (! $task or $task eq 'Quit')    { last; }
		if      ($task eq 'Edit INFO')     { gr_edit_info(\%gr);
		} elsif ($task eq 'Edit')          { deep_edit(\%gr);
		} elsif ($task eq 'Import sf2')    {
		} elsif ($task eq 'Import wav')    {
		} elsif ($task eq 'List')          { gr_list(%gr);
		} elsif ($task eq 'Delete patch')  { gr_delete_patch(%gr);
		} elsif ($task eq 'Write')         { gr_write(%gr);
		} elsif ($task eq 'Config')        { config(%gr);
		}
	}
	if ((! $Saved) && Term::Clui::confirm(" save file ?")) {gr_write(%gr);}
	exit;
} elsif ($file_type eq '') {
	warn " unrecognised file type; should be .sf2, .zip, or .pat\n";
}
exit;

# -----------------------------------------------------------------

sub filetype { my $f = $_[$[];
	if (! open(F, $f)) { die "can't open $f: $!\n"; }
	read F, my $s, 12;
	close F;
	if ($s =~ /^RIFF....sfbk/) { return 'sf2'; }
	if ($s =~ /^PK/) { return 'zip'; }
	if ($s =~ /^GF1PATCH/) { return 'pat'; }
	if ($f =~ /.sf2$/) { return 'sf2'; }
	if ($f =~ /.zip$/) { return 'zip'; }
	if ($f =~ /.pat$/) { return 'pat'; }
	return '';
}

sub deep_edit { my $arg = $_[$[];
	my $type = ref $arg;
	if (! $type) {
		return Term::Clui::ask(' new value ?', $arg);
	} elsif ($type eq 'HASH') {
		while (1) {
			my @keys = sort keys %{$arg};
			my $key = Term::Clui::choose(' edit which ?',
			  @keys,'Add a new key','Delete a key');
			if (! $key) { last; }
			if ($key eq 'Add a new key') {
			} elsif ($key eq 'Delete a key') {
			} elsif (! ref $arg->{$key}) {  # it contains a scalar
				my $new = Term::Clui::ask(' new value ?', $arg->{$key});
				$arg->{$key} = $new;
			} else { deep_edit($arg->{$key});
			}
		}
	} elsif ($type eq 'ARRAY') {
		while (1) {
			my @args = @{$arg};
			my @keys = $[ .. $#args;
			my $key = Term::Clui::choose(' edit which list item ?',
			  @keys,'Add a new key','Delete a key');
			if (! length $key) { last; }
			if ($key eq 'Add a new item') {
			} elsif ($key eq 'Delete a item') {
			} elsif (! ref $args[$key]) {  # it contains a scalar
				my $new = Term::Clui::ask(' new value ?', $args[$key]);
				$args[$key] = $new;
			} else { deep_edit($args[$key]);
			}
		}
	}
}

# ------------------- soundfont functionality -------------------

sub config {
	my $text = MIDI::SoundFont::timidity_cfg($SavedFile, @_);
	Term::Clui::view('suggested_timidity_cfg', $text);
}

sub sf_banks { my %sf = @_;
	my @phdr_list = @{$sf{'phdr'}};
	my %banks = ();
	foreach my $p_ref (@phdr_list) {
		$banks{$p_ref->{'wBank'}} +=1 ;
	}
	return sort {$a <=> $b} keys %banks;
}

sub sf_edit_dump { my $sf_ref = $_[$[];
	my @text = split "\n", Dumper($sf_ref);
	my %new_sf = ();
	$text[$[] = '%new_sf = (';
	$text[$#text] = ");\n";
	while (1) {
		# must delete all the sampledata = ... lines !
		eval Term::Clui::edit('SoundFont', join("\n",@text));
		if (! $@) { last ; }
		if (! Term::Clui::confirm(" syntax error. OK to re-edit ?")) {return;}
	}
	if (Term::Clui::confirm(" OK to replace the SoundFont ?")) {
		%{$sf_ref} = %new_sf;
	}
	return;
}

sub sf_edit_info { my $sf_ref = $_[0];
	my @tasks = ('ICMT', 'ICOP', 'IENG', 'INAM');
	while (1) {
		my $task = Term::Clui::choose(" edit which INFO-field ?", @tasks);
		if (! $task) { last; }
		my $text = $sf_ref->{$task};
		my $newtext = Term::Clui::edit("INFO/$task", $text);
		if (Term::Clui::confirm(" OK to replace $task field ?")) {
			$newtext =~ s/(\S)\n(\S)/$1 $2/;
			$newtext =~ tr/\n//d;
			$sf_ref->{$task} = $newtext;
			$Saved = 0;
		}
	}
}

sub sf_unused_banks { my %sf = @_;
	my %banks = map { $_, 1 } (0..127);
	foreach my $used (sf_banks(%sf)) { delete $banks{$used}; }
	return sort {$a <=> $b} keys %banks;
}


sub sf_list { my %sf = @_;
	my @phdr_list = @{$sf{'phdr'}};
	if (@Banks) {
		my %banks = map { $_, 1 } @Banks;
		my @short_list = ();
		foreach my $p_ref (@phdr_list) {
			if ($banks{$p_ref->{'wBank'}}) { push @short_list, $p_ref; }
		}
		@phdr_list = @short_list;
	}
	@phdr_list = sort { (1000*$a->{'wBank'}+$a->{'wPreset'})
	  <=> (1000*$b->{'wBank'}+$b->{'wPreset'})} @phdr_list;
	my @text = ();
	foreach my $p_ref (@phdr_list) {
		push @text, "bank $p_ref->{'wBank'} patch $p_ref->{'wPreset'} "
	 	. " # $p_ref->{'achPresetName'}\n";
	}
	Term::Clui::view($file, join('',@text));
}

sub sf_move_bank { my %sf = @_;
	my $from = Term::Clui::choose(" move which bank ?", sf_banks(%sf));
	if (! defined $from) { return; }
	my $to = Term::Clui::choose(" to which bank ?", sf_unused_banks(%sf));
	if (! defined $to) { return; }
	foreach my $p_ref (@{$sf{'phdr'}}) {
		if ($p_ref->{'wBank'} == $from) { $p_ref->{'wBank'} = $to; }
	}
	$Saved = 0;
}

sub sf_write { my %sf = @_;
	my $file = Term::Clui::ask_filename(" write to which file ?");
	if (! $file) { return; }
	if ((-e $file) && (! Term::Clui::confirm(" OK to overwrite $file ?"))) {
		return;
	}
	MIDI::SoundFont::sf2file($file, %sf);
	$SavedFile = $file;
	$Saved = 1;
}

# --------------------- gravis functionality -------------------

sub gr_edit_info { my %gr = @_;
	my $info_field = Term::Clui::choose(' edit which field ?',
	  qw(description filename manufacturer));
	if (! $info_field) { return; }
	Term::Clui::inform(" current value = $gr->{$info_field}");
	my $new_value = Term::Clui::ask(' new value ?',$gr->{$info_field});
	if ($new_value) { $gr->{$info_field} = $new_value; }
}

sub gr_write { my %gr = @_;
	my $file = Term::Clui::ask_filename(" write to which file ?");
	if (! $file) { return; }
	if ((-e $file) && (! Term::Clui::confirm(" OK to overwrite $file ?"))) {
		return;
	}
	MIDI::SoundFont::gravis2file($file, %gr);
	$SavedFile = $file;
	$Saved = 1;
}

__END__

=pod

=head1 NAME

sf_edit - manipulates banks of an sf2 SoundfFont file

=head1 SYNOPSIS

 sf_edit -v                        # prints vesion

 sf_edit FileName.sf2

 sf_edit Grork.zip

=head1 DESCRIPTION

This script uses the CPAN module MIDI::SoundFont
to manipulate the banks and patches of an B<.sf2> SoundfFont file,
or the patches of a B<.zip> file of Gravis patches.
It is distributed in the ./examples subdirectory of the MIDI::SoundFont module.

=back

=head1 OPTIONS

=over 3

=item I<-v>

Prints version number.

=back

=head1 CHANGES

 20120224  1.0  first working version

=head1 AUTHOR

Peter J Billam   http://www.pjb.com.au/comp/contact.html

=head1 SEE ALSO

 MIDI::SoundFont
 Term::Clui
 String::Approx
 Archive::Zip
 timidity (1)
 http://www.pjb.com.au/
 http://www.pjb.com.au/muscript/index.html#midi

=cut

