File Coverage

blib/lib/Audio/Nama/IO.pm

Criterion	Covered	Total	%
statement	147	309	47.5
branch	0	78	0.0
condition	0	33	0.0
subroutine	49	121	40.5
pod	0	21	0.0
total	196	562	34.8

package Audio::Nama;
our (%tn, $jack, $config);

# ---------- 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;
use Data::Dumper::Concise;
our $VERSION = 1.0;

# provide following vars to all packages
our ($config, $jack, %tn);
our (%by_name); # index for $by_name{trackname}->{input} = $object
use Audio::Nama::Globals qw($config $jack %tn $setup :trackrw);
use Try::Tiny;

sub initialize { %by_name = () }

# 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_alsa_soundcard_device
	soundcard_device_out 	Audio::Nama::IO::to_alsa_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:
#
#  + Nama:piano_in,
#
# If piano is stereo, the actual ports will be:
#
#  + Nama:piano_in_1
#  + Nama: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.

	my $self = bless {@args}, $class;

	my $direction = $self->direction; # input or output

	# join IO objects to graph
	my $name;
	try{ $name  = $self->name }
	catch {};  # we do nothing

	{ no warnings 'uninitialized';
	Audio::Nama::logpkg(__FILE__,__LINE__,'debug',"I belong to track $name\n",
		sub{Dumper($self)} );
	}

	if($name){
		$by_name{$name}->{$direction} = $self;
	}
	$self
}

# latency stubs
sub capture_latency {
	my $self = shift;
	return unless $self->client;
	Audio::Nama::jack_port_latency('input', $self->client);
}
sub playback_latency {
	my $self = shift;
	return unless $self->client;
	Audio::Nama::jack_port_latency('output', $self->client);
}

# we need at least stubs for subclasses' methods
# for AUTOLOAD to be happy - so we include

sub client {}

#### JACK related methods

# inherited by all, the methods defined below are called in
# these classes:
#
#		to_jack_multi,
#		from_jack_multi
#		to_jack_client
#		from_jack_client
#
# They have no function in other classes.


sub target_id {
	my $self = shift;
	$self->direction eq 'input'
		? $self->source_id
		: $self->send_id;
}
sub target_type {
	my $self = shift;
	$self->direction eq 'input'
		? $self->source_type
		: $self->send_type;
}
sub target_channel {
	my $self = shift;
	$self->target_id =~ /^(\d+)$/ ? $1 : 1
}
sub ports {
	my $self = shift;
	my $client_direction = $self->direction eq 'input' ? 'output' : 'input';
	Audio::Nama::IO::jack_multi_ports( $self->client,
							$client_direction,
							$self->target_channel,
							$self->width,
							Audio::Nama::try{$self->name}
	) if $self->client
}



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;
}

## the format() method generates the correct Ecasound format string,
## (e.g. -f:f32_le,2,48000) if the _format_template() method
## returns a signal format template (e.g. f32_le,N,48000)

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);
	{ no warnings 'uninitialized';
	if ( my $track = $tn{$self->{track_}} ){
		return $track->$call if $track->can($call)
		# ->can is reliable here because Track has no AUTOLOAD
	}
	# suppress error XXX
	return undef if $call eq 'name' or $call eq 'surname';
	}
	my $msg = "Autoload fell through. Object type: ". (ref $self). " illegal method call: $call\n";
	Audio::Nama::throw($msg,$self->dump);
	croak
}

sub DESTROY {}

sub _mono_to_stereo{

	# copy mono track to stereo if we have a pan control and a mono source

	# Truth table
	#REC status, Track width stereo: null
	#REC status, Track width mono:   chcopy
	#PLAY status, WAV width mono:   chcopy
	#PLAY 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  (
			($self->track and $tn{$self->track}->pan)
			and
		  (	$status =~ /REC|MON/ and $is_mono_track->()
			or $status eq PLAY and $is_mono_wav->() )
	)
	{ $copy } else { $nocopy }
}
sub _playat_output {
	my $track = shift;
	return unless $track->shifted_playat_time;
		# or $track->latency_offset;
	join ',',"playat" , $track->shifted_playat_time
		# + $track->latency_offset
}
sub _select_output {
	my $track = shift;
	no warnings 'uninitialized';
	my $start = $track->shifted_region_start_time + $config->hardware_latency();
	my $end   = $track->shifted_region_end_time;
	return unless $config->hardware_latency() or defined $start and defined $end;
	my $setup_length;
	# CASE 1: a region is defined
	if ($end) {
		$setup_length = $end - $start;
	}
	# CASE 2: only hardware latency
	else {
		$setup_length = $track->wav_length - $start
	}
	join ',',"select", $start, $setup_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 {
	$jack->{jackd_running} ? 'jack_multi_in' : 'soundcard_device_in'
}
sub soundcard_output_type_string {
	$jack->{jackd_running} ? 'jack_multi_out' : 'soundcard_device_out'
}
sub soundcard_input_device_string {
	$jack->{jackd_running} ? 'system' : $config->{alsa_capture_device}
}
sub soundcard_output_device_string {
	$jack->{jackd_running} ? 'system' : $config->{alsa_playback_device}
}

sub jack_multi_route {
	my (@ports)  = @_;
	join q(,),q(jack_multi),
	map{quote_jack_port($_)} @ports
}

sub jack_multi_ports {
	my ($client, $direction, $start, $width, $trackname)  = @_;
	no warnings 'uninitialized';
	Audio::Nama::logpkg(__FILE__,__LINE__,'debug',"trackname: $trackname, client $client, direction $direction, start: $start, width $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 $channel_count = scalar @{$jack->{clients}->{$client}{$direction}};
	my $source_or_send = $direction eq 'input' ? 'send' : 'source';
  	die(qq(
Track $trackname: $source_or_send would cover channels $start - $end,
out of bounds for JACK client "$client" ($channel_count channels max).
Change $source_or_send setting, or set track OFF.))
	if $end > $channel_count and $config->{enforce_channel_bounds};
		return @{$jack->{clients}->{$client}{$direction}}[$start-1..$end-1]
		 	if $jack->{clients}->{$client}{$direction};

}
#sub one_port { $jack->{clients}->{$client}->{$direction}->[$start-1] }

sub quote_jack_port {
	my $port = shift;
	($port =~ /\s/ and $port !~ /^"/) ? qq("$port") : $port
}
sub rectified { # client name from number
	$_[0] =~ /^\d+$/
		? 'system'
		: $_[0]
}
### 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' }
}

{
package Audio::Nama::IO::from_rtnull;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub _device_id { 'rtnull' }
}

{
package Audio::Nama::IO::to_rtnull;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub _device_id { 'rtnull' }
}

{
package Audio::Nama::IO::from_wav;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub device_id {
	my $self = shift;
	my @modifiers;
	push @modifiers, $self->playat_output if $self->playat_output;
	push @modifiers, $self->select_output if $self->select_output;
	push @modifiers, split " ", $self->modifiers if $self->modifiers;
	push @modifiers, $self->full_path;
	join(q[,],@modifiers);
}
sub ecs_extra { $_[0]->mono_to_stereo}
sub client { 'system' if $jack->{jackd_running} } # since we share latency value
sub ports { 'system:capture_1' }
}
{
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 { $config->{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}");
}
sub format {}
}
{
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 client {
	my $self = shift;
#  	say "to_jack_multi: target_id: ",$self->target_id;
#  	say "to_jack_multi: rectified target_id: ",Audio::Nama::IO::rectified($self->target_id);
	Audio::Nama::IO::rectified($self->target_id)
}
sub device_id {
	my $self = shift;
	Audio::Nama::IO::jack_multi_route($self->ports)
}
}

{
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 { $config->{devices}->{jack}->{signal_format} }
sub device_id { 'jack,,'.$_[0]->port_name.'_out' }
sub ports { "Nama:".$_[0]->port_name. '_out_1' } # at least this one port
	# HARDCODED port name
}

{
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 }
sub ports { "Nama:".$_[0]->port_name. '_in_1' } # at least this one port
	# HARDCODED port name
}

{
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); }
sub client { Audio::Nama::IO::rectified($_[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}
sub client { Audio::Nama::IO::rectified($_[0]->source_id) }
}

{
package Audio::Nama::IO::from_alsa_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 { $config->{devices}->{$config->{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_alsa_soundcard_device;
use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO';
sub device_id { $config->{devices}->{$config->{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__