/
Fx.pm
489 lines (416 loc) · 12.7 KB
/
Fx.pm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
#!/usr/bin/perl
package Fx;
use strict;
use warnings;
use feature 'state';
use Data::Dumper;
my $debug = 0;
my $export = 0;
###########################################################
#
# FX globals
#
###########################################################
state $LADSPA_PluginsList;
#build the plugin list if it doesn't exist
if (!defined $LADSPA_PluginsList) {
print "FX: Loading LADSPA plugins list\n";
$LADSPA_PluginsList = &get_LADSPA_PluginsList;
print Dumper $LADSPA_PluginsList if $debug;
}
if ($export) {
open FILE,">$ENV{HOME}/LADSPA_PluginsList.txt" or die "$!";
print FILE Dumper $LADSPA_PluginsList;
close FILE;
}
###########################################################
#
# FX OBJECT functions
#
###########################################################
sub new {
my $class = shift;
my $effect = shift;
my $midi_km = shift;
#create fx object
my $fx = {};
#add fx name/ID
$fx->{fxname} = $effect;
#create CC array if midi control is enabled
$fx->{generate_midi_CC} = $midi_km;
$fx->{CCs} = () if $midi_km;
bless $fx,$class;
#init effect
$fx->init if $effect ne "";
return $fx;
}
sub init {
my $fx = shift;
my $effect = $fx->{fxname};
# check if ecasound or LADSPA effect
if ( $fx->LADSPAfxGetControls ) {
print " | |_adding LADSPA plugin $effect\n";
}
else {
if ($fx->EcafxGetControls($effect)) {
#build default ecs effect line
my $defaults = join ',', @{$fx->{defaultvalues}};
$fx->{ecsline} = " -pn:$effect," . $defaults;
}
}
# add midi controllers ? #TODO adapt to nonmixer
$fx->Generate_eca_midi_CC if $fx->{generate_midi_CC};
}
###########################################################
#
# FX functions
#
###########################################################
###########################################################
#
# FX TEST functions
#
###########################################################
sub is_param_ok {
#grab parameter name in parameter
my $fx = shift;
my $paramtotest = shift;
#iterate through each parameters
my $nb = 0;
foreach my $param (@{$fx->{paramnames}}) {
$nb++;
#return index (starting at 1)
return $nb if $paramtotest eq $param;
}
return 0;
}
###########################################################
#
# LADSPA effect functions
#
###########################################################
sub is_LADSPA {
my $fxhash = shift;
my $fx = $fxhash->{fxname};
#build the plugin list if it doesn't exist
if (!defined $LADSPA_PluginsList) {
$LADSPA_PluginsList = &get_LADSPA_PluginsList;
}
#look for the plugin ID
return 1 if ((defined $LADSPA_PluginsList) and (exists $LADSPA_PluginsList->{$fx}));
return 0;
}
sub SanitizeLADSPAFx {
my $fxhash = shift;
my $samplerate = shift;
#get number of parameter
my @paramnames = @{$fxhash->{paramnames}};
my $nb = $#paramnames;
my @totest = ("lowvalues","highvalues","defaultvalues");
foreach my $ref (@totest) {
my @values = @{$fxhash->{$ref}};
for my $i (0..$nb) {
if ( $values[$i] =~ /\*/ ) {
my $string = $values[$i];
print " |_transforming $string into ";
$string =~ s/srate/$samplerate/;
$string =~ s/samplerate/$samplerate/;
my $result = eval $string; #calculate the value
#round to int
if ( (exists $fxhash->{type}) and ($fxhash->{type} eq "integer") ) {
use POSIX qw(ceil floor);
print "(rounded) ";
$result = floor($result);
}
print "$result\n";
$fxhash->{$ref}[$i] = $result; #update value
}
}
}
}
sub LADSPAfxGetControls {
my $fxhash = shift;
my $fx = $fxhash->{fxname};
#build the plugin list if it doesn't exist
if (!defined $LADSPA_PluginsList) {
$LADSPA_PluginsList = &get_LADSPA_PluginsList;
}
#look for the plugin ID
if (defined $LADSPA_PluginsList) {
if (exists $LADSPA_PluginsList->{$fx}) {
#fill arrays
my (@names, @defaults,@lowvals,@highvals);
my $nbcontrols = scalar keys $LADSPA_PluginsList->{$fx}{controls};
for my $control (1..$nbcontrols) {
push @names, $LADSPA_PluginsList->{$fx}{controls}{$control}{name} if exists $LADSPA_PluginsList->{$fx}{controls}{$control}{name};
push @lowvals, $LADSPA_PluginsList->{$fx}{controls}{$control}{min} if exists $LADSPA_PluginsList->{$fx}{controls}{$control}{min};
push @highvals, $LADSPA_PluginsList->{$fx}{controls}{$control}{max} if exists $LADSPA_PluginsList->{$fx}{controls}{$control}{max};
push @defaults, $LADSPA_PluginsList->{$fx}{controls}{$control}{default} if exists $LADSPA_PluginsList->{$fx}{controls}{$control}{default};
#TODO do something with the control {type}
}
#verify equal quantites of parameters
if ( grep {$_ != $#defaults} ($#lowvals, $#highvals, $#names) ) {
warn "Fx Error : incoherent number of parameters for plugin $fxhash->{fxname}";
return 0;
}
if ( grep {$_ == -1} ($#defaults, $#lowvals, $#highvals, $#names) ) {
warn "Fx Error : empty parameters for plugin $fxhash->{fxname}";
return 0;
}
#insert values
$fxhash->{name} = $LADSPA_PluginsList->{$fx}{name};
push( @{$fxhash->{paramnames}} ,@names);
push( @{$fxhash->{defaultvalues}} ,@defaults);
push( @{$fxhash->{lowvalues}} ,@lowvals);
push( @{$fxhash->{highvalues}} ,@highvals);
$fxhash->{audio_io} = $LADSPA_PluginsList->{$fx}{audio_io};
return 1;
}
}
return 0;
}
sub get_LADSPA_PluginsList {
#look for the plugins in installed dirs
my @stdout = `listplugins`;
my %PluginsFileList;
#check if a plugin was found
if (@stdout) {
foreach my $line (@stdout) {
chomp $line; #remove \n
next unless ($line =~ /^\//g);
#new plugin file
chop($line); #remove trailing :
print "---PluginFile: $line\n" if $debug;
#query the plugin file for its plugins
my $stdout = `analyseplugin $line`;
my @pl = split(/\n{2,}/, $stdout);
# print "pluginfile $file has $#pl plugins\n";
foreach my $plugininfo (@pl) {
chomp($plugininfo);
# print "-----------\n";
# print $plugininfo,"\n";
next unless $plugininfo; #return on empty line
# Plugin Name: "C* Eq2x2 - Stereo 10-band equalizer"
# Plugin Label: "Eq2x2"
# Plugin Unique ID: 2594
# Maker: "Tim Goetze <tim@quitte.de>"
# Copyright: "2004-7"
# Must Run Real-Time: No
# Has activate() Function: Yes
# Has deactivate() Function: No
# Has run_adding() Function: Yes
# Environment: Normal or Hard Real-Time
# Ports: "in.l" input, audio, -1 to 1
# "in.r" input, audio, -1 to 1
# "31 Hz" input, control, -48 to 24, default 0
# "63 Hz" input, control, -48 to 24, default 0
# "125 Hz" input, control, -48 to 24, default 0
# "250 Hz" input, control, -48 to 24, default 0
# "500 Hz" input, control, -48 to 24, default 0
# "1 kHz" input, control, -48 to 24, default 0
# "2 kHz" input, control, -48 to 24, default 0
# "4 kHz" input, control, -48 to 24, default 0
# "8 kHz" input, control, -48 to 24, default 0
# "16 kHz" input, control, -48 to 24, default 0
# "out.l" output, audio
# "out.r" output, audio
#get plugin info
my ($Name) = $plugininfo =~ /Plugin Name: "(.*)"/;
my ($Label) = $plugininfo =~ /Plugin Label: "(.*)"/;
my ($ID) = $plugininfo =~ /Plugin Unique ID: (\d+)/;
my ($Ports) = $plugininfo =~ /Ports: (.+)/sx;
#get plugin controls
my @controls = split /\n/ , $Ports;
my $controls_hash = parse_controls(\@controls);
my $audio_hash = parse_audio_io(\@controls);
#update structure
$PluginsFileList{$ID}{name} = $Name;
$PluginsFileList{$ID}{label} = $Label;
$PluginsFileList{$ID}{controls} = $controls_hash;
$PluginsFileList{$ID}{audio_io} = $audio_hash;
$PluginsFileList{$ID}{file} = $line;
}
}
}
else { die "Error : no plugin found, or comamnd error \n"; }
print Dumper \%PluginsFileList if $debug;
return \%PluginsFileList;
}
sub parse_controls {
my $rawcontrols = shift;
my %controls;
my $nb = 1;
foreach my $line (@{$rawcontrols}) {
#ignore audio control definition
next if (( $line =~ /input, audio/ ) or ( $line =~ /output, audio/ ));
$line =~ s/\t//; #remove tab
my ($name , $min, $max , $default ) = $line =~ /"(.*)" input, control, (.*) to (.*), default (.*)/;
#some plugins may have bad formatting or missing info, return empty if we don't have every info
next unless defined $name;
#update hash
$controls{$nb}{name} = $name;
$controls{$nb}{min} = $min;
$controls{$nb}{max} = $max;
#default may contain more info (format like integer, or logaritmic)
if ($default =~ /,/) {
my ($def,$plus) = $default =~ /(.*), (.*)/;
$controls{$nb}{default} = $def;
$controls{$nb}{type} = $plus;
}
else {
$controls{$nb}{default} = $default;
}
#increment number
$nb++;
}
return \%controls;
}
sub parse_audio_io {
my $rawcontrols = shift;
my %controls;
my $inputs = 0;
my $outputs = 0;
foreach my $line (@{$rawcontrols}) {
#only audio control definition
$inputs++ if ( $line =~ /input, audio/ );
$outputs++ if ( $line =~ /output, audio/ );
}
$controls{inputs} = $inputs;
$controls{outputs} = $outputs;
return \%controls;
}
###########################################################
#
# ECASOUND effect functions
#
###########################################################
sub EcafxGetControls {
my $fx = shift;
my $plugin = shift;
return 0 if !$plugin;
#open effect file
my $file;
my $string = '';
my $filepath = $ENV{'ECA_CFG_PATH'}."/effect_presets";
if (!-e $filepath) {
warn "Fx warning: could not acess project specific ecasound effects file\n";
#try the user home ecasound folder
$filepath = $ENV{HOME}."/.ecasound/effect_presets";
}
if (!-e $filepath) {
warn "Fx Error: can't open user ecasound effect preset files\n";
return 0;
}
#continue with found file
open($file, "<", $filepath);
#get the effect parameters string
my $found =0;
my $tic = 0;
while (<$file>) {
if ( $tic == 1 ) {
$string = $string . $_; #print $string,"\n";
last if $_ !~ /\\$/; #print "notlast\n";
}
if (( /^$plugin\b/ ) && ( $tic eq 0) ) {
$found = 1; #print "found : ",$_,"\n";
$tic = 1 if $_ =~ /\\$/; #print "tic=",$tic,"\n";
$string = $_;
}
}
#close file
close($file) || warn "close failed: $!";
if ($found eq 0) {
warn "Plugin $plugin not found\n";
return 0;
}
my $paramnames = '';
my $defaultvalues = '';
my $lowvalues = '';
my $highvalues = '';
my @params = split("\n",$string);
foreach (@params) {
my $temp = $_;
$paramnames = $temp if ($temp =~ /^-ppn/);
$paramnames =~ s/-ppn:|\\$// if $paramnames;
$paramnames =~ s/\s$// if $paramnames;
$defaultvalues = $temp if ($temp =~ /^-ppd/);
$defaultvalues =~ s/-ppd:|\\$// if $defaultvalues;
$defaultvalues =~ s/\s$// if $defaultvalues;
$lowvalues = $temp if ($temp =~ /^-ppl/);
$lowvalues =~ s/-ppl:|\\$// if $lowvalues;
$lowvalues =~ s/\s$// if $lowvalues;
$highvalues = $temp if ($temp =~ /^-ppu/);
$highvalues =~ s/-ppu:|\\$// if $highvalues;
$highvalues =~ s/\s$// if $highvalues;
}
if ($debug) {
print "params : $paramnames\n";
print "default: $defaultvalues\n";
print "lowval : $lowvalues\n";
print "highval: $highvalues\n";
}
my @names = split(",",$paramnames);
my @defaults = split(",",$defaultvalues);
my @lowvals = split(",",$lowvalues);
my @highvals = split(",",$highvalues);
#verify equal quantites of parameters
if ( grep {$_ != $#defaults} ($#lowvals, $#highvals, $#names) ) {
warn "Error : incoherent number of parameters";
return 0;
}
if ( grep {$_ == -1} ($#defaults, $#lowvals, $#highvals, $#names) ) {
warn "Error : empty parameters";
return 0;
}
#insert values
push( @{$fx->{paramnames}} ,@names);
push( @{$fx->{defaultvalues}} ,@defaults);
push( @{$fx->{lowvalues}} ,@lowvals);
push( @{$fx->{highvalues}} ,@highvals);
print Dumper $fx if $debug;
return 1;
}
sub Generate_eca_midi_CC {
#grab plugin name in parameter
my $fx = shift;
my $plugin = shift;
return 0 unless exists $fx->{lowvalues};
return 0 unless exists $fx->{highvalues};
my @lows = @{$fx->{lowvalues}};
my @highs = @{$fx->{highvalues}};
#iterate through each parameters
my $nb =1;
foreach my $param (@{$fx->{paramnames}}) {
#get mim/max parameter range, and new unique CC/channel
my ($CC,$channel) = &getnextCC();
my $low = (shift @lows);
my $high = (shift @highs);
$fx->{ecsline} .= " -km:" . $nb++ . ",$low,$high,$CC,$channel";
#push channel and CC values
push (@{$fx->{CCs}},join(',',($CC,$channel)));
}
#remove trailing whitespace
$fx->{ecsline} =~ s/\s+$//;
return 1;
}
###########################################################
#
# MIDI functions
#
###########################################################
sub getnextCC {
state $channel = 1;
state $CC = 0;
#verify end of midi CC range
die "CC max range error!!\n" if (($CC eq 127) and ($channel eq 16));
#CC range from 1 to 127, update channel if needed
if ($CC == 127) {
$CC = 0;
$channel++;
}
#increment CC number
$CC++;
#return values
return($CC,$channel);
}
1;