#! /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;
my $Version       = $MIDI::SoundFont::VERSION;
my $VersionDate   = $MIDI::SoundFont::VERSION_DATE;
use bytes;

# see ~/csound/make_txts for the rabbit and mt sequences !

use Data::Dumper(Dumper);
$Data::Dumper::Indent = 1;  $Data::Dumper::Sortkeys = 1;

my $OutputDir = '/tmp';
if (-d '/home/pjb/www/midi/free') { $OutputDir = '/home/pjb/www/midi/free'; }
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 'c') { suggest_cfg(); shift;
	} elsif ($1 eq 'd') { shift; $OutputDir = 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;
	}
}

# First create the samples...
# starting sawtooth and fading to triangle
# A=440 at 44100 samples/sec means 1 cycle = 100.25 samples
# so we take 1 cycle = 100 samples and apply chCorrection = -4
my @SawtoothToTriangle = ();
my $n_cycles = 440;
foreach my $i_cycle (1..$n_cycles) {
	my $rise = round(25*$i_cycle/$n_cycles);
	my $fall = 100 - $rise - $rise -1;
	if ($rise > 0) {
		foreach my $i_up_1st (1..$rise) {
			push @SawtoothToTriangle, round(32000*($i_up_1st/$rise));
		}
	}
	foreach my $i_down (0 .. $fall) {
		push @SawtoothToTriangle, round(32000 - 64000*($i_down/$fall));
	}
	if ($rise > 0) {
		foreach my $i_up_2nd (1..$rise) {
			push @SawtoothToTriangle, round(32000*($i_up_2nd/$rise)-32000);
		}
	}
}
# starting square and fading to sine
my @SquareToSine = ();
my $n_cycles = 440;
my $twopi_over100 = 2.0 * 3.141592653589 / 100;
foreach my $i_cycle (1..$n_cycles) {
	my $fade = $i_cycle/$n_cycles;  $fade = $fade*$fade;
	push @SquareToSine, 0;
	foreach my $i (1..49) {
		push @SquareToSine, 32000*((1.0-$fade) + $fade*sin($twopi_over100*$i));
	}
	push @SquareToSine, 0;
	foreach my $i (51..99) {
		push @SquareToSine, 32000*(($fade-1.0) + $fade*sin($twopi_over100*$i));
	}
}
push @SquareToSine, 0;

# now create the soundfont...
my %sf = MIDI::SoundFont::new_sf();
$sf{'INAM'} = 'Bank 5 - some simple synthy sounds';
$sf{'phdr'}[0]{'wBank'} = 5;
$sf{'phdr'}[0]{'achPresetName'} = 'SawtoothToTriangle';
my %smpl_0 = sf_sawtooth2triangle();
$sf{'shdr'}{'smpl_0'} = \%smpl_0;
push @{$sf{'phdr'}}, {
achPresetName => 'SquareToSine',
  pbags => [
    {
      generators => {
        instrument => 'inst_1', velRange => [0,127]
      },
      modulators => []
    }
  ],
  wBank => 5, wPreset => 1
};
$sf{'inst'}{'inst_1'} = {
  ibags => [
    {
      generators => {
        keyRange => [0,127], pan => +190,
        sampleID => 'smpl_1', sampleModes => 1
      },
      modulators => []
    }
  ]
};
my %smpl_1 = sf_square2sine();
$sf{'shdr'}{'smpl_1'} = \%smpl_1;
MIDI::SoundFont::sf2file("$OutputDir/Bank5.sf2",%sf);
# $smpl_0{'sampledata'} = '[ ... ]'; print Dumper(\%smpl_0);

# now the gravis patches
my %pat_1 = MIDI::SoundFont::new_pat();
$pat_1{'description'} = 'SawtoothToTriangle';
my %wavsmpl_1 = gr_sawtooth2triangle();
$pat_1{'instruments'}[0]{'layers'}[0]{'wavsamples'}[0] = \%wavsmpl_1;
MIDI::SoundFont::gravis2file("$OutputDir/SawtoothToTriangle.pat",
  ('SawtoothToTriangle.pat' => \%pat_1));

my %pat_2 = MIDI::SoundFont::new_pat();
$pat_2{'description'} = 'SquareToSine';
my %wavsmpl_2 = gr_square2sine();
$pat_2{'instruments'}[0]{'layers'}[0]{'wavsamples'}[0] = \%wavsmpl_2;
MIDI::SoundFont::gravis2file("$OutputDir/SquareToSine.pat",
  ('SquareToSine.pat' => \%pat_2));

exit 0;

sub sf_sawtooth2triangle {
	# Timidity does an artefact on low notes; should perhaps do 220 and 110 too
	# 16-bit signed little-endian
	my $sampledata = pack 's<*', @SawtoothToTriangle;
	my $l = length $sampledata; # warn "l=$l\n";
	return (
      byOriginalKey => 69,
      chCorrection => -4,
      dwEnd => 100*$n_cycles,
      dwEndloop => 100*($n_cycles-1),     # samples, not bytes
      dwSampleRate => 44100,
      dwStart => 0,
      dwStartloop => 100*($n_cycles-3),   # samples, not bytes
      sampledata => $sampledata,
      sfSampleType => 1,
      wSampleLink => 0
	);
}

sub sf_square2sine {
	my $sampledata = pack 's<*', @SquareToSine;  # 16-bit signed little-endian
	my $l = length $sampledata;
	return (
      byOriginalKey => 69,
      chCorrection => -4,
      dwEnd => 100*$n_cycles,
      dwEndloop => 100*($n_cycles-1),     # samples, not bytes
      dwSampleRate => 44100,
      dwStart => 0,
      dwStartloop => 100*($n_cycles-3),   # samples, not bytes
      sampledata => $sampledata,
      sfSampleType => 1,
      wSampleLink => 0
	);
}

sub gr_sawtooth2triangle {
	# 16-bit signed little-endian;   See doc/timidity/instrum.[ch]
	# MODES_16BIT    1  MODES_UNSIGNED 2  MODES_LOOPING   4  MODES_PINGPONG  8
	# MODES_REVERSE 16  MODES_SUSTAIN 32  MODES_ENVELOPE 64  MODES_CLAMPED 128
	my $sampledata = pack 's<*', @SawtoothToTriangle;
	my $l = length $sampledata; # warn "l=$l\n";
	return (
		balance => 7,
		data => $sampledata,
		envelope_data => "\x3f\x46\x81\x42\x3f\x3f\xd5\xf2\xf6\x08\x08\x08",
		high_freq => 10000000,
		loop_end => 200*($n_cycles-1),    # bytes, not samples
		loop_start => 200*($n_cycles-3),  # bytes, not samples
		low_freq => 20000,
		mode => 1+4+32+64,
		root_freq => 440000,
		sample_name => 'smpl_1',
		sample_rate => 44100,
		scale_factor => 1024,
		scale_freq => 60,
		tune => 1
	);
}

sub gr_square2sine {
	my $sampledata = pack 's<*', @SquareToSine;  # 16-bit signed little-endian
	my $l = length $sampledata;
	return (
		balance => 7,
		data => $sampledata,
		envelope_data => "\x3f\x46\x81\x42\x3f\x3f\xd5\xf2\xf6\x08\x08\x08",
		high_freq => 10000000,
		loop_end => 200*($n_cycles-1),  # bytes, not samples
		loop_start => 200*($n_cycles-3),  # bytes, not samples
		low_freq => 20000,
		mode => 1+4+32+64,
		root_freq => 440000,
		sample_name => 'smpl_2',
		sample_rate => 44100,
		scale_factor => 1024,
		scale_freq => 60,
		tune => 1
	);
}

sub round   { my $x = $_[$[];
	if ($x > 0.0) { return int ($x + 0.5); }
	if ($x < 0.0) { return int ($x - 0.5); }
	return 0;
}


__END__

=pod

=head1 NAME

make_bank5 - Creates a synthy SoundFont, as demo for MIDI::SoundFont

=head1 SYNOPSIS

 make_bank5            # the default output-file is /tmp/Bank5.sf2
 make_bank5 -o /home/soundfonts/Bank5.sf2
 make_bank5 -c -o /home/soundfonts/Bank5.sf2  # suggests timidity.cfg
 perldoc make_bank5    # read the manual :-)

=head1 DESCRIPTION

This script creates a I<SoundFont> file from scratch, using
some simple waveforms.  It is one of the example scripts
that comes with the I<MIDI::SoundFont> CPAN module.

=head1 OPTIONS

=over 3

=item I<-d /home/soundfonts>

Sets the output directory, to I</home/soundfonts> in this example.
In this directory, the files I<Bank5.sf2>,
I<SawtoothToTriangle.pat> and
I<SquareToSine.pat>
will be created.
The default directory is I</tmp>.

=item I<-c>

Also prints to I<STDOUT> a suggested paragraph for your I<timidity.cfg> file

=item I<-v>

Prints version number.

=back

=head1 CHANGES

 20120319  1.0  first working version

=head1 AUTHOR

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

=head1 CREDITS

Based on the MIDI::SoundFont CPAN module.

=head1 SEE ALSO

 http://search.cpan.org/perldoc?MIDI::SoundFont
 http://www.pjb.com.au/midi/
 man timidity.cfg

=cut

