view release on metacpan or  search on metacpan

SoundFont.pm  view on Meta::CPAN

		my %gens = ();  my $j = $from;
		while ($j < $to) {
			$gens{$GeneratorOperators[$igen_list[$j]{'sfGenOper'}]}
			  = $igen_list[$j]{'shAmount'};
			$j += 1;
		}
		$ibag_list[$i]{'generators'} = \%gens;
		delete $ibag_list[$i]{'wInstGenNdx'};
		# should check monotonicity and in-rangeness
		$from = $ibag_list[$i]{'wInstModNdx'};
		$to = $ibag_list[$i+1]{'wInstModNdx'};
		my @mods = ();  $j = $from;
		while ($j < $to) { push @mods, $imod_list[$j]; $j += 1; }
		$ibag_list[$i]{'modulators'} = \@mods;
		delete $ibag_list[$i]{'wInstModNdx'};
		$i += 1;
	}
	# now go though @inst_list extracting each preset's lists of bags
	$i = 0; while ($i < $#inst_list) {
		my $from = $inst_list[$i]{'wInstBagNdx'};
		my $to = $inst_list[$i+1]{'wInstBagNdx'};
		# should check monotonicity and in-rangeness
		my @ibags = ();  my $j = $from;
		while ($j < $to) { push @ibags, $ibag_list[$j]; $j += 1; }
		$inst_list[$i]{'ibags'} = \@ibags;
		delete $inst_list[$i]{'wInstBagNdx'};
		$i += 1;
	}

	# pop EOP off the end of @phdr_list
	if ($phdr_list[$#phdr_list]{'achPresetName'} eq 'EOP') { pop @phdr_list; }
	# pop EOI off the end of @inst_list
	if ($inst_list[$#inst_list]{'achInstName'} eq 'EOI') { pop @inst_list; }
	# construct %inst_hash and %shdr_hash
	my %inst_hash = (); foreach (@inst_list) {
		$inst_hash{$_->{'achInstName'}} = $_;
		delete $_->{'achInstName'};
	}
	my %shdr_hash = (); foreach (@shdr_list) {
		$shdr_hash{$_->{'achSampleName'}} = $_;
		delete $_->{'achSampleName'};
	}
#	$sf{'pbag'} = \@pbag_list;
	$sf{'phdr'} = \@phdr_list;
#	$sf{'pmod'} = \@pmod_list;
#	$sf{'pgen'} = \@pgen_list;
#	$sf{'ibag'} = \@ibag_list;
	$sf{'inst'} = \%inst_hash;
#	$sf{'imod'} = \@imod_list;
#	$sf{'igen'} = \@igen_list;
	$sf{'shdr'} = \%shdr_hash;

	if ($debug) {
		$Data::Dumper::Indent=1; $Data::Dumper::Sortkeys=1; print Dumper(%sf);
	}
	return %sf;
}

sub new_sf { my $inam = $_[$[] || 'Name of this SoundFont';
	my ($name,$passwd,$uid,$gid, $quota,$comment,$gcos,$dir,$shell,$expire)
	  = getpwuid($>);
	$gcos =~ s/,+$//;
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
	my $y = sprintf ("%4.4d", $year+1900);
	my @abbr = qw( January February March April May June
	  July August September October November December );
	my $now = "$abbr[$mon] $mday, $y";   # sfspec21.html#5.6
	return (
		ICMT => "insert comment here",
		ICOP => "Copyright (c) $y $gcos; may be freely copied and modified",
		ICRD => $now,
		IENG => "$name, $gcos",
		INAM => $inam,
		IPRD => 'TiMidity',
		ISFT => "MIDI-SoundFont $VERSION",
		IVER => '',
		ifil => '2.1',
		inst => {
			inst_0 => {
				ibags => [
					{
						generators => {
							keyRange => [ 0, 127 ],
							pan => -190,
							sampleID => 'smpl_0',
							sampleModes => 1,
						},
						modulators => [],
        			},
				],
			},
		},
		phdr => [
			{
				achPresetName => 'Instrument number 0',
				pbags => [
					{
						generators => {
							velRange => [ 0, 127 ],
							instrument => 'inst_0',
						},
						modulators => [],
					},
				],
				wBank => 0,
				wPreset => 0,
			},
		],
		shdr => {
			inst_0 => {
				byOriginalKey => 69,
				chCorrection => 0,
				dwEnd => 10000,
				dwEndloop => 9990,
				dwSampleRate => 44100,
				dwStart => 0,
				dwStartloop => 9890,
				sampledata => ' ... ',
				sfSampleType => 1,
				wSampleLink => 0,
			},