view release on metacpan or  search on metacpan

lib/Audio/NoiseGen.pm  view on Meta::CPAN

  $stream
  %note_freq
  init
  play
  G
  sine
  silence
  noise
  white_noise
  triangle
  square
  envelope
  combine
  split
  sequence
  note
  rest
  segment
  formula
  hardlimit
  amp
  oneshot
  lowpass
  highpass
  generalize
);

our %EXPORT_TAGS = (
  all => [ @EXPORT_OK ]
);

=head1 INITIALIZATION AND PLAY

=head2 init($api, $device, $sample_rate)

This sets up our L<Audio::PortAudio> interface. All parameters are optional, and without any you will get the default provided by PortAudio.

=cut

sub init {
  my $api = shift || Audio::PortAudio::default_host_api();
  my $device = shift || $api->default_output_device;
  $sample_rate = shift || 48000;
  # $sample_rate = shift || 20000;
  $time_step = (1/$sample_rate); # 2 * (1/48000) = 0.0000416666
  $stream = $device->open_write_stream(
    {
      channel_count => 1,
    },
    $sample_rate,
    8000, # some sort of buffer size?
    # 0
  );
}

# sub import {
  # my $class = shift;
  # # if(grep { /^:init$/ } @_) {
    # # Audio::NoiseGen::init();
  # # }
  # $class->SUPER::import(@_);
# }

sub log10 {
  my $n = shift;
  return log($n)/log(10);
}

sub db {
  my $sample = shift;
  return (20 * log10(abs($sample)+0.00000001));
}

=head2 play(gen => $gen, filename => $filename)

C<$filename> is optional.

Invokes the C<$gen> and sends the resulting samples to the output device (soundcard).

=cut

# Play a sequence until we get an undef
my $mon = 0;
sub play {
  my %params = generalize( @_ );
  my $gen = $params{gen};
  my $filename = $params{filename} && $params{filename}->();
  # sox -r 48k -e floating-point -b 32 out.raw out.wav
  my $file;
  if($filename) {
    open $file, '>', $filename
      or die "Error opening $filename: $!";
  }
  while (1) {
    my $raw_sample = '';
    for(1..1000) {
    # while(1) {
      my $sample = $gen->();
      if(defined $sample && ($sample > 1 || $sample < -1)) {
        print "CLIP: $sample\n";
        $sample = $sample > 1 ? 1 : -1;
      }
      # print "Sample: $sample\n";
      if(!defined $sample) {
        $stream->write($raw_sample);
        print $file $raw_sample if $file;
        return;
      }

      # printf "dB: %0.05f\n", db($sample)
        # unless $mon++ % 100;
        
      $raw_sample .= pack "f*", $sample;
    }
      # unless $mon++ % 1000;
    # print "Sending sample block...";
    my $write_available = $stream->write_available;
    # printf "Buffer: %d\n", $write_available
        # if $write_available < 1000;
        # unless $mon++ % 100;
    $stream->write($raw_sample);