#!perl -w

# needs to prepend lokey-lovel-hikey-hivel to zone name, otherwise different zones with the same sample
# disappear!

$section='';
$sampleName='';
$instrumentName='';
$presetName='';

&init;

while (<>)
{
	/^\[Samples\]\s*$/     and ( $section='samples',     $sampleName='',     next );
	/^\[Instruments\]\s*$/ and ( $section='instruments', $instrumentName='', next );
	/^\[Presets\]\s*$/     and ( $section='presets',     $presetName='',     next );
	/^\[Info\]\s*$/        and ( $section='info',                            next );
	
	/^\s*$/ and next;
	chomp;

	($section eq "samples") and do
	{
		/^\s+SampleName=(.+\s*)$/i and ($sampleName = $1, $samples{$sampleName}={}, 
		do {
			   if (-e $sampleName . '.wav') { $samples{$sampleName}{'Extn'} = '.wav'; }
			elsif (-e $sampleName . '.ogg') { $samples{$sampleName}{'Extn'} = '.ogg'; }
		}, next);
		($sampleName ne '') and do
		{
			/^\s+(\S+)=(.*)\s*$/
				and (grep(/^${1}$/, values %sfzTosf2S))
				and ((("$2" ne "") and $samples{$sampleName}{$1}=$2), next);
		};
	};
	
	($section eq "instruments") and do
	{
		/^\s+InstrumentName=(.+)\s*$/i and ($instrumentName = $1, $instruments{$instrumentName}={}, $sampleName='', next);
		($instrumentName ne '') and do
		{
			/^\s+Sample=(.+)\s*$/ and ($sampleName=$1,             $prefix='Z',  $instruments{$instrumentName}{$sampleName}={}, next);
			/^\s+GlobalZone\s*$/  and ($sampleName=".GlobalZone.", $prefix='GZ', $instruments{$instrumentName}{$sampleName}={}, next);
			($sampleName ne '') and do
			{
				/^\s+${prefix}_(\S+)=(.*)\s*$/
					and (grep(/^${1}$/, values %sfzTosf2))
					and ((("$2" ne "") and $instruments{$instrumentName}{$sampleName}{$1}=$2), next);
				/^\s+${prefix}_(unused\d|reserved\d)=(.*)\s*$/
					and ((("$2" ne "") and $instruments{$instrumentName}{$sampleName}{$1}=$2), next);
			};
		};
	};
	
	($section eq "presets") and do
	{
		/^\s+PresetName=(.+)\s*$/i and ($presetName = $1, $presets{$presetName}={}, $instrumentName='', next);
		($presetName ne '') and do {
			/^\s+(Bank|Program)=(.+)\s*$/ and ($instrumentName='',              $prefix='',   $presets{$presetName}{$1}=$2, next);
			/^\s+(Instrument)=(.+)\s*$/   and ($instrumentName=$2,              $prefix='L',  $presets{$presetName}{$instrumentName}={}, next);
			/^\s+GlobalLayer\s*$/         and ($instrumentName=".GlobalLayer.", $prefix='G[LZ]', $presets{$presetName}{$instrumentName}={}, next);
			($instrumentName ne '') and do
			{
				/^\s+${prefix}_(\S+)=(.*)\s*$/
					and (grep(/^${1}$/, values %sfzTosf2))
					and ((("$2" ne "") and $presets{$presetName}{$instrumentName}{$1}=$2), next);
				/^\s+${prefix}_(unused\d|reserved\d)=(.*)\s*$/
					and ((("$2" ne "") and $presets{$presetName}{$instrumentName}{$1}=$2), next);
			};
		};
	};
	
	($section eq "info") and do
	{
		/^\s*(Version|Engine|Name|ROMName|ROMVersion|Date|Designer|Product|Copyright|Editor|Comments)=(.*)\s*$/
			and ((("$2" ne "") and $info{$1}=$2), next);
	};

	print 'Unexpected line: ', $_, "\n";
};

#
# We now have
#  %samples{...samplename...}{...keyname...}=...value...
#  %instruments{...instrumentname...}{...sampleName...}{'Z_'...keyname...}=...value...
#  %instruments{...instrumentname...}{'.GlobalZone.'}{'GZ_'...keyname...}=...value...
#  %presets{...presetname...}{...instrumentName...}{'L_'...keyname...}=...value...
#  %presets{...presetname...}{'.GlobalLayer.'}{'GZ_'...keyname...}=...value...
#  %info{...keyname...}=...value...
#
# Info stands on its own (and isn't used in .sfz)
# The rest of the information is tree-structured, each preset being a root node
# The key is really bank-program-presetName but it looks like SF2 requires unique presetNames.
#
# Each preset has to be a separate .sfz file
# 
# Each preset contains layers ("Instruments"), plus a global layer (here an instrument called .GlobalLayer.)
#
# Each instrument, except the GlobalLayer, contains zones, plus a global zone (here called .GlobalZone.)
#
# Each zone, except the GlobalZone, points to a sample (which is used as the zone name).
# Each zone is a <region> in .sfz format.
#

&info_section();

&presets();

sub presets
{
	foreach $preset (sort keys(%presets))
	{
		print "\n\n//\n// ",
			sprintf('Bank: %03d; ', $presets{$preset}{'Bank'}),
			sprintf('Program: %03d; ', $presets{$preset}{'Program'}),
			'Preset: ', $preset, "\n//\n";
		foreach $layer (sort grep(!/^(\.GlobalLayer\.|Bank|Program)$/, keys(%{$presets{$preset}})))
		{
			&do_layer($layer, \%{$presets{$preset}{$layer}}, \%{$presets{$preset}{'.GlobalLayer.'}});
		}
	}
}

sub do_layer
{
	my($layer) = shift;
	my($ref_thisLayer) = shift;
	my($ref_globalLayer) = shift;
	print "\n//\n// Layer: ", $layer, "\n//\n\n";
	
	foreach $zone (sort by_lokey_lovel grep(!/^\.Global/, keys(%{$instruments{$layer}})))
	{
		&do_zone($zone, \%{$instruments{$layer}{$zone}}, \%{$instruments{$layer}{'.GlobalZone.'}},
			$ref_thisLayer, $ref_globalLayer);
	}
}

sub by_lokey_lovel
{
	return 
		(&want_sfz('lokey', \%{$instruments{$layer}{$a}}, undef, undef, undef) * 127 +
		 &want_sfz('lovel', \%{$instruments{$layer}{$a}}, undef, undef, undef))
		<=>
		(&want_sfz('lokey', \%{$instruments{$layer}{$b}}, undef, undef, undef) * 127 +
		 &want_sfz('lovel', \%{$instruments{$layer}{$b}}, undef, undef, undef));
}

sub do_zone
{
	my($zone, @refs) = @_;
	push(@refs, \%{$samples{$zone}});

	$zone =~ /R$/ and return;

	print "\n<region>\n";
	print 'sample=', $zone, ($samples{$sampleName}{'Extn'} or ''), "\n";

	&sf2_to_sfz('lokey', 0, @refs);
	&sf2_to_sfz('hikey', 127, @refs);
	&sf2_to_sfz('lovel', 0, @refs);
	&sf2_to_sfz('hivel', 127, @refs);

	&sf2_to_sfz('group', undef, @refs);
	&sf2_to_sfz('offby', undef, @refs);

	&sf2_to_sfz('pitch_keycenter', 127, @refs);
}

sub sf2_to_sfz
{
	my($key) = shift;
	my($default) = shift;
	my($value) = &want_sfz($key, @_);

	if (defined($sf2_to_sfz_func{$key}))
	{
		$value=&{$sf2_to_sfz_func{$key}}($key, $value, @_);
	}
	if (defined($value))
	{
		if (defined($default))
		{
			if ($value eq $default)
			{
				return;
			}
		}
		print(" $key=$value\n");
	}
}

sub want_sfz
{
	my($sfzkey) = shift;
	my($sf2Ssuff) = $sfzTosf2S{$sfzkey};
	my($sf2suff)  = $sfzTosf2{$sfzkey};
	defined($sf2Ssuff) or defined($sf2suff) or (print("wanted $sfzkey but no sf2Ssuff or sf2suff\n"), return undef);

	return &want_sf2($sf2Ssuff, $sf2suff, @_);
}

sub want_sf2
{

	my($sf2Ssuff, $sf2suff, $ref_thisZone, $ref_globalZone, $ref_thisLayer, $ref_globalLayer, $ref_samples, @junk) = @_;

	defined($sf2suff)  and defined(${$ref_thisZone}{$sf2suff})    and return ${$ref_thisZone}{$sf2suff};
	defined($sf2Ssuff) and defined(${$ref_samples}{$sf2Ssuff})    and return ${$ref_samples}{$sf2Ssuff};  # different hashkeys!
	defined($sf2suff)  and defined(${$ref_globalZone}{$sf2suff})  and return ${$ref_globalZone}{$sf2suff};
	defined($sf2suff)  and defined(${$ref_thisLayer}{$sf2suff})   and return ${$ref_thisLayer}{$sf2suff};
	defined($sf2suff)  and defined(${$ref_globalLayer}{$sf2suff}) and return ${$ref_globalLayer}{$sf2suff};

	return undef;
}



# Use that [Info] section somehow..!
sub info_section
{
	print "////\n";
	print '// ', 
		(defined($info{'Name'}) and $info{'Name'}), 
		(defined($info{'Product'}) and (' - ', $info{'Product'})), 
		(defined($info{'Designer'}) and (' - ', $info{'Designer'})), "\n";
	print '// ', 
		(defined($info{'Date'}) and $info{'Date'}),
		(defined($info{'Copyright'}) and (' - ', $info{'Copyright'})), "\n";
	print '// ', 
		(defined($info{'Editor'}) and ($info{'Editor'}, ' - with ')),
		'sf2tosfz.pl', "\n";
	defined($info{'Comments'}) and (print '// ', $info{'Comments'}, "\n");
	print "// - - -\n";
	print '// ', 
		(defined($info{'Engine'}) and $info{'Engine'}),
		(defined($info{'Version'}) and (', ', $info{'Version'})), "\n";
	defined($info{'ROMName'}) and (print '// ROM: ', $info{'ROMName'},
		(defined($info{'ROMVersion'}) and (' ', $info{'ROMVersion'})), "\n");
	print "////\n\n";
}

sub init
{
%sfzTosf2 = (
	'lokey' => 'LowKey',
	'hikey' => 'HighKey',
	'lovel' => 'LowVelocity',
	'hivel' => 'HighVelocity',
#loccN hiccN
#lobend hibend
#lochanaft hichanaft
#lopolyaft hipolyaft
#trigger
	'group' => 'exclusiveClass',
	'offby' => 'exclusiveClass',	# unless I find out otherwise

	'offset' => '',
	'offsetCoarse' => 'startAddrsCoarseOffset',
	'offsetFine' => 'startAddrsOffset',
	'end' => '',
	'endCoarse' => 'endAddrsCoarseOffset',
	'endFine' => 'endAddrsOffset',
#loopmode
	'loopstart' => '',
	'loopstartCoarse' => 'startloopAddrsCoarseOffset',
	'loopstartFine' => 'startloopAddrsOffset',
	'loopend' => '',
	'loopendCoarse' => 'endloopAddrsCoarseOffset',
	'loopendFine' => 'endloopAddrsOffset',

	'be' => 'keynum',
	'transpose' => 'coarseTune',
	'tune' => 'fineTune',
	'pitch_keycenter' => 'overridingRootKey',
	'pitch_keytrack' => 'scaleTuning',
#bendup benddown

	'fg' => 'Modulator',		# I don't understand the format
					# which makes the *Mod* conversions hard!

# (sourceModOper) (destModOper) (amount) (amountModOper) (sourceModTransOper)

	'gf' => 'delayModEnv',
	'gg' => 'attackModEnv',
	'ah' => 'holdModEnv',
	'bh' => 'decayModEnv',
	'ch' => 'sustainModEnv',
	'dh' => 'releaseModEnv',

	'ga' => 'delayModLFO',
	'gb' => 'freqModLFO',

	'eh' => 'keynumToModEnvHold',
	'fh' => 'keynumToModEnvDecay',

#
	'gh' => 'modEnvToPitch',
	'gc' => 'modLfoToPitch',

	'pitchlfo_delay' => 'delayVibLFO',
	'pitchlfo_freq' => 'freqVibLFO',
	'pitchlfo_depth' => 'vibLfoToPitch',
#
	'cutoff' => 'initialFilterFc',
	'resonance' => 'initialFilterQ',
	'ha' => 'modEnvToFilterFc',
	'gd' => 'modLfoToFilterFc',

#
#amp_keytrack
#amp_keycentre
#amp_depth
	'volume' => 'initialAttenuation',
	'amp_delay' => 'delayVolEnv',
	'amp_attack' => 'attackVolEnv',
	'amp_hold' => 'holdVolEnv',
	'amp_decay' => 'decayVolEnv',
	'amp_sustain' => 'sustainVolEnv',
	'amp_release' => 'releaseVolEnv',

	'fc' => 'keynumToVolEnvHold',
	'fd' => 'keynumToVolEnvDecay',

#amp_veltrack
	'ab' => 'velocity',

#amplfo_delay
#amplfo_freq
#amplfo_depth
	'ge' => 'modLfoToVolume',

	'de' => 'sampleModes',
	'ea' => 'pan',
#
	'effect2' => 'chorusEffectsSend',
	'effect1' => 'reverbEffectsSend',
);

%sfzTosf2S = (
	'aa' => 'SampleRate',
	'root' => 'Key',
	'tune' => 'FineTune',
	'pan' => 'Type',
	'ab' => 'Link',
);

%sf2_to_sfz_func = (
	'transpose' => \&bit16,
	'tune' => \&bit16,
	'pitch_keytrack' => \&bit16,
	'offset' => \&bit32,
	'end' => \&bit32,
	'loopstart' => \&bit32,
	'loopend' => \&bit32,
	'pan' => \&pan,
	'pitchlfo_depth' => \&bit16,
);
}

sub bit16     { my($key, $value, @junk) = @_; return (!defined($value)) ? undef : ($value < 32768) ? ($value) : (-1 * (65536-$value)); }
sub bit16pc   { &bit16(@_) / 1000.0; }
sub pan       {	my($key, $value, @junk) = @_; return (!defined($value)) ? undef : (($value !~ [2|4]) ? $value : (($value eq 2) ? -100 : 100)); }
sub go_undef  { return undef; }

sub bit32
{
	my($key, $value, @refs) = @_; 

	my($valueCoarse) = &want_sfz($key . 'Coarse', @refs);
	my($valueFine) = &want_sfz($key . 'Fine', @refs);

	$value = 0;
	defined($valueCoarse) and $value+=&bit16('', $valueCoarse) * 32768;
	defined($valueFine)   and $value+=&bit16('', $valueFine);

	return $value;
}

sub bit32pc   { &bit32(@_) / 10.0; }