File Coverage

blib/lib/Audio/TinySoundFont.pm

Criterion	Covered	Total	%
statement	105	105	100.0
branch	18	18	100.0
condition	21	25	84.0
subroutine	24	24	100.0
pod	10	11	90.9
total	178	183	97.2

package Audio::TinySoundFont;

use v5.14;
use warnings;
our $VERSION = '0.11';

use autodie;
use Carp;
use Try::Tiny;
use Scalar::Util qw/blessed/;

use Moo;
use Types::Standard qw/ArrayRef HashRef GlobRef Str Int Num InstanceOf/;

use Audio::TinySoundFont::XS;
use Audio::TinySoundFont::Preset;
use Audio::TinySoundFont::Builder;

has _tsf => (
  is       => 'ro',
  isa      => InstanceOf ['Audio::TinySoundFont::XS'],
  required => 1,
);

has volume => (
  is      => 'rw',
  isa     => Num,
  default => 0.3,
  trigger => sub { my $self = shift; $self->_tsf->set_volume(shift) },
);

has preset_count => (
  is  => 'lazy',
  isa => Int,
);

has presets => (
  is  => 'lazy',
  isa => HashRef,
);

*SAMPLE_RATE = \&Audio::TinySoundFont::XS::SAMPLE_RATE;

my $XS        = 'Audio::TinySoundFont::XS';
my %ref_build = (
  '' => sub
  {
    my $file = shift;
    croak qq{File "$file" doesn't exist}
        if !-e $file;
    return try { $XS->load_file($file) } catch { croak $_ };
  },
  SCALAR => sub
  {
    my $str = shift;
    open my $glob, '<', $str;
    return try { $XS->load_fh($glob) } catch { croak $_ };
  },
  GLOB => sub
  {
    my $fh = shift;
    return try { $XS->load_fh($fh) } catch { croak $_ };
  },
);

sub BUILDARGS
{
  my $class = shift;
  my $file  = shift;
  my $args  = Moo::Object::BUILDARGS( $class, @_ );

  my $build_fn = $ref_build{ ref $file };
  croak "Cannot load soundfont file, unknown ref: " . ref($file)
      if !defined $build_fn;
  my $tsf = $build_fn->($file);
  $args->{volume} = 0.3;

  $args->{_tsf} = $tsf;

  return $args;
}

sub _build_preset_count
{
  my $self = shift;

  return $self->_tsf->presetcount;
}

sub _build_presets
{
  my $self = shift;

  my %result;
  foreach my $i ( 0 .. $self->preset_count )
  {
    my $name     = $self->_tsf->get_presetname($i) // '';
    my $n        = '';
    my $conflict = 1;
    while ( exists $result{"$name$n"} )
    {
      $conflict++;
      $n = "_$conflict";
    }
    $name = "$name$n";
    $result{$name} = Audio::TinySoundFont::Preset->new(
      soundfont => $self,
      index     => $i,
    );
  }

  return \%result;
}

sub preset
{
  my $self = shift;
  my $name = shift;

  my $preset = $self->presets->{$name};

  croak qq{Could not find preset "$name"}
      if !defined $preset;

  return $preset;
}

sub preset_index
{
  my $self  = shift;
  my $index = shift;

  croak qq{Could not find preset "$index"}
      if $index >= $self->preset_count;

  return Audio::TinySoundFont::Preset->new(
    soundfont => $self,
    index     => $index,
  );
}

sub new_builder
{
  my $self   = shift;
  my @script = @_;

  if ( @script == 1 && ref $script[0] eq 'ARRAY' )
  {
    @script = @{ $script[0] };
  }

  return Audio::TinySoundFont::Builder->new(
    soundfont   => $self,
    play_script => \@script,
  );
}

sub active_voices
{
  my $self = shift;
  return $self->_tsf->active_voices;
}

sub is_active
{
  my $self = shift;
  return !!$self->_tsf->active_voices;
}

sub note_on
{
  my $self   = shift;
  my $preset = shift // croak "Preset is required for note_on";
  my $note   = shift // 60;
  my $vel    = shift // 0.5;

  if ( !blessed $preset )
  {
    $preset = $self->preset($preset);
  }

  ( InstanceOf ['Audio::TinySoundFont::Preset'] )->($preset);

  $self->_tsf->note_on( $preset->index, $note, $vel );
  return;
}

sub note_off
{
  my $self   = shift;
  my $preset = shift // croak "Preset is required for note_off";
  my $note   = shift // 60;

  if ( !blessed $preset )
  {
    $preset = $self->preset($preset);
  }

  ( InstanceOf ['Audio::TinySoundFont::Preset'] )->($preset);

  $self->_tsf->note_off( $preset->index, $note );
  return;
}

sub render
{
  my $self = shift;
  my %args = @_;

  my $tsf = $self->_tsf;

  my $SR      = $tsf->SAMPLE_RATE;
  my $seconds = $args{seconds} // 0;
  my $samples = ( $seconds * $SR ) || $args{samples} // $SR;

  return $tsf->render($samples);
}

sub render_unpack
{
  my $self = shift;

  return unpack( 's<*', $self->render(@_) );
}

sub db_to_vol
{
  my $self = shift;
  my $db   = shift;

  return
      if !defined $db;

  # Volume is a float 0.0-1.0, db is in dB -100..0, so adjust it to a float
  $db
      = $db > 0    ? 0
      : $db < -100 ? -100
      :              $db;
  return 10**( $db / 20 );
}

1;
__END__