## -------------- Effects registry ---------------
package Audio::Nama;
use Modern::Perl;
use Audio::Nama::Util qw(round);
no warnings 'uninitialized';
## register data about LADSPA plugins, and Ecasound effects and
# presets (names, ids, parameters, hints)
sub prepare_static_effects_data{
my $source = shift;
logsub("&prepare_static_effects_data");
if (not is_test_script() ){
logpkg(__FILE__,__LINE__,'debug', join "\n", "newplugins:", new_plugins());
if (! $source and ($config->{opts}->{r} or new_plugins())){
unlink $file->effects_cache;
print "Regenerating effects data cache\n";
}
}
# maybe $source
if ($config->{opts}->{T} )
{
logpkg(__FILE__,__LINE__,'debug', "using dummy effects data");
$source = $fx_cache->{fake};
}
elsif (-f $file->effects_cache and ! $config->{opts}->{C})
{
logpkg(__FILE__,__LINE__,'debug', "found effects cache: ",$file->effects_cache);
$source = read_file($file->effects_cache); # scalar assign
}
if ($source)
{
assign(
data => decode($source, 'json'),
vars => [qw($fx_cache)],
class => 'Audio::Nama'
);
}
else
{
logpkg(__FILE__,__LINE__,'debug', "reading in effects data, please wait...");
initialize_effect_index();
read_in_effects_data();
# cop-register, preset-register, ctrl-register, ladspa-register
get_ladspa_hints();
get_lv2_hints() unless $config->{opts}->{J};
integrate_ladspa_hints();
integrate_cop_hints();
sort_ladspa_effects();
prepare_effects_help();
logpkg(__FILE__,__LINE__,'debug', "updating effects cache on disk: ",$file->effects_cache);
serialize (
file => $file->effects_cache,
vars => [qw($fx_cache)],
class => 'Audio::Nama',
format => 'json') unless is_test_script();
}
prepare_effect_index();
}
sub ladspa_plugin_list {
my @plugins;
my %seen;
for my $dir ( split ':', ladspa_path()){
next unless -d $dir;
opendir(my $dirh, $dir)
or die "can't open directory $dir for read: $!";
push @plugins,
map{"$dir/$_"} # full path
grep{ ! $seen{$_} and ++$seen{$_}} # skip seen plugins
grep{ /\.so$/} readdir $dirh; # get .so files
closedir $dirh;
}
@plugins
}
sub lv2_plugin_list {
my @plugins;
my %seen;
for my $dir ( split ':', lv2_path()){
next unless -d $dir;
opendir(my $dirh, $dir)
or die "can't open directory $dir for read: $!";
push @plugins,
map{"$dir/$_"} # full path
grep{ ! $seen{$_} and ++$seen{$_}} # skip seen plugins
grep{ /\.lv2$/} readdir $dirh; # get .lv2 files
closedir $dirh;
}
@plugins
}
sub new_plugins {
my @filenames = ladspa_plugin_list();
push @filenames, lv2_plugin_list();
push @filenames, '/usr/local/share/ecasound/effect_presets',
'/usr/share/ecasound/effect_presets',
"$ENV{HOME}/.ecasound/effect_presets";
my $effects_cache_stamp = modified_stamp($file->effects_cache);
my $latest;
map{ my $mod = modified_stamp($_);
$latest = $mod if $mod > $latest } @filenames;
$latest > $effects_cache_stamp;
}
sub modified_stamp {
# timestamp that file was modified
my $filename = shift;
#print "file: $filename\n";
my @s = stat $filename;
$s[9];
}
sub initialize_effect_index {
$fx_cache->{partial_label_to_full} = {};
}
sub prepare_effect_index {
logsub("&prepare_effect_index");
map{
my $code = $_;
my ($short) = $code =~ /:([-\w]+)/;
if ( $short ) {
if ($fx_cache->{partial_label_to_full}->{$short}) { warn "name collision: $_\n" }
else { $fx_cache->{partial_label_to_full}->{$short} = $code }
}
$fx_cache->{partial_label_to_full}->{$code} = $code;
} grep{ !/^elv2:/ }keys %{$fx_cache->{full_label_to_index}};
#print json_out $fx_cache->{partial_label_to_full};
}
sub extract_effects_data {
logsub("&extract_effects_data");
my ($lower, $upper, $regex, $separator, @lines) = @_;
carp ("incorrect number of lines ", join ' ',$upper-$lower,scalar @lines)
if $lower + @lines - 1 != $upper;
logpkg(__FILE__,__LINE__,'debug',"lower: $lower upper: $upper separator: $separator");
logpkg(__FILE__,__LINE__,'debug', "lines: ". join "\n",@lines);
logpkg(__FILE__,__LINE__,'debug', "regex: $regex");
my $j = $lower - 1;
while(my $line = shift @lines){
$j++;
$line =~ /$regex/ or
carp("bad effect data line: $line\n",
join " ", map{ ord($_) } split //, $line), next;
my ($no, $name, $id, $rest) = ($1, $2, $3, $4);
# $no is unimportant; it from the list numbering
logpkg(__FILE__,__LINE__,'debug', "Number: $no Name: $name Code: $id Rest: $rest");
my @p_names = split $separator,$rest;
map{s/'//g}@p_names; # remove leading and trailing q(') in ladspa strings
logpkg(__FILE__,__LINE__,'debug', "Parameter names: @p_names");
$fx_cache->{registry}->[$j]={};
#$fx_cache->{registry}->[$j]->{number} = $no;
$fx_cache->{registry}->[$j]->{code} = $id;
$fx_cache->{registry}->[$j]->{name} = $name;
$fx_cache->{registry}->[$j]->{count} = scalar @p_names;
$fx_cache->{registry}->[$j]->{params} = [];
$fx_cache->{registry}->[$j]->{display} = qq(field);
map{ push @{$fx_cache->{registry}->[$j]->{params}}, {name => $_} } @p_names
if @p_names;
# abbrevations for lv2: lv2-foo for elv2:http://something.com/other/foo
if ($id =~ /elv2:/){
my ($suffix) = $id =~ /(?:elv2:).*?([^\/]+)$/;
my $trimmed = $line;
$trimmed =~ s/^\d+\.\s*//;
$trimmed =~ s/\t/ /g;
$trimmed =~ s/'//g;
$trimmed =~ s/,/, /g;
$trimmed = "LV2 $trimmed";
$fx_cache->{partial_label_to_full}->{"lv2-$suffix"} = $id;
push @{$fx_cache->{user_help}}, $trimmed; # store help
}
# abbreviate index takes full names as well
$fx_cache->{partial_label_to_full}->{$id} = $id;
}
}
sub sort_ladspa_effects {
logsub("&sort_ladspa_effects");
# print json_out($fx_cache->{split});
my $aa = $fx_cache->{split}->{ladspa}{a};
my $zz = $fx_cache->{split}->{ladspa}{z};
# print "start: $aa end $zz\n";
map{push @{$fx_cache->{ladspa_sorted}}, 0} ( 1 .. $aa ); # fills array slice [0..$aa-1]
splice @{$fx_cache->{ladspa_sorted}}, $aa, 0,
sort { $fx_cache->{registry}->[$a]->{name} cmp $fx_cache->{registry}->[$b]->{name} } ($aa .. $zz) ;
logpkg(__FILE__,__LINE__,'debug', "sorted array length: ". scalar @{$fx_cache->{ladspa_sorted}});
}
sub read_in_effects_data {
logsub("&read_in_effects_data");
#### LADSPA
my $lr = eval_iam("ladspa-register");
logpkg(__FILE__,__LINE__,'debug',"ladpsa-register output:\n",$lr);
#print $lr;
my @ladspa = split "\n", $lr;
# join the two lines of each entry
my @lad = map { join " ", splice(@ladspa,0,2) } 1..@ladspa/2;
#logpkg(__FILE__,__LINE__,'debug',join "\n","ladpsa-register processed output:",@lad);
#### LV2
my $lv2 = eval_iam('lv2-register'); # TODO test fake lv2-register
# get_data_section('fake_lv2_register');
logpkg(__FILE__,__LINE__,'debug',"lv2-register output:\n",$lv2);
# join wrapped lines
$lv2 =~ s/\n # newline
\.{3} # three dots '...'
\x20 # a space
//gx; # delete, multiple times, expanded regex
# join pairs of lines
$lv2 =~ s/\n\s*(-elv2)/ $1/g;
# now we can handle similar to LADSPA
# split on newlines
my @lv2 = split /\n/,$lv2;
# logpkg(__FILE__,__LINE__,'debug',sub{ json_out(\@lv2) });
logpkg(__FILE__,__LINE__,'trace',sub{ json_out(\@lv2) });
my $preset = eval_iam("preset-register");
my @preset = grep {! /^\s*$/ } split "\n", $preset;
logpkg(__FILE__,__LINE__,'debug',"preset-register output:\n",$preset);
my $ctrl = eval_iam("ctrl-register");
my @ctrl = grep {! /^\s*$/ } split "\n", $ctrl;
logpkg(__FILE__,__LINE__,'debug',"ctrl-register output:\n",$ctrl);
my $cop = eval_iam("cop-register");
my @cop = grep {! /^\s*$/ } split "\n", $cop;
logpkg(__FILE__,__LINE__,'debug',"cop-register output:\n",$cop);
logpkg(__FILE__,__LINE__,'debug', "found ", scalar @cop, " Ecasound chain operators");
logpkg(__FILE__,__LINE__,'debug', "found ", scalar @preset, " Ecasound presets");
logpkg(__FILE__,__LINE__,'debug', "found ", scalar @ctrl, " Ecasound controllers");
logpkg(__FILE__,__LINE__,'debug', "found ", scalar @lad, " LADSPA effects");
logpkg(__FILE__,__LINE__,'debug', "found ", scalar @lv2, " LV2 effects");
# index boundaries we need to make effects list and menus
$fx_cache->{split}->{cop}{a} = 1;
$fx_cache->{split}->{cop}{z} = @cop; # scalar
$fx_cache->{split}->{ladspa}{a} = $fx_cache->{split}->{cop}{z} + 1;
$fx_cache->{split}->{ladspa}{b} = $fx_cache->{split}->{cop}{z} + int(@lad/4);
$fx_cache->{split}->{ladspa}{c} = $fx_cache->{split}->{cop}{z} + 2*int(@lad/4);
$fx_cache->{split}->{ladspa}{d} = $fx_cache->{split}->{cop}{z} + 3*int(@lad/4);
$fx_cache->{split}->{ladspa}{z} = $fx_cache->{split}->{cop}{z} + @lad;
$fx_cache->{split}->{preset}{a} = $fx_cache->{split}->{ladspa}{z} + 1;
$fx_cache->{split}->{preset}{b} = $fx_cache->{split}->{ladspa}{z} + int(@preset/2);
$fx_cache->{split}->{preset}{z} = $fx_cache->{split}->{ladspa}{z} + @preset;
$fx_cache->{split}->{ctrl}{a} = $fx_cache->{split}->{preset}{z} + 1;
$fx_cache->{split}->{ctrl}{z} = $fx_cache->{split}->{preset}{z} + @ctrl;
$fx_cache->{split}->{lv2}{a} = $fx_cache->{split}->{ctrl}{z} + 1;
$fx_cache->{split}->{lv2}{z} = $fx_cache->{split}->{ctrl}{z} + @lv2;
my $cop_re = qr/
^(\d+) # number
\. # dot
\s+ # spaces+
(\w.+?) # name, starting with word-char, non-greedy
# (\w+) # name
,\s* # comma spaces*
-(\w+) # effect_id
:? # maybe colon (if parameters)
(.*$) # rest
/x;
my $preset_re = qr/
^(\d+) # number
\. # dot
\s+ # spaces+
(\w+) # name
,\s* # comma spaces*
-(pn:\w+) # preset_id
:? # maybe colon (if parameters)
(.*$) # rest
/x;
my $ladspa_re = qr/
^(\d+) # number
\. # dot
\s+ # spaces
(.+?) # name, any non-greedy
\s+ # spaces
-(el:[-\w]+),? # ladspa_id maybe followed by comma
(.*$) # rest
/x;
my $lv2_re = qr/
^(\d+) # number
\. # dot
\s+ # spaces
(.+?) # name, any non-greedy
\s+ # space
-(?<name> # named captured named 'name'
elv2: # prefix is -elv2:
[^,]+ # URL: non-comma chars
), # comma
(.*$) # rest
/x;
my $ctrl_re = qr/
^(\d+) # number
\. # dot
\s+ # spaces
(\w.+?) # name, starting with word-char, non-greedy
,\s* # comma, zero or more spaces
-(k\w+):? # ktrl_id maybe followed by colon
(.*$) # rest
/x;
extract_effects_data(
$fx_cache->{split}->{cop}{a},
$fx_cache->{split}->{cop}{z},
$cop_re,
q(,),
@cop,
);
extract_effects_data(
$fx_cache->{split}->{ladspa}{a},
$fx_cache->{split}->{ladspa}{z},
$ladspa_re,
q(','),
@lad,
);
extract_effects_data(
$fx_cache->{split}->{lv2}{a},
$fx_cache->{split}->{lv2}{z},
$lv2_re,
q(','),
@lv2,
);
extract_effects_data(
$fx_cache->{split}->{preset}{a},
$fx_cache->{split}->{preset}{z},
$preset_re,
q(,),
@preset,
);
extract_effects_data(
$fx_cache->{split}->{ctrl}{a},
$fx_cache->{split}->{ctrl}{z},
$ctrl_re,
q(,),
@ctrl,
);
for my $i (0..$#{$fx_cache->{registry}}){
$fx_cache->{full_label_to_index}->{ $fx_cache->{registry}->[$i]->{code} } = $i;
logpkg(__FILE__,__LINE__,'debug', "i: $i code: $fx_cache->{registry}->[$i]->{code} display: $fx_cache->{registry}->[$i]->{display}");
}
logpkg(__FILE__,__LINE__,'debug', sub{"$fx_cache->{registry}\n======\n", json_out($fx_cache->{registry})}); ;
}
sub integrate_cop_hints {
my @cop_hints = @{ yaml_in( get_data_section('ecasound_chain_operator_hints_yml')) };
for my $hashref ( @cop_hints ){
#print "cop hints ref type is: ",ref $hashref, $/;
my $code = $hashref->{code};
$fx_cache->{registry}->[ $fx_cache->{full_label_to_index}->{ $code } ] = $hashref;
}
}
sub ladspa_path {
$ENV{LADSPA_PATH} || q(/usr/lib/ladspa);
}
sub lv2_path {
$ENV{LV2_PATH} || q(/usr/lib/lv2);
}
sub get_ladspa_hints{
logsub("&get_ladspa_hints");
my @dirs = split ':', ladspa_path();
my $data = '';
my %seen = ();
my @plugins = ladspa_plugin_list();
#pager join $/, @plugins;
# use these regexes to snarf data
my $pluginre = qr/
Plugin\ Name: \s+ "([^"]+)" \s+
Plugin\ Label: \s+ "([^"]+)" \s+
Plugin\ Unique\ ID: \s+ (\d+) \s+
[^\x00]+(?=Ports) # swallow maximum up to Ports
Ports: \s+ ([^\x00]+) # swallow all
/x;
my $paramre = qr/
"([^"]+)" # name inside quotes
\s+
(.+) # rest
/x;
my $i;
for my $file (@plugins){
my @stanzas = split "\n\n", qx(analyseplugin $file);
for my $stanza (@stanzas) {
my ($plugin_name, $plugin_label, $plugin_unique_id, $ports)
= $stanza =~ /$pluginre/
or carp "*** couldn't match plugin stanza $stanza ***";
logpkg(__FILE__,__LINE__,'debug', "plugin label: $plugin_label $plugin_unique_id");
my @lines = grep{ /control/ } split "\n",$ports;
my @params; # data
my @names;
for my $p (@lines) {
next if $p =~ /^\s*$/;
$p =~ s/\.{3}/10/ if $p =~ /amplitude|gain/i;
$p =~ s/\.{3}/60/ if $p =~ /delay|decay/i;
$p =~ s(\.{3})($config->{sample_rate}/2) if $p =~ /frequency/i;
$p =~ /$paramre/;
my ($name, $rest) = ($1, $2);
my ($dir, $type, $range, $default, $hint) =
split /\s*,\s*/ , $rest, 5;
logpkg(__FILE__,__LINE__,'debug', join(
"|",$name, $dir, $type, $range, $default, $hint) );
# if $hint =~ /logarithmic/;
if ( $range =~ /toggled/i ){
$range = q(0 to 1);
$hint .= q(toggled);
}
my %p;
$p{name} = $name;
$p{dir} = $dir;
$p{hint} = $hint;
my ($beg, $end, $default_val, $resolution)
= range($name, $range, $default, $hint, $plugin_label);
$p{begin} = $beg;
$p{end} = $end;
$p{default} = $default_val;
$p{resolution} = $resolution;
push @params, { %p };
}
$plugin_label = "el:" . $plugin_label;
$fx_cache->{ladspa_help}->{$plugin_label} = $stanza;
$fx_cache->{ladspa_id_to_filename}->{$plugin_unique_id} = $file;
$fx_cache->{ladspa_label_to_unique_id}->{$plugin_label} = $plugin_unique_id;
$fx_cache->{ladspa_label_to_unique_id}->{$plugin_name} = $plugin_unique_id;
$fx_cache->{ladspa_id_to_label}->{$plugin_unique_id} = $plugin_label;
$fx_cache->{ladspa}->{$plugin_label}->{name} = $plugin_name;
$fx_cache->{ladspa}->{$plugin_label}->{id} = $plugin_unique_id;
$fx_cache->{ladspa}->{$plugin_label}->{params} = [ @params ];
$fx_cache->{ladspa}->{$plugin_label}->{count} = scalar @params;
$fx_cache->{ladspa}->{$plugin_label}->{display} = 'scale';
} # pager( join "\n======\n", @stanzas);
#last if ++$i > 10;
}
logpkg(__FILE__,__LINE__,'debug', sub{json_out($fx_cache->{ladspa})});
}
sub get_lv2_hints {
my @plugins = split " ", qx(lv2ls);
logpkg(__FILE__,__LINE__,'debug','No LV2 plugins found'), return unless @plugins;
map { $fx_cache->{lv2_help}->{"elv2:$_"} = join '', Audio::Nama::AnalyseLV2::lv2_help($_) } @plugins;
}
sub srate_val {
my $input = shift;
my $val_re = qr/(
[+-]? # optional sign
\d+ # one or more digits
(\.\d+)? # optional decimal
(e[+-]?\d+)? # optional exponent
)/ix; # case insensitive e/E
my ($val) = $input =~ /$val_re/; # or carp "no value found in input: $input\n";
$val * ( $input =~ /srate/ ? $config->{sample_rate} : 1 )
}
sub range {
my ($name, $range, $default, $hint, $plugin_label) = @_;
my $multiplier = 1;;
my ($beg, $end) = split /\s+to\s+/, $range;
$beg = srate_val( $beg );
$end = srate_val( $end );
$default = srate_val( $default );
$default = $default || $beg;
logpkg(__FILE__,__LINE__,'debug', "beg: $beg, end: $end, default: $default");
if ( $name =~ /gain|amplitude/i ){
$beg = 0.01 unless $beg;
$end = 0.01 unless $end;
}
my $resolution = ($end - $beg) / 100;
if ($hint =~ /integer|toggled/i ) { $resolution = 1; }
elsif ($hint =~ /logarithmic/ ) {
$beg = round ( log $beg ) if $beg;
$end = round ( log $end ) if $end;
$resolution = ($end - $beg) / 100;
$default = $default ? round (log $default) : $default;
}
$resolution = d2( $resolution + 0.002) if $resolution < 1 and $resolution > 0.01;
$resolution = dn ( $resolution, 3 ) if $resolution < 0.01;
$resolution = int ($resolution + 0.1) if $resolution > 1 ;
($beg, $end, $default, $resolution)
}
sub integrate_ladspa_hints {
logsub("&integrate_ladspa_hints");
map{
my $i = $fx_cache->{full_label_to_index}->{$_};
# print("$_ not found\n"),
if ($i) {
$fx_cache->{registry}->[$i]->{params} = $fx_cache->{ladspa}->{$_}->{params};
# we revise the number of parameters read in from ladspa-register
$fx_cache->{registry}->[$i]->{count} = scalar @{$fx_cache->{ladspa}->{$_}->{params}};
$fx_cache->{registry}->[$i]->{display} = $fx_cache->{ladspa}->{$_}->{display};
}
} keys %{$fx_cache->{ladspa}};
my %L;
my %M;
map { $L{$_}++ } keys %{$fx_cache->{ladspa}};
map { $M{$_}++ } grep {/el:/} keys %{$fx_cache->{full_label_to_index}};
for my $k (keys %L) {
$M{$k} or logpkg(__FILE__,__LINE__,'debug', "$k not found in ecasound listing");
}
for my $k (keys %M) {
$L{$k} or logpkg(__FILE__,__LINE__,'debug', "$k not found in ladspa listing");
}
logpkg(__FILE__,__LINE__,'debug', sub {join "\n", sort keys %{$fx_cache->{ladspa}}});
logpkg(__FILE__,__LINE__,'debug', '-' x 60);
logpkg(__FILE__,__LINE__,'debug', sub{join "\n", grep {/el:/} sort keys %{$fx_cache->{full_label_to_index}}});
#print json_out $fx_cache->{registry}; exit;
}
## generate effects help data
sub prepare_effects_help {
# presets
map{ s/^.*? //; # remove initial number
$_ .= "\n"; # add newline
my ($id) = /(pn:\w+)/; # find id
s/,/, /g; # to help line breaks
push @{$fx_cache->{user_help}}, $_; #store help
} split "\n",eval_iam("preset-register");
# LADSPA
my $label;
map{
if ( my ($_label) = /-(el:[-\w]+)/ ){
$label = $_label;
s/^\s+/ /; # trim spaces
s/'//g; # remove apostrophes
$_ .="\n"; # add newline
push @{$fx_cache->{user_help}}, $_; # store help
} else {
# replace leading number with LADSPA Unique ID
s/^\d+/$fx_cache->{ladspa_label_to_unique_id}->{$label}/;
s/\s+$/ /; # remove trailing spaces
substr($fx_cache->{user_help}->[-1],0,0) = $_; # join lines
$fx_cache->{user_help}->[-1] =~ s/,/, /g; #
$fx_cache->{user_help}->[-1] =~ s/,\s+$//;
}
} reverse split "\n",eval_iam("ladspa-register");
}
1;