/usr/local/CPAN/Audio-Nama/Audio/Nama/IO.pm
# ---------- IO -----------
#
# IO objects for writing Ecasound chain setup file
#
# Object values can come from three sources:
#
# 1. As arguments to the constructor new() while walking the
# routing graph:
# + assigned by dispatch: chain_id, loop_id, track, etc.
# + override by graph node (higher priority)
# + override by graph edge (highest priority)
# 2. (sub)class methods called as $object->method_name
# + defined as _method_name (access via AUTOLOAD, overrideable by constructor)
# + defined as method_name (not overrideable)
# 3. AUTOLOAD
# + any other method calls are passed to the the associated track
# + illegal track method call generate an exception
package Audio::Nama::IO;
use Modern::Perl; use Carp;
our $VERSION = 1.0;
# we will use the following to map from graph node names
# to IO class names
our %io_class = qw(
null_in Audio::Nama::IO::from_null
null_out Audio::Nama::IO::to_null
soundcard_in Audio::Nama::IO::from_soundcard
soundcard_out Audio::Nama::IO::to_soundcard
soundcard_device_in Audio::Nama::IO::from_soundcard_device
soundcard_device_out Audio::Nama::IO::to_soundcard_device
wav_in Audio::Nama::IO::from_wav
wav_out Audio::Nama::IO::to_wav
loop_source Audio::Nama::IO::from_loop
loop_sink Audio::Nama::IO::to_loop
jack_manual_in Audio::Nama::IO::from_jack_port
jack_manual_out Audio::Nama::IO::to_jack_port
jack_ports_list_in Audio::Nama::IO::from_jack_port
jack_ports_list_out Audio::Nama::IO::to_jack_port
jack_multi_in Audio::Nama::IO::from_jack_multi
jack_multi_out Audio::Nama::IO::to_jack_multi
jack_client_in Audio::Nama::IO::from_jack_client
jack_client_out Audio::Nama::IO::to_jack_client
);
### class descriptions
# === CLASS Audio::Nama::IO::from_jack_port ===
#
# is triggered by source_type codes:
#
# + jack_manual_in
# + jack_ports_list_in
#
# For track 'piano', the class creates an input similar to:
#
# -i:jack,,piano_in
#
# which receives input from JACK node:
#
# + ecasound:piano_in,
#
# If piano is stereo, the actual ports will be:
#
# + ecasound:piano_in_1
# + ecasound:piano_in_2
# (CLASS Audio::Nama::IO::to_jack_port is similar)
### class definition
our $AUTOLOAD;
# add underscore to field names so that regular method
# access will go through AUTOLOAD
# we add an underscore to each key
use Audio::Nama::Object qw(track_ chain_id_ endpoint_ format_ format_template_ width_ ecs_extra_ direction_ device_id_);
sub new {
my $class = shift;
my %vals = @_;
my @args = map{$_."_", $vals{$_}} keys %vals; # add underscore to key
# note that we won't check for illegal fields
# so we can pass any value and allow AUTOLOAD to
# check the hash for it.
bless {@args}, $class
}
sub ecs_string {
my $self = shift;
my @parts;
push @parts, '-f:'.$self->format if $self->format;
push @parts, '-'.$self->io_prefix.':'.$self->device_id;
join ' ',@parts;
}
sub format {
my $self = shift;
Audio::Nama::signal_format($self->format_template, $self->width)
if $self->format_template and $self->width
}
sub _format_template {} # the leading underscore allows override
# by a method without the underscore
sub _ecs_extra {} # allow override
sub direction {
(ref $_[0]) =~ /::from/ ? 'input' : 'output'
}
sub io_prefix { substr $_[0]->direction, 0, 1 } # 'i' or 'o'
sub AUTOLOAD {
my $self = shift;
# get tail of method call
my ($call) = $AUTOLOAD =~ /([^:]+)$/;
my $result = q();
my $field = "$call\_";
my $method = "_$call";
return $self->{$field} if exists $self->{$field};
return $self->$method if $self->can($method);
if ( my $track = $Audio::Nama::tn{$self->{track_}} ){
return $track->$call if $track->can($call)
# ->can is reliable here because Track has no AUTOLOAD
}
print $self->dump;
croak "Autoload fell through. Object type: ", (ref $self), ", illegal method call: $call\n";
}
sub DESTROY {}
# The following methods were moved here from the Track class
# because they are only used in generating chain setups.
# They retain $track as the $self variable.
sub _mono_to_stereo{
# Truth table
#REC status, Track width stereo: null
#REC status, Track width mono: chcopy
#MON status, WAV width mono: chcopy
#MON status, WAV width stereo: null
#Higher channel count (WAV or Track): null
my $self = shift;
my $status = $self->rec_status();
my $copy = "-chcopy:1,2";
my $nocopy = "";
my $is_mono_track = sub { $self->width == 1 };
my $is_mono_wav = sub { Audio::Nama::channels($self->wav_format) == 1};
if ( $status eq 'REC' and $is_mono_track->()
or $status eq 'MON' and $is_mono_wav->() )
{ $copy }
else { $nocopy }
}
sub _playat_output {
my $track = shift;
return unless $track->adjusted_playat_time;
join ',',"playat" , $track->adjusted_playat_time;
}
sub _select_output {
my $track = shift;
my $start = $track->adjusted_region_start_time + Audio::Nama::hardware_latency();
my $end = $track->adjusted_region_end_time;
return unless Audio::Nama::hardware_latency() or defined $start and defined $end;
my $length;
# CASE 1: a region is defined
if ($end) {
$length = $end - $start;
}
# CASE 2: only hardware latency
else {
$length = $track->wav_length - $start
}
join ',',"select", $start, $length
}
### utility subroutines
sub get_class {
my ($type,$direction) = @_;
Audio::Nama::Graph::is_a_loop($type) and
return $io_class{ $direction eq 'input' ? "loop_source" : "loop_sink"};
$io_class{$type} or croak "unrecognized IO type: $type"
}
sub soundcard_input_type_string {
$Audio::Nama::jack_running ? 'jack_multi_in' : 'soundcard_device_in'
}
sub soundcard_output_type_string {
$Audio::Nama::jack_running ? 'jack_multi_out' : 'soundcard_device_out'
}
sub soundcard_input_device_string {
$Audio::Nama::jack_running ? 'system' : $Audio::Nama::alsa_capture_device
}
sub soundcard_output_device_string {
$Audio::Nama::jack_running ? 'system' : $Audio::Nama::alsa_playback_device
}
sub jack_multi_route {
my ($client, $direction, $start, $width) = @_;
# can we route to these channels?
my $end = $start + $width - 1;
# the following logic avoids deferencing undef for a
# non-existent client, and correctly handles
# the case of a portname (containing colon)
my $count_maybe_ref = $Audio::Nama::jack{$client}{$direction};
my $max = ref $count_maybe_ref eq 'ARRAY'
? scalar @$count_maybe_ref
: $count_maybe_ref;
#my $max = scalar @{$Audio::Nama::jack{$client}{$direction}};
die qq(JACK client "$client", direction: $direction
channel ($end) is out of bounds. $max channels maximum.\n)
if $end > $max;
join q(,),q(jack_multi),
map{quote_jack_port($_)}
@{$Audio::Nama::jack{$client}{$direction}}[$start-1..$end-1];
}
sub default_jack_ports_list {
my ($track_name) = shift;
"$track_name.ports"
}
sub quote_jack_port {
my $port = shift;
($port =~ /\s/ and $port !~ /^"/) ? qq("$port") : $port
}
### subclass definitions
### method names with a preceding underscore
### can be overridded by the object constructor
package Audio::Nama::IO::from_null;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub _device_id { 'null' } #
package Audio::Nama::IO::to_null;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub _device_id { 'null' } # underscore for testing
package Audio::Nama::IO::from_wav;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub device_id {
my $io = shift;
my @modifiers;
push @modifiers, $io->playat_output if $io->playat_output;
push @modifiers, $io->select_output if $io->select_output;
push @modifiers, split " ", $io->modifiers if $io->modifiers;
push @modifiers, $io->full_path;
join(q[,],@modifiers);
}
sub ecs_extra { $_[0]->mono_to_stereo}
package Audio::Nama::IO::to_wav;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub device_id { $_[0]->full_path }
sub _format_template { $Audio::Nama::raw_to_disk_format }
package Audio::Nama::IO::from_loop;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub new {
my $class = shift;
my %vals = @_;
$class->SUPER::new( %vals, device_id => "loop,$vals{endpoint}");
}
package Audio::Nama::IO::to_loop;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO::from_loop';
package Audio::Nama::IO::from_soundcard;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub new {
shift; # throw away class
my $class = $io_class{Audio::Nama::IO::soundcard_input_type_string()};
$class->new(@_);
}
package Audio::Nama::IO::to_soundcard;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub new {
shift; # throw away class
my $class = $io_class{Audio::Nama::IO::soundcard_output_type_string()};
$class->new(@_);
}
package Audio::Nama::IO::to_jack_multi;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub device_id {
my $io = shift;
# maybe source_id is an input number
my $client = $io->direction eq 'input'
? $io->source_id
: $io->send_id;
my $channel = 1;
# we want the direction with respect to the client, i.e. # reversed
my $client_direction = $io->direction eq 'input' ? 'output' : 'input';
if( Audio::Nama::dest_type($client) eq 'soundcard'){
$channel = $client;
$client = Audio::Nama::IO::soundcard_input_device_string(); # system, okay for output
}
Audio::Nama::IO::jack_multi_route($client,$client_direction,$channel,$io->width )
}
# don't need to specify format, since we take all channels
package Audio::Nama::IO::from_jack_multi;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO::to_jack_multi';
sub ecs_extra { $_[0]->mono_to_stereo }
package Audio::Nama::IO::to_jack_port;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub format_template { $Audio::Nama::devices{jack}{signal_format} }
sub device_id { 'jack,,'.$_[0]->port_name.'_out' }
package Audio::Nama::IO::from_jack_port;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO::to_jack_port';
sub device_id { 'jack,,'.$_[0]->port_name.'_in' }
sub ecs_extra { $_[0]->mono_to_stereo }
package Audio::Nama::IO::to_jack_client;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub device_id { "jack," . Audio::Nama::IO::quote_jack_port($_[0]->send_id); }
package Audio::Nama::IO::from_jack_client;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub device_id { 'jack,'. Audio::Nama::IO::quote_jack_port($_[0]->source_id); }
sub ecs_extra { $_[0]->mono_to_stereo}
package Audio::Nama::IO::from_soundcard_device;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub ecs_extra { join ' ', $_[0]->rec_route, $_[0]->mono_to_stereo }
sub device_id { $Audio::Nama::devices{$Audio::Nama::alsa_capture_device}{ecasound_id} }
sub input_channel { $_[0]->source_id }
sub rec_route {
# works for mono/stereo only!
no warnings qw(uninitialized);
my $self = shift;
# needed only if input channel is greater than 1
return '' if ! $self->input_channel or $self->input_channel == 1;
my $route = "-chmove:" . $self->input_channel . ",1";
if ( $self->width == 2){
$route .= " -chmove:" . ($self->input_channel + 1) . ",2";
}
return $route;
}
{
package Audio::Nama::IO::to_soundcard_device;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub device_id { $Audio::Nama::devices{$Audio::Nama::alsa_playback_device}{ecasound_id} }
sub ecs_extra {route($_[0]->width,$_[0]->output_channel) }
sub output_channel { $_[0]->send_id }
sub route2 {
my ($from, $to, $width) = @_;
}
sub route {
# routes signals (1..$width) to ($dest..$dest+$width-1 )
my ($width, $dest) = @_;
return '' if ! $dest or $dest == 1;
# print "route: width: $width, destination: $dest\n\n";
my $offset = $dest - 1;
my $route ;
for my $c ( map{$width - $_ + 1} 1..$width ) {
$route .= " -chmove:$c," . ( $c + $offset);
}
$route;
}
}
package Audio::Nama::IO::any;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
1;
__END__