File Coverage

blib/lib/Audio/Nama/EffectChain.pm

Criterion	Covered	Total	%
statement	35	206	16.9
branch	0	50	0.0
condition	0	22	0.0
subroutine	12	36	33.3
pod	0	15	0.0
total	47	329	14.2

# ------------- Effect-Chain and -Profile routines --------
# Effect Chains
#
# we have two type of effect chains
# + global effect chains - usually user defined, available to all projects
# + system generated effect chains, per project

{
package Audio::Nama::EffectChain;
use Modern::Perl;
use Data::Dumper::Concise;
use Carp;
use Exporter qw(import);
use Storable qw(dclone);
use Audio::Nama::Effect  qw(fxn append_effect);
use Audio::Nama::Log qw(logpkg logsub);
use Audio::Nama::Assign qw(json_out);

use Audio::Nama::Globals qw($fx_cache %tn $fx);

our $AUTOLOAD;
our $VERSION = 0.001;
no warnings qw(uninitialized);
our @ISA;
our ($n, %by_index, @attributes, %is_attribute);
use Audio::Nama::Object qw(

		n
		ops_list
        ops_data
		inserts_data
		region
		attrib
		class

		);
@attributes = qw(
			name
			bypass
			id
			project
			global
			profile
			user
			system
			track_name
			track_version_result
			track_version_original
			track_target_original
			insert
			track_cache
			track_target
	) ;

### 	attributes for searching, sorting, used by external functions
# 		name				# for user-defined effect chains
#
# 		bypass				# used for identifying effect bypass (obsolete)
# 		id					# effect id, for storing single effect with controllers
# 							# for bypass (probably obsolete)
#
# 		project				# true value identifies project-specific effect chain
#
# 		global				# true value identified global effect chain,
# 							# not project specific, usually user-defined
#
# 		profile				# name of associated effect profile
#
# 		user				# true value identifies user created effect chain
#
# 		system				# true value identifies system generated effect chain
#
# 		track_name			# applies to a track of this name
#
# 		track_version_result 	# WAV version of track after caching
#
# 		track_version_original 	# WAV version of track before caching
#
# 		insert				# true value identifies belonging to an insert
#
# 		track_cache			# true value identifies belonging to track caching
#
# 		track_target_original #	WAV files were from this track

%is_attribute = map{ $_ => 1 } @attributes;
initialize();

## sugar for accessing individual effect attributes
## similar sugar is used for effects.

sub is_controller {
	my ($self, $id) = @_;
	$self->{ops_data}->{$id}->{belongs_to}
}
sub parent_id : lvalue {
	my ($self, $id) = @_;
	$self->{ops_data}->{$id}->{belongs_to}
}
sub type {
	my ($self, $id) = @_;
	$self->{ops_data}->{$id}->{type}
}
sub params {
	my ($self, $id) = @_;
	$self->{ops_data}->{$id}->{params}
}

sub initialize {
	$n = 0;
	%by_index = ();
}
sub new_index { $n++; $by_index{$n} ?  new_index() : $n }
sub new {
	# arguments: ops_list, ops_data, inserts_data
	# ops_list => [id1, id2, id3,...];
	my $class = shift;
	my %vals = @_;

	# we need to so some preparation if we are creating
	# an effect chain for the first time (as opposed
	# to restoring a serialized effect chain)

	if (! $vals{n} ) {

		# move secondary attributes to $self->{attrib}->{...}
		move_attributes(\%vals);

		$vals{n} = new_index();
		$vals{inserts_data} ||= [];
		$vals{ops_list} 	||= [];
		$vals{ops_data} 	||= {};
		croak "undeclared field in: @_" if grep{ ! $_is_field{$_} } keys %vals;
		croak "must have exactly one of 'global' or 'project' fields defined"
			unless ($vals{attrib}{global} xor $vals{attrib}{project});

		logpkg(__FILE__,__LINE__,'debug','constructor arguments ', sub{ json_out(\%vals) });

		# we expect some effects
		logpkg(__FILE__,__LINE__,'warn',"Nether ops_list or nor insert_data is present")
			if ! scalar @{$vals{ops_list}} and ! scalar @{$vals{inserts_data}};

		my $ops_data = {};
		# ops data is taken preferentially
		# from ops_data argument, with fallback
		# to existing effects

		# in both cases, we clone the data structures
		# to ensure we don't damage the original

		map {

			if ( $vals{ops_data}->{$_} )

			{
				$ops_data->{$_} 		  = dclone($vals{ops_data}->{$_});
			}
			else
			{
				my $filtered_op_data = dclone( fxn($_)->as_hash );# copy
				my @unwanted_keys = qw( chain bypassed name surname display);
				delete $filtered_op_data->{$_} for @unwanted_keys;
				$ops_data->{$_} = $filtered_op_data;
			}

		} @{$vals{ops_list}};


		$vals{ops_data} = $ops_data;

		if( scalar @{$vals{inserts_data}})
		{

			# rewrite inserts to store what we need:
			# 1. for general-purpose effects chain use
			# 2. for track caching use


			$vals{inserts_data} =
			[
				map
				{
					logpkg(__FILE__,__LINE__,'debug',"insert: ", sub{Dumper $_});
					my @wet_ops = @{$tn{$_->wet_name}->ops};
					my @dry_ops = @{$tn{$_->dry_name}->ops};
					my $wet_effect_chain = Audio::Nama::EffectChain->new(
						project => 1,
						insert	=> 1,
						ops_list => \@wet_ops,
					);
					my $dry_effect_chain = Audio::Nama::EffectChain->new(
						project => 1,
						insert => 1,
						ops_list => \@dry_ops,
					);
					my $hash = dclone($_->as_hash);

					$hash->{wet_effect_chain} = $wet_effect_chain->n;
					$hash->{dry_effect_chain} = $dry_effect_chain->n;

					map{ delete $hash->{$_} } qw(n dry_vol wet_vol track);

					# Reasons for deleting insert attributes

					# n: we'll get a new index when we re-apply
					# dry_vol, wet_vol: will never be re-allocated
					#    so why not reuse them?
					#    except for general purpose we'd like to
					#    re-allocate
					# track: we already know the track from
					#    the parent effect chain

					# What is left:
					#
					# 	class
					#	wetness
					#	send_type
					#	send_id
					#	return_type
					#	return_id
					#	wet_effect_chain => ec_index,
					#   dry_effect_chain => ec_index,

					$hash
				} @{$vals{inserts_data}}
			];
		}

		#say Audio::Nama::json_out($vals{inserts_data}) if $vals{inserts_data};
	}
	my $object = bless { %vals }, $class;
	$by_index{$vals{n}} = $object;
	logpkg(__FILE__,__LINE__,'debug',sub{$object->dump});
	$object;
}
sub AUTOLOAD {
	my $self = shift;
	my ($call) = $AUTOLOAD =~ /([^:]+)$/;
	return $self->{attrib}->{$call} if exists $self->{attrib}->{$call}
		or $is_attribute{$call};
	croak "Autoload fell through. Object type: ", (ref $self), ", illegal method call: $call\n";
}

### apply effect chain to the specified track

sub add_ops {
	my($self, $track, $ec_args) = @_;

	# Higher priority: track argument
	# Lower priority:  effect chain's own track name attribute
	$track ||= $tn{$self->track_name} if $tn{$self->track_name};


	# make sure surname is unique

	my ($new_surname, $existing) = $track->unique_surname($ec_args->{surname});
	if ( $new_surname ne $ec_args->{surname})
	{
		Audio::Nama::pager_newline(
			"track ".
			$track->name.qq(: other effects with surname "$ec_args->{surname}" found,),
			qq(using "$new_surname". Others are: $existing.));
		$ec_args->{surname} = $new_surname;
	}


	logpkg(__FILE__,__LINE__,'debug',$track->name,
			qq(: adding effect chain ), $self->name, Dumper $self

		);

	# Exclude restoring vol/pan for track_caching.
	# (This conditional is a hack that would be better
	# implemented by subclassing EffectChain
	# for cache/uncache)

	my @ops_list;
	my @added;
	if( $self->track_cache ){
		@ops_list = grep{ $_ ne $track->vol and $_ ne $track->pan }
								@{$self->ops_list}
	} else {
		@ops_list = @{$self->ops_list};
	}
	map
	{
		my $args =
		{
			chain  		=> $track->n,
			type   		=> $self->type($_),
			params 		=> $self->params($_),
			parent		=> $self->parent_id($_),
		};


		# drop the ID if it is already used
		$args->{id} = $_ unless fxn($_);

		logpkg(__FILE__,__LINE__,'debug',"args ", json_out($args));

		$args->{surname} = $ec_args->{surname} if $ec_args->{surname};

		my $FX = append_effect($args)->[0];
		push @added, $FX;
		my $new_id = $FX->id;

		# the effect ID may be new, or it may be previously
		# assigned ID,
		# whatever value is supplied is guaranteed
		# to be unique; not to collide with any other effect

		logpkg(__FILE__,__LINE__,'debug',"new id: $new_id");
		my $orig_id = $_;
		if ( $new_id ne $orig_id)
		# re-write all controllers to belong to new id
		{
			map{ $self->parent_id($_) =~ s/^$orig_id$/$new_id/  } @{$self->ops_list}
		}

	} @ops_list;
	\@added
}
sub add_inserts {
	my ($self, $track) = @_;
	map
	{
		my $insert_data = dclone($_); # copy so safe to modify
		#say "found insert data:\n",Audio::Nama::json_out($insert_data);

		# get effect chain indices for wet/dry arms

		my $wet_effect_chain = delete $insert_data->{wet_effect_chain};
		my $dry_effect_chain = delete $insert_data->{dry_effect_chain};
		my $class 			 = delete $insert_data->{class};

		$insert_data->{track} = $track->name;
		my $insert = $class->new(%$insert_data);
		#$Audio::Nama::by_index{$wet_effect_chain}->add($insert->wet_name, $tn{$insert->wet_name}->vol)
		#$Audio::Nama::by_index{$dry_effect_chain}->add($insert->dry_name, $tn{$insert->dry_name}->vol)
	} @{$self->inserts_data};
}
sub add_region {
	my ($self, $track) = @_;
	# there is also a check in uncache track
	Audio::Nama::throw($track->name.": track already has region definition\n",
		"failed to apply region @$self->{region}\n"), return
		if $track->is_region;
	$track->set(region_start => $self->{region}->[0],
				region_end	 => $self->{region}->[1]);
}

sub add {
	my ($self, $track, $successor) = @_;
	# TODO stop_do_start should take place at this level
	# possibly reconfiguring engine
	my $args = {};
	$args->{before} = $successor;
	$args->{surname} = $self->name if $self->name;
	my $added = $self->add_ops($track, $args);
	$self->add_inserts($track);
	$self->add_region($track) if $self->region;
	$added

}
sub destroy {
	my $self = shift;
	delete $by_index{$self->n};
}

#### class routines

sub find {

# find(): search for an effect chain by attributes
#
# Returns EffectChain objects in list context,
# number of matches in scalar context.

	my %args = @_;
	my $unique = delete $args{unique};

	# first check for a specified index that matches
	# an existing chain

	return $by_index{$args{n}} if $args{n};

	# otherwise all specified fields must match

	my @found = grep
		{ 	my $fx_chain = $_;

			# check if any specified fields *don't* match

			my @non_matches = grep
			{

				! ($fx_chain->{attrib}->{$_} eq $args{$_})

				#! ($_ ne 'version' and $args{$_} eq 1 and $fx_chain->$_)

			} keys %args;

			# if no non-matches, then all have matched,
			# and we return true

			! scalar @non_matches

       } values %by_index;

	warn("unique chain requested but multiple chains found. Skipping.\n"),
		return if $unique and @found > 1;

	if( wantarray() ){ $unique ? pop @found : sort{ $a->n cmp $b->n } @found  }
	else { scalar @found }
}

sub summary {
	my $self = shift;
	my @output;
	push @output, "  name: ".$self->name if $self->name;
	push @output, "  track name: ".$self->track_name if $self->track_name;
	push @output,
	map{
		my $i = Audio::Nama::effect_index( $self->{ops_data}->{$_}->{type} );
		my $name = "    ". $fx_cache->{registry}->[$i]->{name};
	} @{$_->ops_list};
	map{ $_,"\n"} @output;
}

sub move_attributes {
	my $ec_hash = shift;
	map { $ec_hash->{attrib}->{$_} = delete $ec_hash->{$_}  }
	grep{ $ec_hash->{$_} }
	@attributes;
}

sub DESTROY {}

}
{
####  Effect-chain and -profile routines

package Audio::Nama;
sub add_effect_chain {
	my ($name, $track, $successor) = @_;
	my ($ec) = Audio::Nama::EffectChain::find(
		unique => 1,
		user   => 1,
		name   => $name,
	);
	if( $ec ){ $ec->add($Audio::Nama::this_track, $successor) }
	else { Audio::Nama::throw("$name: effect chain not found") }
	1;
}
sub new_effect_profile {
	logsub("&new_effect_profile");
	my ($bunch, $profile) = @_;
	my @tracks = bunch_tracks($bunch);
	Audio::Nama::pager( qq(effect profile "$profile" created for tracks: @tracks) );
	map {
		Audio::Nama::EffectChain->new(
			profile 	=> $profile,
			user		=> 1,
			global		=> 1,
			track_name	=> $_,
			ops_list	=> [ $tn{$_}->fancy_ops ],
			inserts_data => $tn{$_}->inserts,
		);
	} @tracks;
}
sub delete_effect_profile {
	logsub("&delete_effect_profile");
	my $name = shift;
	Audio::Nama::pager( qq(deleting effect profile: $name) );
	map{ $_->destroy} Audio::Nama::EffectChain::find( profile => $name );
}

sub apply_effect_profile {  # overwriting current effects
	logsub("&apply_effect_profile");
	my ($profile) = @_;
	my @chains = Audio::Nama::EffectChain::find(profile => $profile);

	# add missing tracks
	map{ Audio::Nama::pager( "adding track $_" ); add_track($_) }
		grep{ !$tn{$_} }
		map{ $_->track_name } @chains;
	# add effect chains
	map{ $_->add } @chains;
}
sub is_effect_chain {
	my $name = shift;
	my ($fxc) = Audio::Nama::EffectChain::find(name => $name, unique => 1);
	$fxc
}
}
1;
__END__