├── src ├── ui ├── mui ├── dist ├── mtest ├── emit_logging_categories ├── list_all_subs ├── make_stubs ├── makeman ├── missing_files_list ├── strip_comments ├── engine_fields ├── effect_fields ├── var_pronouns ├── insert_fields ├── var_map_gen ├── strip_all ├── var_singletons ├── 11_mark.t ├── TrackWaveform.p ├── build ├── var_serialize ├── generate_executable_stub ├── banner ├── 06_latency.t ├── list_subs ├── termkey-keys ├── 04_object.t ├── crossover-alsa.te ├── stereo51.te ├── myproc ├── WavModify.p ├── Lat.p ├── TrackLatency.p ├── hotkey_grammar.pl ├── BusUtil.p ├── io_fields ├── EngineSetup.p ├── customize.pl ├── effect_chain_fields ├── effect_chain_attributes ├── list_calls ├── Regions.p ├── var_overview ├── palette.json ├── var_lists ├── Graphical.p ├── check_hash_keys ├── fake_jack_latency ├── StatusSnapshot.p ├── EffectNickname.p ├── Memoize.p ├── Custom.p ├── midish_commands ├── tempo_map ├── Text.p ├── 01_symbols.t ├── 02_assign.t ├── track_fields ├── crossover.nms ├── Wavinfo.p ├── Bunch.p ├── TrackRegion.p ├── TrackComment.p ├── stereo51.nms ├── fake_jack_lsp ├── escape_codes ├── Object.p ├── Options.p ├── MuteSoloFade.p ├── 14_latency.t_off ├── Globals.p ├── TrackEffect.p ├── man_page_part2 ├── Mix.p ├── Modes.p ├── Refresh_subs.pl ├── Log.p ├── Wav.p ├── preproc ├── var_namarc ├── emit_command_headers ├── Contents ├── Waveform.p ├── Help.p ├── TrackUtils.p ├── EcasoundCleanup.p ├── Midi.p ├── Util.p ├── namarc ├── Sequence.p ├── Config.p ├── Nama.p ├── EcasoundRun.p └── Git.p ├── MANIFEST.SKIP ├── Build.PL ├── BUILD ├── MANIFEST ├── README └── Changes /src/ui: -------------------------------------------------------------------------------- 1 | ../bin/nama -------------------------------------------------------------------------------- /src/mui: -------------------------------------------------------------------------------- 1 | ./myproc;./ui $1 $2 $3 $4 $5 $6 2 | -------------------------------------------------------------------------------- /src/dist: -------------------------------------------------------------------------------- 1 | cd $MD; ./Build.PL && ./Build test && ./Build dist 2 | -------------------------------------------------------------------------------- /src/mtest: -------------------------------------------------------------------------------- 1 | ./myproc; cd .. ;src/build; ./Build.PL; ./Build test 2 | 3 | -------------------------------------------------------------------------------- /src/emit_logging_categories: -------------------------------------------------------------------------------- 1 | ls *.p | perl -pe 's/\.p$//; s/^/Audio::Nama::/' 2 | -------------------------------------------------------------------------------- /src/list_all_subs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | my @all = qx( ./list_subs `cat CODE_MANIFEST` ); 3 | print @all; 4 | 5 | -------------------------------------------------------------------------------- /src/make_stubs: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | ./list_subs $1 | perl -ne 'chomp; next if $_ eq "new"; print "sub $_ { UI:\:$_\() }", $/' 3 | -------------------------------------------------------------------------------- /src/makeman: -------------------------------------------------------------------------------- 1 | pod2man --section=1 ../bin/nama nama.1 --name=nama 2 | pod2html --title="nama(1)" --infile=../bin/nama --outfile=nama.html 3 | -------------------------------------------------------------------------------- /src/missing_files_list: -------------------------------------------------------------------------------- 1 | grep '\[\%' *p *pl | perl -nE 'm(\.\/([\w\.]+)) and say $1' | perl -nE 'chomp; say qq(INCLUDE file "$_" not found) if ! -e $_' 2 | -------------------------------------------------------------------------------- /src/strip_comments: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use warnings; 3 | while(<>){ s/#([^!].*|$)//gm; print} 4 | 5 | # pound followed by newline or something not bang 6 | -------------------------------------------------------------------------------- /src/engine_fields: -------------------------------------------------------------------------------- 1 | name # name of the engine 2 | port # tcp port for listening 3 | jack_seek_delay # obsolete? 4 | jack_transport_mode 5 | events 6 | socket 7 | pids 8 | ecasound 9 | buffersize 10 | ready 11 | -------------------------------------------------------------------------------- /src/effect_fields: -------------------------------------------------------------------------------- 1 | id 2 | type 3 | chain 4 | class 5 | params 6 | params_log 7 | display 8 | parent 9 | owns 10 | bypassed 11 | name 12 | surname 13 | predecessor 14 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | blib/* 2 | MANIFEST.bak 3 | MANIFEST.SKIP 4 | README.html 5 | Makefile.old 6 | lib/Audio/makeman 7 | lib/Audio/nama* 8 | Audio-Nama-* 9 | try/* 10 | .git/* 11 | src/* 12 | ^MYMETA\.yml$ 13 | ^MYMETA\.json$ 14 | -------------------------------------------------------------------------------- /src/var_pronouns: -------------------------------------------------------------------------------- 1 | $this_track 2 | $this_bus 3 | $this_bus_o 4 | $this_mark 5 | $this_edit 6 | $this_sequence 7 | $this_engine 8 | $this_user 9 | $prompt 10 | %tn 11 | %ti 12 | %bn 13 | %mn 14 | %en 15 | %fi 16 | $g 17 | $debug 18 | $debug2 19 | $quiet 20 | REC 21 | MON 22 | PLAY 23 | OFF 24 | -------------------------------------------------------------------------------- /src/insert_fields: -------------------------------------------------------------------------------- 1 | n # index 2 | class 3 | send_type 4 | send_id 5 | return_type 6 | return_id 7 | wet_track # obsolete, use method wet_name 8 | dry_track # obsolete, use method dry_name 9 | tracks # obsolete 10 | track # insert applies to this track 11 | wetness # 0 to 100 12 | wet_vol # effect id 13 | dry_vol # effect id 14 | -------------------------------------------------------------------------------- /src/var_map_gen: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use Modern::Perl; 3 | use File::Slurp; 4 | print join $/, 5 | #map { split " ", $_ } # store as key/value pairs 6 | grep { my @var = split " ", $_; @var == 2 } # take only substitutions 7 | grep{ ! /^\s*$/ } # skip blank lines 8 | map{ s/#.*$//; $_} # remove comments 9 | split "\n", read_file("./var_namarc"); 10 | -------------------------------------------------------------------------------- /src/strip_all: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use File::Slurp; 3 | my @files = @ARGV; 4 | map{ print strip_all(my $string = read_file($_)) } @files; 5 | sub strip_all{ strip_blank_lines( strip_comments(@_) ) } 6 | 7 | sub strip_blank_lines { 8 | map{ s/\n(\s*\n)+/\n/sg } @_; 9 | @_; 10 | 11 | } 12 | 13 | sub strip_comments { # 14 | map{ s/#.*$//mg; } @_; 15 | @_ 16 | } 17 | -------------------------------------------------------------------------------- /src/var_singletons: -------------------------------------------------------------------------------- 1 | $ui 2 | $mode 3 | $file 4 | $graph 5 | $setup 6 | # minimally initiated, a new chain setup will overwrite some 7 | # fields 8 | # used for status snapshots and last_rec_track lists that 9 | # require continuity over several setups. 10 | $config 11 | $jack 12 | $fx 13 | $fx_cache 14 | $text 15 | $term 16 | $gui 17 | $midi 18 | $help 19 | $mastering 20 | $project 21 | -------------------------------------------------------------------------------- /src/11_mark.t: -------------------------------------------------------------------------------- 1 | use Test2::Bundle::More; 2 | use strict; 3 | use ::Mark; 4 | $ENV{NAMA_VERBOSE_TEST_OUTPUT} and diag ("TESTING $0\n"); 5 | my $mark = ::Mark->new( name => 'thebeginning'); 6 | 7 | 8 | is( ref $mark , '::Mark', "Object creation"); 9 | $mark->set_attrib( "gabble", "babble"); 10 | is( $mark->attrib("gabble"), 'babble', "attribute store and read"); 11 | is( $mark->gabble, 'babble', "access attribute as method"); 12 | 13 | done_testing(); 14 | __END__ 15 | 16 | -------------------------------------------------------------------------------- /src/TrackWaveform.p: -------------------------------------------------------------------------------- 1 | package ::TrackWaveform; 2 | use ::Globals qw($project $config $gui %ti); 3 | use Modern::Perl '2020'; 4 | use Role::Tiny; 5 | use Try::Tiny; 6 | 7 | sub waveform { 8 | my $self = shift; 9 | ::Waveform->new( project => $self->project, 10 | wav => $self->current_wav, 11 | start => $self->region_start_time, 12 | end => $self->region_end_time, 13 | track => $self, 14 | ); 15 | } 16 | 17 | 18 | 1 # obligatory 19 | 20 | __END__ 21 | -------------------------------------------------------------------------------- /src/build: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # if the executable contains 'src', then we assume top-level 3 | IS_TOP_LEVEL=`echo $0 | grep src`; 4 | if [ $IS_TOP_LEVEL ]; then 5 | cd src 6 | fi 7 | ./myproc 8 | cd .. 9 | ./Build.PL 10 | echo "Now you can go to the nama toplevel directory and type:" 11 | echo "\t./Build test" 12 | echo "If you're happy with the result you can do:" 13 | echo "\t./Build install" 14 | echo "****************************************" 15 | if [ ! $IS_TOP_LEVEL ]; then 16 | cd src 17 | fi 18 | -------------------------------------------------------------------------------- /src/var_serialize: -------------------------------------------------------------------------------- 1 | @tracks_data 2 | @bus_data 3 | @groups_data 4 | @marks_data 5 | @fade_data 6 | @edit_data 7 | @inserts_data 8 | @effects_data 9 | @global_effect_chain_vars 10 | @global_effect_chain_data 11 | @project_effect_chain_data 12 | $this_track_name 13 | 14 | # these variables get written into track objects 15 | # on project load, then separated out on 16 | # project save, so that the data can 17 | # be kepts out of VCS 18 | 19 | %track_comments 20 | %track_version_comments 21 | 22 | @tracked_vars 23 | @persistent_vars 24 | -------------------------------------------------------------------------------- /src/generate_executable_stub: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use Modern::Perl; 3 | use File::Slurp; 4 | use autodie; 5 | 6 | my $script_dir = '../bin'; 7 | mkdir $script_dir unless -d $script_dir; 8 | my $script = "$script_dir/nama"; 9 | my $exec = <new(4,8); 6 | my $lat2 = ::Lat->new(16,32); 7 | 8 | is(ref $lat, '::Lat', "Latency object instantiation"); 9 | is("$lat","4 8","Stringify object"); 10 | is($lat->min, 4, "Min latency accessor"); 11 | is_deeply( $lat->add_latency($lat2), ::Lat->new(20,40), "Latency addition"); 12 | is_deeply( ::Lat->new(20,40), ($lat + $lat2), "Latency addition, overloading '+' operator"); 13 | is(do{ eval {::Lat->new(1,0)}; defined $@}, 1, "Exception on Max greater than Min"); 14 | 15 | done_testing(); 16 | __END__ 17 | -------------------------------------------------------------------------------- /src/list_subs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use File::Slurp; 3 | #$debug = 1; 4 | my %subs; 5 | while (my $source = shift @ARGV){ 6 | my @lines = read_file($source); 7 | $debug and print "lines: ". scalar @lines, $/; 8 | my $sub_re = qr/^sub\s+(\w+)\s*\{/; 9 | @subs = map{ /$sub_re/ and $1 } grep {/$sub_re/} @lines; 10 | $debug and print "subs:". scalar @subs, $/; 11 | # print join ($/, @subs), $/; 12 | #my $text = join '', @lines; 13 | #map {$text =~ s/(\s$_)\s*;/$1();/gx } @subs; 14 | #print $text; 15 | @subs{@subs} = 1..scalar @subs; 16 | } 17 | my @subs = sort keys %subs; 18 | $debug and print "subs:". scalar @subs, $/; 19 | print join $/, @subs; 20 | -------------------------------------------------------------------------------- /src/termkey-keys: -------------------------------------------------------------------------------- 1 | NONE 2 | Backspace 3 | Tab 4 | Enter 5 | Escape 6 | Space 7 | DEL 8 | Up 9 | Down 10 | Left 11 | Right 12 | Begin 13 | Find 14 | Insert 15 | Delete 16 | Select 17 | PageUp 18 | PageDown 19 | Home 20 | End 21 | Cancel 22 | Clear 23 | Close 24 | Command 25 | Copy 26 | Exit 27 | Help 28 | Mark 29 | Message 30 | Move 31 | Open 32 | Options 33 | Print 34 | Redo 35 | Reference 36 | Refresh 37 | Replace 38 | Restart 39 | Resume 40 | Save 41 | Suspend 42 | Undo 43 | KP0 44 | KP1 45 | KP2 46 | KP3 47 | KP4 48 | KP5 49 | KP6 50 | KP7 51 | KP8 52 | KP9 53 | KPEnter 54 | KPPlus 55 | KPMinus 56 | KPMult 57 | KPDiv 58 | KPComma 59 | KPPeriod 60 | KPEquals 61 | -------------------------------------------------------------------------------- /src/04_object.t: -------------------------------------------------------------------------------- 1 | use Test2::Bundle::More; 2 | use strict; 3 | 4 | $ENV{NAMA_VERBOSE_TEST_OUTPUT} and diag ("TESTING $0\n"); 5 | $ENV{NAMA_VERBOSE_TEST_OUTPUT} and diag "testing trivial class Apple"; 6 | package Apple; 7 | our @ISA; 8 | use ::Object qw(color); 9 | 10 | package main; 11 | 12 | my $apple = Apple->new(color => 'green'); 13 | 14 | is( ref $apple, 'Apple', "instantiation") ; 15 | 16 | is( $apple->color, 'green', "accessor" ); 17 | 18 | $apple->set( color => 'red' ); 19 | 20 | is( $apple->color, 'red', "mutator" ); 21 | 22 | #$apple->color = 'blue'; 23 | 24 | #is( $apple->color, 'blue', "lvalue" ); 25 | 26 | done_testing() 27 | 28 | __END__ 29 | -------------------------------------------------------------------------------- /src/crossover-alsa.te: -------------------------------------------------------------------------------- 1 | # ecasound chainsetup file 2 | 3 | # general 4 | 5 | -z:mixmode,sum -G:jack,Nama,send -G:jack,NamaEcasound, -b 256 -z:db,100000 -z:nointbuf 6 | 7 | # audio inputs 8 | 9 | -a:3 -i:alsa,default 10 | -a:4,5,6,7 -i:loop,pre1_out 11 | -a:8,9 -i:loop,pre2_out 12 | 13 | # post-input processing 14 | 15 | -a:3 16 | -a:5 -chmove:3,2 17 | -a:6 -chmove:3,1 18 | -a:7 -chmove:4,1 -chmove:5,2 19 | 20 | # pre-output processing 21 | 22 | -a:6 -chmove:1,7 23 | -a:7 -chmove:2,10 -chmove:1,9 24 | -a:8 -chmove:2,4 -chmove:1,3 25 | -a:9 -chmove:2,6 -chmove:1,5 26 | 27 | # audio outputs 28 | 29 | -a:3 -o:loop,pre1_out 30 | -a:4 -o:loop,pre2_out 31 | -a:5,6,7,8,9 -o:alsa,default 32 | -------------------------------------------------------------------------------- /src/stereo51.te: -------------------------------------------------------------------------------- 1 | # ecasound chainsetup file 2 | 3 | # general 4 | 5 | -z:mixmode,sum -G:jack,Nama,send -G:jack,NamaEcasound, -b 256 -z:db,100000 -z:nointbuf 6 | 7 | # audio inputs 8 | 9 | -a:1 -i:loop,Main_in 10 | -a:10 -i:loop,R-L_in 11 | -a:11,12 -i:loop,R-L_out 12 | -a:3 -i:alsa,default 13 | -a:4,5,6,7,8,9 -i:loop,Stereo_out 14 | 15 | # post-input processing 16 | 17 | -a:3 18 | -a:6 -chmix:3 19 | -a:7 -chmix:4 20 | -a:8 -chmute:2 21 | -a:9 -chmute:1 22 | -a:10 -chmix:1 23 | -a:11 -chmove:1,5 24 | 25 | # pre-output processing 26 | 27 | -a:12 -chmove:1,6 28 | 29 | # audio outputs 30 | 31 | -a:1 -o:alsa,default 32 | -a:10 -o:loop,R-L_out 33 | -a:3 -o:loop,Stereo_out 34 | -a:4,5,6,7,11,12 -o:loop,Main_in 35 | -a:8,9 -o:loop,R-L_in 36 | -------------------------------------------------------------------------------- /src/myproc: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # use -d for debugging output 3 | 4 | # change to build directory nama/src 5 | 6 | CUR_DIR=`dirname $0` 7 | cd "$CUR_DIR" 8 | 9 | ./check_hash_keys 10 | 11 | MD=.. 12 | LIBPATH=$MD/lib/Audio/Nama 13 | LD=$MD/lib 14 | TD=$MD/t 15 | SD=$MD/bin 16 | 17 | ./missing_files_list 18 | 19 | echo "Cleaning output directories" 20 | for d in $LD $SD; do rm -rf $d; mkdir -p $d; done 21 | rm $TD/*.t 22 | mkdir -p $LIBPATH 23 | 24 | DEBUG=$1 25 | ./preproc $DEBUG -r Audio::Nama \ 26 | -s $MD/src \ 27 | -t $LIBPATH \ 28 | -a p \ 29 | -b pm 30 | mv $LIBPATH/Nama.pm $LIBPATH/../Nama.pm 31 | ./preproc $DEBUG -s $MD/src \ 32 | -t $MD/t \ 33 | -r Audio::Nama \ 34 | -a t \ 35 | -b t 36 | ./generate_executable_stub 37 | ./makeman 38 | rm *.tmp 39 | -------------------------------------------------------------------------------- /src/WavModify.p: -------------------------------------------------------------------------------- 1 | package ::WavModify; 2 | use Role::Tiny; 3 | use Modern::Perl '2020'; 4 | use ::Globals qw(PLAY); 5 | 6 | sub normalize { 7 | my $track = shift; 8 | if ($track->rec_status ne PLAY){ 9 | ::throw($track->name, ": You must set track to PLAY before normalizing, skipping.\n"); 10 | return; 11 | } 12 | # track version will exist if PLAY status 13 | my $cmd = 'ecanormalize '; 14 | $cmd .= $track->full_path; 15 | ::pager("executing: $cmd\n"); 16 | system $cmd; 17 | } 18 | sub fixdc { 19 | my $track = shift; 20 | if ($track->rec_status ne PLAY){ 21 | ::throw($track->name, ": You must set track to PLAY before fixing dc level, skipping.\n"); 22 | return; 23 | } 24 | 25 | my $cmd = 'ecafixdc '; 26 | $cmd .= $track->full_path; 27 | ::pager("executing: $cmd\n"); 28 | system $cmd; 29 | } 30 | 1; 31 | -------------------------------------------------------------------------------- /src/Lat.p: -------------------------------------------------------------------------------- 1 | package ::Lat; 2 | use Modern::Perl '2020'; 3 | our $VERSION = 1.0; 4 | our @ISA; 5 | use Data::Dumper::Concise; 6 | use overload '+' => \&add_latency, 7 | "\"\"" => sub { join ' ',$_[0]->min, $_[0]->max }; 8 | sub new { 9 | my $class = shift; 10 | my ($min, $max) = @_; 11 | defined $min and defined $max or die "undefined field: min: $min or max; $max"; 12 | die "Lat object has Min ($min) greater than Max ($max)" if $min > $max; 13 | my $self = bless [$min, $max], $class; 14 | $self; 15 | } 16 | sub add_latency { 17 | my (@latencies) = @_[0,1]; # throw away swap argument 18 | my ($min, $max) = (0,0); 19 | map{ $min += $_->min; $max += $_->max } @latencies; 20 | ::Lat->new($min, $max); 21 | } 22 | sub min {$_[0]->[0] } 23 | sub max {$_[0]->[1] } 24 | sub values { $_[0]->min, $_[0]->max } 25 | 26 | 1; 27 | __END__ 28 | 29 | -------------------------------------------------------------------------------- /src/TrackLatency.p: -------------------------------------------------------------------------------- 1 | package ::TrackLatency; 2 | use Role::Tiny; 3 | use Modern::Perl '2020'; 4 | our $VERSION = 1.0; 5 | use ::Globals qw($setup); 6 | 7 | sub latency_offset { 8 | my $track = shift; 9 | no warnings 'uninitialized'; 10 | $setup->{latency}->{sibling}->{$track->name} 11 | - $setup->{latency}->{track}->{$track->name}->{total}; 12 | } 13 | 14 | sub capture_latency { 15 | my $track = shift; 16 | my $io = $track->input_object; 17 | return $io->capture_latency if ref $io; 18 | } 19 | sub playback_latency { 20 | my $track = shift; 21 | my $io = $track->input_object; 22 | return $io->playback_latency if ref $io; 23 | } 24 | sub sibling_latency { 25 | my $track = shift; 26 | $setup->{latency}->{sibling}->{$track->name} 27 | } 28 | sub sibling_count { 29 | my $track = shift; 30 | $setup->{latency}->{sibling_count}->{$track->name} 31 | } 32 | 33 | 1; 34 | -------------------------------------------------------------------------------- /src/hotkey_grammar.pl: -------------------------------------------------------------------------------- 1 | command: set_current_effect 2 | command: set_stepsize 3 | command: set_jumpsize 4 | command: set_parameter 5 | command: cancel 6 | cancel: /.+Escape/ 7 | foo: /./ 8 | set_current_effect: 'f' effect_id 'Enter' {::set_current_op($item{effect_id}) } 9 | set_hotkey_mode: 'o' hotkey_mode { $::mode->{hotkey_mode} = $item{hotkey_mode} } 10 | hotkey_mode: /[jmp]/ 11 | effect_id: lower_case_effect_id { $return = uc $item{lower_case_effect_id} } 12 | lower_case_effect_id: /[a-z]+/ 13 | set_stepsize: 'm' digit { ::set_stepsize( $item{digit}) } 14 | set_stepsize: 'm-' digit { ::set_stepsize(-$item{digit}) } 15 | set_parameter: '=' value 'Enter' { ::set_stepsize( $item{value}) } 16 | set_jumpsize: 't' value 'Enter' {$::config->{hotkey_playback_jumpsize_seconds} = $item{value}} 17 | digit: /\d/ 18 | value: /[+-]?([\d_]+(\.\d*)?|\.\d+)([eE][+-]?\d+)?/ 19 | -------------------------------------------------------------------------------- /src/BusUtil.p: -------------------------------------------------------------------------------- 1 | { 2 | package ::BusUtil; 3 | use Role::Tiny; 4 | use Modern::Perl '2020'; 5 | our $VERSION = 1.0; 6 | use ::Globals qw(%tn %bn PLAY OFF MON); 7 | 8 | sub version_has_edits { 9 | my ($track) = @_; 10 | grep 11 | { $_->host_track eq $track->name 12 | and $_->host_version == $track->playback_version 13 | } values %::Edit::by_name; 14 | } 15 | sub bus_tree { # for solo function to work in sub buses 16 | my $track = shift; 17 | my $mix = $track->group; 18 | return if $mix eq 'Main'; 19 | ($mix, $tn{$mix}->bus_tree); 20 | } 21 | 22 | sub activate_bus { 23 | my $track = shift; 24 | ::add_bus($track->name) unless $track->is_system_track; 25 | } 26 | sub is_mixer { 27 | my $track = shift; 28 | my $type = $track->{source_type}; 29 | return unless defined $type and $type eq 'bus'; 30 | my $id = $track->{source_id}; 31 | my $bus = $bn{$id}; 32 | $bus 33 | } 34 | } 35 | 1; 36 | 37 | 38 | -------------------------------------------------------------------------------- /src/io_fields: -------------------------------------------------------------------------------- 1 | # Fields for IO objects 2 | 3 | # These fields are commonly assigned by the dispatch() routine 4 | # that processes graph edges 5 | 6 | track # originating track name 7 | chain_id # -a: argument 8 | endpoint # graph node name, for routing to loop devices 9 | 10 | # The following fields can be assigned to override defaults for 11 | # for special cases 12 | 13 | format 14 | format_template 15 | 16 | # argument for signal_format(), eg s16_le,N,44100,i 17 | #output_width# ditto, provides the 'N' for above, overriding track value 18 | 19 | width 20 | ecs_extra # post_input or pre_output operators 21 | 22 | direction # needed only for IO::any 23 | device_id # needed only for IO::any 24 | 25 | # The following fields will come from the associated track via AUTOLOAD 26 | 27 | # full_path 28 | # width # no. of channels 29 | # mono_to_stereo 30 | # rec_route 31 | # playat_output 32 | # select_output 33 | # modifiers 34 | -------------------------------------------------------------------------------- /src/EngineSetup.p: -------------------------------------------------------------------------------- 1 | # ----------- Engine Setup and Teardown ----------- 2 | 3 | package ::; 4 | use Modern::Perl '2020'; use Carp; 5 | 6 | sub reconfigure_engine { 7 | 8 | logsub((caller(0))[3]); 9 | 10 | # skip if command line option is set 11 | 12 | return if $config->{opts}->{R}; 13 | refresh_wav_cache(); 14 | update_jack_client_list(); 15 | refresh_tempo_map() if $config->{use_metronome}; 16 | project_snapshot(); 17 | ::Engine::sync_action('configure'); 18 | } 19 | 20 | sub request_setup { 21 | my ($package, $filename, $line) = caller(); 22 | logpkg('debug',"reconfigure requested in file $filename:$line"); 23 | $setup->{changed}++ 24 | } 25 | 26 | sub generate_setup {::Engine::sync_action('setup') } 27 | 28 | sub start_transport { 29 | logsub((caller(0))[3]); 30 | ::Engine::sync_action('start'); 31 | 32 | } 33 | 34 | sub stop_transport { 35 | 36 | logsub((caller(0))[3]); 37 | ::Engine::sync_action('stop'); 38 | } 39 | 40 | 1; 41 | __END__ 42 | -------------------------------------------------------------------------------- /src/customize.pl: -------------------------------------------------------------------------------- 1 | ### customize.pl - user code 2 | 3 | # test this by typing: 4 | # 5 | # perl customize.pl 6 | # 7 | # or, if you are running from your build directory, e.g. 8 | # 9 | # perl -I ~/build/nama/lib customize.pl 10 | 11 | use Modern::Perl '2020'; 12 | use Audio::Nama::Globals qw(:all); 13 | 14 | my @user_customization = ( 15 | 16 | prompt => sub { 17 | no warnings 'uninitialized'; 18 | join ' ', 'nama', git_branch_display(), bus_track_display(), '> ' 19 | }, 20 | 21 | ## user defined commands 22 | 23 | commands => 24 | { 25 | # usage: greet 26 | greet => sub { 27 | my ($name,$adjective) = @_; 28 | pager("Hello $name! You look $adjective today!!"); 29 | }, 30 | disable_jack_polling => sub{ $project->{events}->{poll_jack} = undef }, 31 | 32 | promote_current_version => sub { 33 | my $v = $this_track->playback_version; 34 | promote_version_to_track($this_track, $v); 35 | }, 36 | 37 | }, 38 | 39 | ); 40 | -------------------------------------------------------------------------------- /src/effect_chain_fields: -------------------------------------------------------------------------------- 1 | 2 | 3 | ########### EffectChain fields ############ 4 | 5 | ### Group 1 - core functionality 6 | 7 | n # index 8 | 9 | ops_list # list of effect ids (may include controllers) 10 | # constructor argument, but not part 11 | # of constructed object 12 | 13 | ops_data # effect data, can be generated from 14 | # ops_list 15 | 16 | inserts_data # we need to build something special from this 17 | # + can contain pre and post-fader inserts 18 | # + we need an additional two effect chains 19 | # for each insert to hold effects on wet or dry arm 20 | # maybe wet_effect_chain, dry_effect_chain 21 | fade_data # 22 | region # array ref with [region_start, region_end] 23 | 24 | attrib # fields for searching 25 | 26 | class # for restore 27 | 28 | ### Group 2 29 | 30 | is_mixing # 31 | 32 | source_tag # git commit at time of caching 33 | -------------------------------------------------------------------------------- /src/effect_chain_attributes: -------------------------------------------------------------------------------- 1 | ### attributes for searching, sorting, used by external functions 2 | 3 | name # for user-defined effect chains 4 | 5 | project # true value identifies project-specific effect chain 6 | 7 | global # true value identifies global effect chain, 8 | 9 | profile # name of associated effect profile 10 | 11 | user # true value identifies user created effect chain 12 | 13 | system # true value identifies system generated effect chain 14 | 15 | track_name # applies to a track of this name 16 | 17 | track_version_result # WAV version of track after caching 18 | 19 | track_version_original # WAV version of track before caching 20 | 21 | track_target_original # WAV files were from this track 22 | 23 | insert # true value identifies belonging to an insert 24 | 25 | track_cache # true value identifies belonging to track caching 26 | 27 | track_target # unused 28 | 29 | bypass # used for identifying effect bypass (obsolete) 30 | 31 | id # duplicates purpose of id field? obsolete? 32 | -------------------------------------------------------------------------------- /src/list_calls: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | my $target = shift; 3 | my @all_files = `cat CODE_MANIFEST`; 4 | my @all = qx(./list_subs `cat CODE_MANIFEST`); 5 | print "found ", scalar @all, " subroutines in total\n"; 6 | my @seek = grep{ $_ ne $target } map{ chomp; $_ } @all_files; 7 | #print "@seek"; exit; 8 | @all = qx(./list_subs @seek); 9 | my @mine = qx(./list_subs $target); 10 | print "of these, I'm searching for calls to", scalar @all, " external\n"; 11 | print "subroutines which will need to be imported.\n"; 12 | print "the total minus ", scalar @mine, "subs in $target.\n"; 13 | 14 | print "\nlisting sub calls in $target\n\n"; 15 | my $text = qx(cat ./$target); 16 | #print $text; exit; 17 | my %found; 18 | map { 19 | 20 | my $current_sub = $_; 21 | my $re = qr{ 22 | (?set(region_start => $beg); 9 | $this_track->set(region_end => $end); 10 | show_region(); 11 | } 12 | sub new_region { 13 | my ($beg, $end, $name) = @_; 14 | $name ||= new_region_name(); 15 | add_track_alias($name, $this_track->name); 16 | set_region($beg,$end); 17 | } 18 | sub new_region_name { 19 | my $name = $this_track->name . '_region_'; 20 | my $i; 21 | map{ my ($j) = /_(\d+)$/; $i = $j if $j > $i; } 22 | grep{/$name/} keys %::Track::by_name; 23 | $name . ++$i 24 | } 25 | sub remove_region { 26 | if (! $this_track->region_start){ 27 | throw($this_track->name, ": no region is defined. Skipping."); 28 | return; 29 | } elsif ($this_track->target ){ 30 | pager($this_track->name, ": looks like a region... removing."); 31 | $this_track->remove; 32 | } else { undefine_region() } 33 | } 34 | 35 | sub undefine_region { 36 | $this_track->set(region_start => undef ); 37 | $this_track->set(region_end => undef ); 38 | pager($this_track->name. ": Region definition removed. Full track will play.\n"); 39 | } 40 | 1; 41 | __END__ 42 | -------------------------------------------------------------------------------- /src/var_overview: -------------------------------------------------------------------------------- 1 | Globals.pm Module for exporting Nama global variables. 2 | It is built from the following files: 3 | 4 | var_pronouns Pronouns (e.g. $this_track) and 5 | indices (e.g. %tn, %ti to get track by name, index) 6 | 7 | var_serialize Marshalling variables for saving and restoring project state 8 | 9 | var_singletons Objects and simple hashes that contain 10 | (such as $config) or 11 | objects such as $file. Hash access to 12 | underlying fields is expected, and 13 | is necessary for Tk slider widgets. 14 | 15 | Hash keys of all variables in var_singletons must be 16 | declared in var_keys or in var_namarc. This is checked 17 | during build 18 | 19 | var_keys List of allowed singleton hash keys 20 | 21 | #### Config variables require an entry in var_config 22 | 23 | var_config Maps keys in .namarc (e.g. $mix_to_disk_format) 24 | to Nama internal variable $config->{mix_to_disk_format} 25 | 26 | var_map_gen Script to generate mappings from var_config 27 | 28 | 29 | #### Lists of variables used for serializing 30 | 31 | var_lists Initializes variable lists for serializing/deserializing 32 | 33 | -------------------------------------------------------------------------------- /src/palette.json: -------------------------------------------------------------------------------- 1 | { 2 | "gui" : { 3 | "_nama_palette" : { 4 | "Capture" : "#f22c92f088d3", 5 | "ClockBackground" : "#998ca489b438", 6 | "ClockForeground" : "#000000000000", 7 | "GroupBackground" : "#998ca489b438", 8 | "GroupForeground" : "#000000000000", 9 | "MarkArmed" : "#d74a811f443f", 10 | "Mixdown" : "#bf67c5a1491f", 11 | "MonBackground" : "#9420a9aec871", 12 | "MonForeground" : "Black", 13 | "Mute" : "#a5a183828382", 14 | "OffBackground" : "#998ca489b438", 15 | "OffForeground" : "Black", 16 | "Play" : "#68d7aabf755c", 17 | "RecBackground" : "#d9156e866335", 18 | "RecForeground" : "Black", 19 | "SendBackground" : "#9ba79cbbcc8a", 20 | "SendForeground" : "Black", 21 | "SourceBackground" : "#f22c92f088d3", 22 | "SourceForeground" : "Black" 23 | }, 24 | "_palette" : { 25 | "ew" : { 26 | "background" : "#d915cc1bc3cf", 27 | "foreground" : "black" 28 | }, 29 | "mw" : { 30 | "activeBackground" : "#4e097822b438", 31 | "background" : "#c2c5d0b5e49a", 32 | "foreground" : "black" 33 | } 34 | } 35 | } 36 | } 37 | -------------------------------------------------------------------------------- /src/var_lists: -------------------------------------------------------------------------------- 1 | @global_effect_chain_vars = qw( 2 | 3 | @global_effect_chain_data 4 | $::EffectChain::n 5 | $fx->{alias} 6 | ); 7 | @tracked_vars = qw( 8 | 9 | @tracks_data 10 | @bus_data 11 | @groups_data 12 | @marks_data 13 | @fade_data 14 | @edit_data 15 | @inserts_data 16 | @effects_data 17 | 18 | $project->{nama_version} 19 | $project->{save_file_version_number} 20 | $project->{sample_rate} 21 | 22 | $fx->{applied} 23 | $fx->{params} 24 | $fx->{params_log} 25 | 26 | ); 27 | @persistent_vars = qw( 28 | 29 | $project->{nama_version} 30 | $project->{save_file_version_number} 31 | $project->{mark_sequence_counter} 32 | $project->{timebase} 33 | $project->{command_buffer} 34 | $project->{track_version_comments} 35 | $project->{track_comments} 36 | $project->{bunch} 37 | $project->{current_op} 38 | $project->{current_param} 39 | $project->{param_stepsize} 40 | $project->{playback_position} 41 | $project->{sample_rate} 42 | $project->{waveform} 43 | @project_effect_chain_data 44 | $fx->{id_counter} 45 | $setup->{loop_endpoints} 46 | $mode->{loop_enable} 47 | $mode->{mastering} 48 | $mode->{preview} 49 | $mode->{midi_transport_sync} 50 | $gui->{_seek_unit} 51 | $text->{command_history} 52 | $text->{hotkey_mode} 53 | $this_track_name 54 | $this_op 55 | ); 56 | 57 | -------------------------------------------------------------------------------- /src/Graphical.p: -------------------------------------------------------------------------------- 1 | # ------------ Graphical User Interface ------------ 2 | 3 | package ::Graphical; ## gui routines 4 | use Modern::Perl '2020'; use Carp; 5 | our $VERSION = 1.071; 6 | use ::Globals qw($term $prompt); 7 | 8 | use Module::Load::Conditional qw(can_load); 9 | use ::Assign qw(:all); 10 | use ::Util qw(colonize); 11 | no warnings 'uninitialized'; 12 | 13 | our @ISA = '::'; ## default to root namespace, e.g. Refresh_subs, Graphical_subs 14 | # actually this doesn't seem like a 15 | # good idea 16 | # widgets 17 | 18 | ## The following methods belong to the Graphical interface class 19 | 20 | sub hello {"make a window";} 21 | sub loop { 22 | $term->Attribs->{already_prompted} = 0; 23 | $term->tkRunning(1); 24 | while (1) { 25 | my ($user_input) = $term->readline($prompt) ; 26 | ::process_line( $user_input ); 27 | } 28 | } 29 | 30 | sub initialize_tk { 31 | my $result1 = can_load( modules => { Tk => undef } ) ; 32 | my $result2 = can_load( modules => { 'Tk::PNG' => undef } ); 33 | $result1 34 | } 35 | 36 | # the following graphical methods are placed in the root namespace 37 | # allowing access to root namespace variables 38 | # with a package path 39 | 40 | package ::; 41 | [% qx(cat ./Graphical_subs.pl ) %] 42 | 43 | [% qx(cat ./Refresh_subs.pl ) %] 44 | 45 | 1; 46 | 47 | __END__ 48 | 49 | -------------------------------------------------------------------------------- /src/check_hash_keys: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use Modern::Perl; 3 | use File::Slurp; 4 | # get registered keys by combining contents of two files 5 | my %var_map = map{ split " ", $_ } split "\n", qx(./strip_all ./var_namarc); 6 | my @vars1 = values %var_map; 7 | my @vars2 = split "\n", qx(./strip_all ./var_keys); 8 | my %singletons; 9 | my %singleton_has_key; 10 | {no warnings 'uninitialized'; 11 | 12 | map{ 13 | my $target = $_; 14 | my ($singleton, $key) = $target =~ /^(\$\w+)->\{(\w+)}/; 15 | 16 | { 17 | #say "singleton: $singleton, key: $key"; 18 | $singletons{$singleton}++; 19 | $singleton_has_key{$singleton} //= {}; 20 | $singleton_has_key{$singleton}{$key}++; 21 | } 22 | } @vars1, @vars2 23 | } 24 | my @files = glob("*.p *.pl *.t"); 25 | =comment 26 | use Data::Dumper::Concise; 27 | print Dumper \%singletons; 28 | print Dumper \%singleton_has_key; 29 | 30 | print join " ", @files; 31 | =cut 32 | 33 | my $srevars = join '|', map{ s/\$//; $_ } keys %singletons; 34 | my $sre = qr/\$($srevars)->\{(\w+)}/; 35 | 36 | map{ 37 | my $filename = $_; 38 | my $contents = read_file($filename); 39 | while( $contents =~ /$sre/g ) 40 | { 41 | my($singleton,$key) = ($1,$2); 42 | #say "found $singleton, $key"; 43 | say "$filename: illegal key ", $singleton, '->{', $key , '}' 44 | if ! $singleton_has_key{"\$$singleton"}{$key} 45 | } 46 | } @files; 47 | -------------------------------------------------------------------------------- /src/fake_jack_latency: -------------------------------------------------------------------------------- 1 | system:capture_1 2 | port latency = 1024 frames 3 | port playback latency = [ 0 0 ] frames 4 | port capture latency = [ 1024 1024 ] frames 5 | system:capture_2 6 | port latency = 1024 frames 7 | port playback latency = [ 0 0 ] frames 8 | port capture latency = [ 1024 1024 ] frames 9 | system:playback_1 10 | port latency = 2048 frames 11 | port playback latency = [ 2048 2048 ] frames 12 | port capture latency = [ 0 0 ] frames 13 | system:playback_2 14 | port latency = 2048 frames 15 | port playback latency = [ 2048 2048 ] frames 16 | port capture latency = [ 0 0 ] frames 17 | LinuxSampler:capture_1 18 | port latency = 1024 frames 19 | port playback latency = [ 256 256 ] frames 20 | port capture latency = [ 512 1024 ] frames 21 | LinuxSampler:capture_2 22 | port latency = 1024 frames 23 | port playback latency = [ 256 256 ] frames 24 | port capture latency = [ 256 1024 ] frames 25 | LinuxSampler:playback_1 26 | port latency = 2048 frames 27 | port playback latency = [ 2048 2048 ] frames 28 | port capture latency = [ 512 512 ] frames 29 | LinuxSampler:playback_2 30 | port latency = 2048 frames 31 | port playback latency = [ 2048 2048 ] frames 32 | port capture latency = [ 512 512 ] frames 33 | -------------------------------------------------------------------------------- /src/StatusSnapshot.p: -------------------------------------------------------------------------------- 1 | package ::StatusSnapshot; 2 | 3 | use Role::Tiny; 4 | use Modern::Perl '2020'; 5 | our $VERSION = 1.0; 6 | { 7 | package ::; 8 | 9 | # these track fields will be inspected 10 | 11 | my @relevant_track_fields = qw( 12 | name 13 | n 14 | width 15 | group 16 | playat 17 | region_start 18 | region_end 19 | looping 20 | source_id 21 | source_type 22 | send_id 23 | send_type 24 | rec_status 25 | current_version 26 | ); 27 | sub status_snapshot { 28 | 29 | # 30 | # hashref output for detecting if we need to reconfigure engine 31 | # compared as YAML strings 32 | 33 | 34 | # %status_snaphot indicates Nama's internal 35 | # state. It consists of 36 | # - the values of selected global variables 37 | # - selected field values of each track 38 | 39 | my %snapshot = ( project => $project->{name}, 40 | mastering_mode => $mode->mastering, 41 | preview => $mode->{preview}, 42 | doodle => $mode->{doodle}, 43 | jack_running => $jack->{jackd_running}, 44 | tracks => [], ); 45 | map { push @{$snapshot{tracks}}, $_->snapshot(\@relevant_track_fields) } 46 | grep{ $_->rec_status ne OFF } grep { $_->group ne 'Temp' } ::all_tracks(); 47 | \%snapshot; 48 | } 49 | sub status_snapshot_string { 50 | my $json = json_out(status_snapshot()); 51 | $json =~ s/: "(\d+)"/: $1/g; 52 | $json 53 | } 54 | } 55 | 56 | 1; 57 | -------------------------------------------------------------------------------- /src/EffectNickname.p: -------------------------------------------------------------------------------- 1 | package ::EffectNickname; 2 | use Modern::Perl '2020'; 3 | our $VERSION = 1.0; 4 | use Role::Tiny; 5 | 6 | sub effect_nickname_count { 7 | my ($track, $nick) = @_; 8 | my $count = 0; 9 | for my $FX ($track->user_ops_o){ $count++ if $FX->name =~ /^$nick\d*$/ } 10 | $count 11 | } 12 | sub unique_surname { 13 | my ($track, $surname) = @_; 14 | # increment supplied surname to be unique to the track if necessary 15 | # return arguments: 16 | # $surname, $previous_surnames 17 | my $max = undef; 18 | my %found; 19 | for my $FX ($track->user_ops_o) 20 | { 21 | if( $FX->surname =~ /^$surname(\d*)$/) 22 | { 23 | $found{$FX->surname}++; 24 | no warnings qw(uninitialized numeric); 25 | $max = $1 if $1 > $max; 26 | } 27 | } 28 | if (%found){ $surname.++$max, join ' ',sort keys %found } else { $surname } 29 | } 30 | sub unique_nickname { 31 | my ($track, $nickname) = @_; 32 | my $i = 0; 33 | my @found; 34 | for my $FX ($track->user_ops_o) 35 | { 36 | if( $FX->name =~ /^$nickname(\d*)$/) 37 | { 38 | push @found, $FX->name; 39 | $i = $1 if $1 and $1 > $i 40 | } 41 | } 42 | $nickname. (@found ? ++$i : ""), "@found" 43 | } 44 | # return effect IDs matching a surname 45 | sub with_surname { 46 | my ($track, $surname) = @_; 47 | my @found; 48 | for my $FX ($track->user_ops_o) 49 | { push @found, $FX->id if $FX->surname eq $surname } 50 | @found ? "@found" : undef 51 | } 52 | 1; 53 | -------------------------------------------------------------------------------- /src/Memoize.p: -------------------------------------------------------------------------------- 1 | # ------ Memoize subroutines ------ 2 | package ::; 3 | use Modern::Perl '2020'; 4 | use Memoize qw(memoize unmemoize); 5 | 6 | BEGIN { # OPTMIZATION 7 | my @wav_functions = qw( 8 | get_versions 9 | candidates 10 | _targets 11 | _versions 12 | ); 13 | my @track_methods = qw( 14 | dir 15 | basename 16 | full_path 17 | group_last 18 | last 19 | current_wav 20 | current_version 21 | playback_version 22 | maybe_playback 23 | rec_status 24 | region_start_time 25 | region_end_time 26 | playat_time 27 | user_ops 28 | input_path 29 | waveform 30 | ); 31 | sub track_memoize { # before generate_setup 32 | return unless $config->{memoize}; 33 | map{package ::Track; memoize($_) } @track_methods; 34 | } 35 | sub track_unmemoize { # after generate_setup 36 | return unless $config->{memoize}; 37 | map{package ::Track; unmemoize ($_)} @track_methods; 38 | } 39 | sub refresh_wav_cache { 40 | return unless $config->{memoize}; 41 | map{package ::Wav; unmemoize ($_); memoize($_) } 42 | @wav_functions; 43 | } 44 | sub latency_memoize { 45 | map{ memoize($_) } ('::self_latency','::latency_of'); 46 | } 47 | sub latency_unmemoize { 48 | map{ unmemoize($_) } ('::self_latency','::latency_of'); 49 | } 50 | sub latency_rememoize { latency_unmemoize(); latency_memoize() } 51 | 52 | sub init_wav_memoize { 53 | return unless $config->{memoize}; 54 | map{package ::Wav; memoize($_) } @wav_functions; 55 | } 56 | } 57 | 1; 58 | __END__ 59 | 60 | -------------------------------------------------------------------------------- /src/Custom.p: -------------------------------------------------------------------------------- 1 | # ---------------- User Customization --------------- 2 | 3 | package ::; 4 | use Modern::Perl '2020'; 5 | 6 | sub setup_user_customization { 7 | my $filename = $file->user_customization(); 8 | 9 | # effect aliases from .namarc 10 | for( keys %{$config->{alias}->{effect}} ) 11 | { my $longform = $config->{alias}->{effect}->{$_}; 12 | if(effect_index($longform)) 13 | { 14 | $fx_cache->{partial_label_to_full}->{$_} = 15 | $fx_cache->{partial_label_to_full}->{$longform} 16 | } 17 | else 18 | { throw("$longform: effect not found, cannot create shortcut") 19 | } 20 | } 21 | return unless -r $filename; 22 | say("reading user customization file $filename"); 23 | my %custom; 24 | unless (%custom = do $filename) { 25 | throw("couldn't parse $filename: $@\n") if $@; 26 | return; 27 | } 28 | logpkg('debug','customization :', sub{Dumper \%custom }); 29 | my $prompt; 30 | { no warnings 'redefine'; 31 | *prompt = $custom{prompt} if $custom{prompt}; 32 | } 33 | my @commands = keys %{ $custom{commands} }; 34 | for my $cmd(@commands){ 35 | #my $coderef = gen_coderef($cmd,$custom{commands}{$cmd}) or next; 36 | $text->{user_command}->{$cmd} = $custom{commands}{$cmd}; 37 | } 38 | $config->{alias} = $custom{aliases}; 39 | } 40 | 41 | sub gen_coderef { 42 | my ($cmd,$code) = @_; 43 | my $coderef = eval "sub{ use feature ':5.10'; no warnings 'uninitialized'; $code }"; 44 | throw("couldn't parse command $cmd: $@"), return if $@; 45 | $coderef 46 | } 47 | 1; 48 | 49 | -------------------------------------------------------------------------------- /src/midish_commands: -------------------------------------------------------------------------------- 1 | print 2 | err 3 | h 4 | exec 5 | debug 6 | panic 7 | info 8 | getunit 9 | setunit 10 | getfac 11 | fac 12 | getpos 13 | g 14 | getlen 15 | sel 16 | getq 17 | setq 18 | ev 19 | gett 20 | getf 21 | cf 22 | getx 23 | cx 24 | geti 25 | ci 26 | geto 27 | co 28 | mute 29 | unmute 30 | getmute 31 | ls 32 | save 33 | load 34 | reset 35 | export 36 | import 37 | i 38 | p 39 | r 40 | s 41 | t 42 | mins 43 | mcut 44 | mdup 45 | minfo 46 | mtempo 47 | msig 48 | mend 49 | ctlconf 50 | ctlconfx 51 | ctlunconf 52 | ctlinfo 53 | m 54 | metrocf 55 | tlist 56 | # ct 57 | # tnew 58 | # tdel 59 | # tren 60 | texists 61 | taddev 62 | tsetf 63 | tgetf 64 | tcheck 65 | tcut 66 | tclr 67 | tpaste 68 | tcopy 69 | tins 70 | tmerge 71 | tquant 72 | ttransp 73 | tevmap 74 | tclist 75 | tinfo 76 | ilist 77 | iexists 78 | iset 79 | inew 80 | idel 81 | iren 82 | iinfo 83 | igetc 84 | igetd 85 | iaddev 86 | irmev 87 | olist 88 | oexists 89 | oset 90 | onew 91 | odel 92 | oren 93 | oinfo 94 | ogetc 95 | ogetd 96 | oaddev 97 | ormev 98 | flist 99 | fexists 100 | fnew 101 | fdel 102 | fren 103 | finfo 104 | freset 105 | fmap 106 | funmap 107 | ftransp 108 | fvcurve 109 | fchgin 110 | fchgout 111 | fswapin 112 | fswapout 113 | xlist 114 | xexists 115 | xnew 116 | xdel 117 | xren 118 | xinfo 119 | xrm 120 | xsetd 121 | xadd 122 | shut 123 | proclist 124 | builtinlist 125 | dnew 126 | ddel 127 | dmtcrx 128 | dmmctx 129 | dclktx 130 | dclkrx 131 | dclkrate 132 | dinfo 133 | dixctl 134 | doxctl 135 | -------------------------------------------------------------------------------- /src/tempo_map: -------------------------------------------------------------------------------- 1 | intro: 8 120 # play 8 measures at 120 bpm (4/4) 2 | verse1: 12 120 X.x. # 12 measures at 120 bpm, playing only the 1st and 3rd beat 3 | 4 120-140 X.x. # gradually increase tempo to 140 bpm 4 | chorus1: 16 140 5 | bridge: 8 3/4 140 0.5 # change to 3/4 time, reduce volume 6 | 8 3/4 140 # normal volume again 7 | verse2: 12 120 # back to 4/4 (implied) 8 | chorus2: 16 140 # jump to 140 bpm 9 | outro: 6 140 10 | 2 140-80 # ritardando over the last 2 bars 11 | -------------------------------------------------------------------------------- /Build.PL: -------------------------------------------------------------------------------- 1 | #! /usr/bin/env perl 2 | use v5; 3 | use strict; 4 | use warnings; 5 | 6 | use Module::Build; 7 | 8 | my $build = Module::Build->new( 9 | module_name => 'Audio::Nama', 10 | dist_abstract => "multitrack recorder and digital audio workstation", 11 | dist_author => 'Joel Roth ', 12 | configure_requires => { 13 | 'Module::Build' => '0.4004', # test_requires 14 | }, 15 | requires => { 16 | 'autodie' => 0, 17 | 'AnyEvent' => 5.0, 18 | 'Data::Dumper::Concise' => 0, 19 | 'Data::Section::Simple' => 0, 20 | 'Event' => 0, 21 | 'File::Find::Rule' => 0, 22 | 'File::Copy' => 0, 23 | 'File::Copy::Link' => 0, 24 | 'File::HomeDir' => 0, 25 | 'File::Slurp' => 0, 26 | 'File::Temp' => 0, 27 | 'Git::Repository' => 0, 28 | 'Graph' => 0, 29 | 'IO::Socket' => 0, 30 | 'IO::Select' => 0, 31 | 'JSON::XS' => 0, 32 | 'IPC::Open3' => 0, 33 | 'IPC::System::Simple' => 0, 34 | 'List::Util' => 0, 35 | 'List::MoreUtils' => 0, 36 | 'Log::Log4perl' => 0, 37 | 'Modern::Perl' => 0, 38 | 'Module::Load::Conditional' => 0, 39 | 'Parse::RecDescent' => 0, 40 | 'Role::Tiny' => 0, 41 | 'SUPER' => 0, 42 | 'Term::ReadLine::Gnu' => 0, 43 | 'Test2::Bundle::More' => 0, 44 | 'Text::Diff' => 0, 45 | 'Text::Format' => 0, 46 | 'Text::Template' => 0, 47 | 'Time::HiRes' => 0, 48 | 'Try::Tiny' => 0, 49 | 'YAML::Tiny' => 0, 50 | 'perl' => '5.030', # incl experimental.pm; postderef;; equivalent to use Modern::Perl '2020' 51 | }, 52 | test_requires => { 53 | 'Test2::Bundle::More' => 0, 54 | }, 55 | license => 'perl', 56 | create_license => 0, 57 | create_readme => 0, 58 | ); 59 | 60 | $build->create_build_script; 61 | 62 | -------------------------------------------------------------------------------- /src/Text.p: -------------------------------------------------------------------------------- 1 | # -------- Text Interface ----------- 2 | ## The following subroutines/methods belong to the Text interface class 3 | ## the grammar of the command processor is defined in 4 | # grammar_body.pl with subroutines in Grammar.p 5 | 6 | package ::Text; 7 | use Modern::Perl '2020'; use Carp; 8 | no warnings 'uninitialized'; 9 | use ::Globals qw(:all); 10 | use ::Assign qw(:all); 11 | 12 | our @ISA = '::'; 13 | our $VERSION = 1.071; 14 | 15 | sub hello {"hello world!";} 16 | 17 | sub loop { 18 | package ::; 19 | initialize_prompt(); 20 | $Event::DIED = sub { 21 | my ($event, $errmsg) = @_; 22 | throw($errmsg); 23 | $text->{term_attribs}->{line_buffer} = q(); 24 | if($term){ 25 | $term->clear_message(); 26 | $term->rl_reset_line_state(); 27 | } 28 | }; 29 | use Data::Dumper::Concise; 30 | Event::loop(); 31 | } 32 | 33 | ## NO-OP GRAPHIC METHODS 34 | 35 | no warnings qw(redefine); 36 | sub init_gui {} 37 | sub transport_gui {} 38 | sub group_gui {} 39 | sub track_gui {} 40 | sub preview_button {} 41 | sub create_master_and_mix_tracks {} 42 | sub time_gui {} 43 | sub refresh {} 44 | sub refresh_group {} 45 | sub refresh_track {} 46 | sub flash_ready {} 47 | sub update_master_version_button {} 48 | sub update_version_button {} 49 | sub paint_button {} 50 | sub project_label_configure{} 51 | sub length_display{} 52 | sub clock_display {} 53 | sub clock_config {} 54 | sub manifest {} 55 | sub global_version_buttons {} 56 | sub destroy_widgets {} 57 | sub destroy_marker {} 58 | sub restore_time_marks {} 59 | sub show_unit {} 60 | sub add_effect_gui {} 61 | sub remove_effect_gui {} 62 | sub marker {} 63 | sub init_palette {} 64 | sub save_palette {} 65 | sub paint_mute_buttons {} 66 | sub remove_track_gui {} 67 | sub reset_engine_mode_color_display {} 68 | sub set_engine_mode_color_display {} 69 | sub setup_playback_indicator {} 70 | 71 | 1; 72 | __END__ 73 | -------------------------------------------------------------------------------- /BUILD: -------------------------------------------------------------------------------- 1 | BUILD INSTRUCTIONS 2 | You may decide to clone the Nama's github repository and from source 3 | rather than installing from CPAN. It is easier to browse or hack on 4 | Nama this way. Functionality is separated into a number of files, and 5 | you will see $::package_var instead of $Audio::Nama::package_var. 6 | 7 | You can get also updates more quickly and can share patches with other 8 | developers. 9 | 10 | Procedure 11 | For typical build and test: 12 | 13 | cpan Text::Template 14 | git-clone git://github.com/bolangi/nama.git 15 | cd nama/src 16 | ./build 17 | ./ui 18 | 19 | To install the module, do as usual: 20 | 21 | cd .. 22 | perl Makefile.PL 23 | make install 24 | 25 | How it works 26 | The build script creates the perl modules for the distribution under the 27 | nama/lib directory using *.p, *.pl, *.t and other files in the nama/src 28 | directory. 29 | 30 | build looks into the *.p files for lines that look like: 31 | 32 | [% somefile.pl %] 33 | 34 | This notation is analogous to the C-preprocessor #include directive: 35 | somefile.pl gets included in the source at that point. Some of these 36 | include lines are more complicated: 37 | 38 | [% qx(./strip_comments ./grammar_body) %] 39 | 40 | Here the preprocessor runs the script strip_comments on grammar_body, 41 | removing text that would choke the parser generator. 42 | 43 | Build provides a few parameters to the preprocessing script preproc, 44 | which uses the Text::Template to perform most of the required 45 | substitutions. 46 | 47 | To see the names of the files and scripts used to build the modules 48 | type: 49 | 50 | ls *.p 51 | grep '\[%' * # shows all include directives 52 | 53 | -------------------------------------------------------------------------------- /src/01_symbols.t: -------------------------------------------------------------------------------- 1 | use Test2::Bundle::More; 2 | use strict; 3 | 4 | use ::Globals qw($ui); 5 | use ::Log; 6 | ::Log::initialize_logger(); 7 | 8 | is($ui, 'bullwinkle', 'global variable import'); 9 | 10 | package Foo; 11 | 12 | use ::Globals qw(:all); 13 | 14 | main::is($ui, 'bullwinkle', 'global variable-all-tag import'); 15 | 16 | package main; 17 | 18 | use ::Assign qw(:all); 19 | # `make test'. After `make install' it should work as `perl 1.t' 20 | 21 | #diag ("TESTING $0\n"); 22 | 23 | my @test_classes = qw( :: main:: main); # SKIP_PREPROC 24 | use vars qw( $foo @face $name %dict); 25 | my @var_list = qw( $foo @face $name %dict); 26 | my $struct2 = { 27 | '$foo' => 2, 28 | '$name' => 'John', 29 | '@face' => [1,5,7,12], 30 | '%dict' => {fruit => 'melon'} 31 | }; 32 | my $struct = { 33 | foo => 2, 34 | name => 'John', 35 | face => [1,5,7,12], 36 | dict => {fruit => 'melon'} 37 | }; 38 | for my $c (@test_classes) { 39 | #diag ("testing for class $c"); 40 | 41 | assign (data => $struct, class => $c, vars => \@var_list); 42 | my $serialized = serialize( class => $c, vars => \@var_list); 43 | 44 | my $expected = < 2, 70 | name => undef, 71 | face => [], 72 | dict => {}, 73 | }; 74 | #diag("scalar array: ",scalar @face, " scalar hash: ", scalar %dict); 75 | assign (data => $nulls, class => 'main', vars => \@var_list); 76 | is( scalar @face, 0, "Null array assignment"); 77 | is( scalar %dict, 0, "Null hash assignment"); 78 | 79 | 80 | done_testing(); 81 | __END__ 82 | -------------------------------------------------------------------------------- /src/02_assign.t: -------------------------------------------------------------------------------- 1 | use Test2::Bundle::More; 2 | use strict; 3 | 4 | use ::Assign qw(:all); 5 | use ::Log; 6 | ::Log::initialize_logger(); 7 | # `make test'. After `make install' it should work as `perl 1.t' 8 | 9 | $ENV{NAMA_VERBOSE_TEST_OUTPUT} and diag ("TESTING $0\n"); 10 | 11 | my @test_classes = qw( :: main:: main); # SKIP_PREPROC 12 | use vars qw( $foo @face $name %dict); 13 | my @var_list = qw( $foo @face $name %dict); 14 | my $struct2 = { 15 | '$foo' => 2, 16 | '$name' => 'John', 17 | '@face' => [1,5,7,12], 18 | '%dict' => {fruit => 'melon'} 19 | }; 20 | my $struct = { 21 | foo => 2, 22 | name => 'John', 23 | face => [1,5,7,12], 24 | dict => {fruit => 'melon'} 25 | }; 26 | $ENV{NAMA_VERBOSE_TEST_OUTPUT} and diag("Serializing, storing$ENV{NAMA_VERBOSE_TEST_OUTPUT} recalling data"); 27 | for my $c (@test_classes) { 28 | $ENV{NAMA_VERBOSE_TEST_OUTPUT} and diag ("testing for package $c"); 29 | 30 | assign (data => $struct, class => $c, vars => \@var_list); 31 | #assign($struct, @var_list); 32 | #print json_out(\%dict); 33 | #print json_out($struct); 34 | my $serialized = serialize( class => $c, vars => \@var_list); 35 | 36 | my $expected = < 2, 62 | name => undef, 63 | face => [], 64 | dict => {}, 65 | }; 66 | #diag("scalar array: ",scalar @face, " scalar hash: ", scalar %dict); 67 | assign (data => $nulls, class => 'main', vars => \@var_list); 68 | is( scalar @face, 0, "Null array assignment"); 69 | is( scalar %dict, 0, "Null hash assignment"); 70 | 71 | 72 | done_testing(); 73 | __END__ 74 | -------------------------------------------------------------------------------- /src/track_fields: -------------------------------------------------------------------------------- 1 | class # for storage and inspection 2 | is_mix_track # Obsolete, retained for backwards compatibility 3 | n # track index 4 | name 5 | group # group affiliation 6 | 7 | rw # REC/MON/OFF setting 8 | version # version setting 9 | midi_versions # used for Midi 10 | width # channel count 11 | 12 | ops # effect operators list 13 | vol # vol control operator 14 | pan # pan control operator 15 | fader # fader operator 16 | latency_op # latency compensation operator 17 | offset # for calculating ecasound chain 18 | # chain operator indexes 19 | # of track effects 20 | 21 | old_vol_level # for mute/unmute 22 | old_pan_level 23 | 24 | playat # for shifting (delaying) playback 25 | region_start # region endpoints 26 | region_end 27 | modifiers # Ecasound playat,select,reverse,loop objects 28 | looping # do I loop? 29 | 30 | hide # I'm invisible 31 | 32 | source_id # signal source (channel No. or jack client) 33 | source_type # soundcard or jack_client 34 | last_source # text representation 35 | 36 | # acceptable source_type values (also applies to send_type) 37 | # 38 | # Active settings: 39 | # 40 | # - jack_client 41 | # - jack_ports_list 42 | # - jack_manual 43 | # - soundcard (ALSA/JACK) 44 | # 45 | # Passive settings: 46 | # 47 | # - track 48 | # - bus 49 | # - loop 50 | 51 | # At present, no activity takes place. 52 | # Connections are made by other objects. 53 | 54 | send_id # as above, for output 55 | send_type 56 | 57 | target # link this track to another track name 58 | project # link this track to another project 59 | 60 | forbid_user_ops # declare that we prohibit user from adding ops 61 | engine_group 62 | 63 | # new API: 64 | # { 1 => 65 | # { 66 | # user => 'user comment', 67 | # system => 'system comment' 68 | # }, 69 | # } 70 | current_edit # {version1 => current_edit1,...} 71 | -------------------------------------------------------------------------------- /MANIFEST: -------------------------------------------------------------------------------- 1 | BUILD 2 | Changes 3 | COPYING 4 | MANIFEST This list of files 5 | META.yml 6 | README 7 | bin/nama 8 | t/01_symbols.t 9 | t/02_assign.t 10 | t/04_object.t 11 | t/06_latency.t 12 | t/11_mark.t 13 | t/12_nama.t 14 | t/data/fake_effects_cache.json 15 | lib/Audio/Nama.pm 16 | lib/Audio/Nama/Globals.pm 17 | lib/Audio/Nama/EcasoundRun.pm 18 | lib/Audio/Nama/Modes.pm 19 | lib/Audio/Nama/Fade.pm 20 | lib/Audio/Nama/MuteSoloFade.pm 21 | lib/Audio/Nama/EcasoundSetup.pm 22 | lib/Audio/Nama/Lat.pm 23 | lib/Audio/Nama/ChainSetup.pm 24 | lib/Audio/Nama/Latency.pm 25 | lib/Audio/Nama/Edit.pm 26 | lib/Audio/Nama/Log.pm 27 | lib/Audio/Nama/Wav.pm 28 | lib/Audio/Nama/Engine.pm 29 | lib/Audio/Nama/CacheTrack.pm 30 | lib/Audio/Nama/Mix.pm 31 | lib/Audio/Nama/Text.pm 32 | lib/Audio/Nama/Object.pm 33 | lib/Audio/Nama/Grammar.pm 34 | lib/Audio/Nama/Jack.pm 35 | lib/Audio/Nama/WavModify.pm 36 | lib/Audio/Nama/Midi.pm 37 | lib/Audio/Nama/Bunch.pm 38 | lib/Audio/Nama/AnalyseLV2.pm 39 | lib/Audio/Nama/Mark.pm 40 | lib/Audio/Nama/Terminal.pm 41 | lib/Audio/Nama/Custom.pm 42 | lib/Audio/Nama/TrackWaveform.pm 43 | lib/Audio/Nama/EcasoundCleanup.pm 44 | lib/Audio/Nama/Help.pm 45 | lib/Audio/Nama/Project.pm 46 | lib/Audio/Nama/Waveform.pm 47 | lib/Audio/Nama/TrackRegion.pm 48 | lib/Audio/Nama/Config.pm 49 | lib/Audio/Nama/TrackEffect.pm 50 | lib/Audio/Nama/Graph.pm 51 | lib/Audio/Nama/Persistence.pm 52 | lib/Audio/Nama/EngineSetup.pm 53 | lib/Audio/Nama/TrackIO.pm 54 | lib/Audio/Nama/Bus.pm 55 | lib/Audio/Nama/TrackComment.pm 56 | lib/Audio/Nama/Insert.pm 57 | lib/Audio/Nama/Regions.pm 58 | lib/Audio/Nama/Git.pm 59 | lib/Audio/Nama/Sequence.pm 60 | lib/Audio/Nama/StatusSnapshot.pm 61 | lib/Audio/Nama/TrackUtils.pm 62 | lib/Audio/Nama/TrackLatency.pm 63 | lib/Audio/Nama/Assign.pm 64 | lib/Audio/Nama/Initializations.pm 65 | lib/Audio/Nama/Util.pm 66 | lib/Audio/Nama/EffectChain.pm 67 | lib/Audio/Nama/Options.pm 68 | lib/Audio/Nama/Track.pm 69 | lib/Audio/Nama/BusUtil.pm 70 | lib/Audio/Nama/EffectNickname.pm 71 | lib/Audio/Nama/Memoize.pm 72 | lib/Audio/Nama/Wavinfo.pm 73 | lib/Audio/Nama/Effect.pm 74 | lib/Audio/Nama/Graphical.pm 75 | lib/Audio/Nama/EffectsRegistry.pm 76 | lib/Audio/Nama/IO.pm 77 | lib/Audio/Nama/Tempo.pm 78 | META.json 79 | -------------------------------------------------------------------------------- /src/crossover.nms: -------------------------------------------------------------------------------- 1 | #create crossover_3chan_piano_cs 2 | 3 | # Input is 5-channel audio from Pianoteq keyboard 4 | # Output is 10 channels divided in pairs in the following order: 5 | # woofer, mid, tweeter, center, rear. 6 | # Center is a mono output, others are stereo. 7 | # Soundcard channel 8 is unused. 8 | 9 | # The following setup script will run correctly 10 | # under ALSA and also with jackd controlling the 11 | # soundcard. 12 | 13 | # initialize tracks 14 | 15 | add-tracks pre1 pre2 woofer center rear mid tweeter 16 | for pre1 pre2 woofer center rear mid tweeter; move-to-bus Aux 17 | 18 | pre1 set-track width 5 19 | 20 | for pre2 woofer center rear; source track pre1 21 | 22 | select-track woofer 23 | add-effect chmove 3 2 24 | stereo 25 | send 1 # send output to soundcard starting at channel 1 26 | 27 | for mid tweeter; source track pre2 28 | 29 | select-track mid 30 | stereo 31 | send 3 # send output to soundcard starting at channel 3 32 | 33 | tweeter # trackname appearing alone or prepended to a command implies select-track 34 | stereo 35 | send 5 36 | 37 | center mono 38 | add-effect chmove 3 1 39 | send 7 40 | 41 | rear 42 | stereo 43 | afx chmove 4 1 # 'afx' is a shortcut for 'add-effect' 44 | afx chmove 5 2 45 | send 9 46 | 47 | for Aux; remove-fader-effect pan; remove-fader-effect vol 48 | Main off; rffx vol; rffx pan 49 | 50 | 51 | # -n:crossover_3chan_piano_cs \ 52 | # -a:pre1 -pf:./pre1.ecp -f:f32_le,5,48000 -i:jack -o:loop,1 \ 53 | # -a:pre2,woofer,center,rear -f:f32_le,5,48000 -i:loop,1 \ 54 | # -a:pre2 -pf:./pre2.ecp -o:loop,2 \ 55 | # -a:mid,tweeter -f:f32_le,5,48000 -i:loop,2 \ 56 | # -a:woofer -pf:./woofer.ecp -chorder:1,3,0,0,0,0,0,0,0,0 \ 57 | # -a:mid -pf:./mid.ecp -chorder:0,0,1,2,0,0,0,0,0,0 \ 58 | # -a:tweeter -pf:./tweeter.ecp -chorder:0,0,0,0,1,2,0,0,0,0 \ 59 | # -a:center -pf:./center_nodelay.ecp -chorder:0,0,0,0,0,0,3,0,0,0 \ 60 | # -a:rear -pf:./rear.ecp -chorder:0,0,0,0,0,0,0,0,4,5 \ 61 | # -a:woofer,mid,tweeter,center,rear -f:f32_le,10,48000 -o:jack \ 62 | # -a:all -z:mixmode,sum -z:nodb -B:rtlowlatency -b:64 63 | -------------------------------------------------------------------------------- /src/Wavinfo.p: -------------------------------------------------------------------------------- 1 | # ------- WAV file info routines --------- 2 | 3 | package ::; 4 | use Modern::Perl '2020'; 5 | 6 | ### WAV file length/format/modify_time are cached in $setup->{wav_info} 7 | 8 | ### Cached methods 9 | 10 | sub wav_length { 11 | my $path = shift; 12 | _update_wav_cache($path); 13 | $setup->{wav_info}->{$path}{length} 14 | } 15 | sub wav_format { 16 | my $path = shift; 17 | _update_wav_cache($path); 18 | $setup->{wav_info}->{$path}{format} 19 | } 20 | 21 | ### Implementation 22 | 23 | sub cache_wav_info { 24 | my @files = File::Find::Rule 25 | ->file() 26 | ->name( '*.wav' ) 27 | ->in( this_wav_dir() ); 28 | map{ _get_wav_info($_) } @files; 29 | } 30 | sub _get_wav_info { 31 | my $path = shift; 32 | #say "path: $path"; 33 | $setup->{wav_info}->{$path}{length} = _get_length($path); 34 | $setup->{wav_info}->{$path}{format} = _get_format($path); 35 | $setup->{wav_info}->{$path}{modify_time} = _get_modify_time($path); 36 | } 37 | sub _get_length { 38 | my $path = shift; 39 | my $length = ecasound_get_info($path, 'ai-get-length'); 40 | $length ? sprintf("%.4f", $length) : undef 41 | } 42 | sub _get_format { 43 | my $path = shift; 44 | ecasound_get_info($path, 'ai-get-format'); 45 | } 46 | sub _get_modify_time { 47 | my $path = shift; 48 | my @stat = stat $path; 49 | $stat[9] 50 | } 51 | sub _update_wav_cache { 52 | my $path = shift; 53 | { no warnings 'uninitialized'; 54 | return unless _get_modify_time($path) != $setup->{wav_info}->{$path}{modify_time}; 55 | } 56 | # throw("WAV file $path has changed! Updating cache."); 57 | _get_wav_info($path) 58 | } 59 | 60 | sub ecasound_get_info { 61 | # get information about an audio object 62 | 63 | my ($path, $command) = @_; 64 | 65 | local $config->{category} = 'ECI_WAVINFO'; 66 | 67 | $path = qq("$path"); 68 | my $old = ecasound_iam('cs-selected'); 69 | teardown_engine(); 70 | ecasound_iam('cs-add gl'); 71 | ecasound_iam('c-add g'); 72 | ecasound_iam('ai-add ' . $path); 73 | ecasound_iam('ao-add null'); 74 | ecasound_iam('cs-connect'); 75 | ecasound_iam('ai-select '. $path); 76 | my $result = ecasound_iam($command); 77 | teardown_engine(); 78 | ecasound_iam("cs-load $old") if $old; 79 | $result; 80 | } 81 | 1; 82 | __END__ 83 | 84 | -------------------------------------------------------------------------------- /src/Bunch.p: -------------------------------------------------------------------------------- 1 | # ---------------------- Bunch ----------------- 2 | # 3 | # operate on a list of tracks 4 | 5 | package ::; 6 | use Modern::Perl '2020'; 7 | 8 | sub is_bunch { 9 | my $name = shift; 10 | $bn{$name} or $project->{bunch}->{$name} 11 | } 12 | 13 | { 14 | my %set_stat = ( 15 | (map{ $_ => 'rw' } qw(rec play mon off) ), 16 | map{ $_ => 'rec_status' } qw(REC PLAY MON OFF ) 17 | ); 18 | 19 | sub bunch { 20 | my ($bunchname, @tracks) = @_; 21 | if (! $bunchname){ 22 | ::pager(json_out( $project->{bunch} )); 23 | } elsif (! @tracks){ 24 | $project->{bunch}->{$bunchname} 25 | and pager("bunch $bunchname: @{$project->{bunch}->{$bunchname}}\n") 26 | or throw("bunch $bunchname: does not exist.\n"); 27 | } elsif (my @mispelled = grep { ! $tn{$_} and ! $ti{$_}} @tracks){ 28 | ::throw("@mispelled: mispelled track(s), skipping.\n"); 29 | } else { 30 | $project->{bunch}->{$bunchname} = [ @tracks ]; 31 | } 32 | } 33 | sub add_to_bunch {} 34 | 35 | sub bunch_tracks { 36 | my $bunchy = shift; 37 | my @tracks; 38 | if ( my $bus = $bn{$bunchy}){ 39 | @tracks = $bus->tracks; 40 | } elsif ( $bunchy eq 'bus' ){ 41 | logpkg('debug', "special bunch: bus"); 42 | @tracks = grep{ ! $bn{$_} } $bn{$this_bus}->tracks; 43 | } elsif ($bunchy =~ /\s/ # multiple identifiers 44 | or $tn{$bunchy} 45 | or $bunchy !~ /\D/ and $ti{$bunchy}){ 46 | logpkg('debug', "multiple tracks found"); 47 | # verify all tracks are correctly named 48 | my @track_ids = split " ", $bunchy; 49 | my @illegal = grep{ ! track_from_name_or_index($_) } @track_ids; 50 | if ( @illegal ){ 51 | throw("Invalid track ids: @illegal. Skipping."); 52 | } else { @tracks = map{ $_->name} 53 | map{ track_from_name_or_index($_)} @track_ids; } 54 | 55 | } elsif ( my $method = $set_stat{$bunchy} ){ 56 | logpkg('debug', "special bunch: $bunchy, method: $method"); 57 | $bunchy = uc $bunchy; 58 | @tracks = grep{$tn{$_}->$method eq $bunchy} 59 | $bn{$this_bus}->tracks 60 | } elsif ( $project->{bunch}->{$bunchy} and @tracks = @{$project->{bunch}->{$bunchy}} ) { 61 | logpkg('debug', "bunch tracks: @tracks"); 62 | } else { throw("$bunchy: no matching bunch identifier found") } 63 | @tracks; 64 | } 65 | } 66 | sub track_from_name_or_index { /\D/ ? $tn{$_[0]} : $ti{$_[0]} } 67 | 1; 68 | -------------------------------------------------------------------------------- /src/TrackRegion.p: -------------------------------------------------------------------------------- 1 | { 2 | package ::TrackRegion; 3 | use Role::Tiny; 4 | use Modern::Perl '2020'; 5 | use ::Globals qw(:all); 6 | use Carp; 7 | 8 | # these behaviors are associated with WAV playback 9 | 10 | sub is_region { defined $_[0]->{region_start} } 11 | 12 | sub region_start_time { 13 | my $track = shift; 14 | return unless $track->is_region; 15 | #return if $track->rec_status ne PLAY; 16 | #carp $track->name, ": expected PLAY status" if $track->rec_status ne PLAY; 17 | ::Mark::time_from_tag( $track->region_start ) 18 | } 19 | sub region_end_time { 20 | my $track = shift; 21 | return unless $track->is_region; 22 | #return if $track->rec_status ne PLAY; 23 | #carp $track->name, ": expected PLAY status" if $track->rec_status ne PLAY; 24 | no warnings 'uninitialized'; 25 | if ( $track->region_end eq 'END' ){ 26 | return $track->wav_length; 27 | } else { 28 | ::Mark::time_from_tag( $track->region_end ) 29 | } 30 | } 31 | sub playat_time { 32 | my $track = shift; 33 | #carp $track->name, ": expected PLAY status" if $track->rec_status ne PLAY; 34 | #return if $track->rec_status ne PLAY; 35 | ::Mark::time_from_tag( $track->playat ) 36 | } 37 | 38 | # the following methods adjust 39 | # region start and playat values during edit mode 40 | 41 | sub shifted_length { 42 | my $track = shift; 43 | my $setup_length; 44 | if ($track->region_start){ 45 | $setup_length = $track->shifted_region_end_time 46 | - $track->shifted_region_start_time 47 | } else { 48 | $setup_length = $track->wav_length; 49 | } 50 | no warnings 'uninitialized'; 51 | $setup_length += $track->shifted_playat_time; 52 | } 53 | 54 | sub shifted_region_start_time { 55 | my $track = shift; 56 | return $track->region_start_time unless $mode->{offset_run}; 57 | ::new_region_start(::edit_vars($track)); 58 | 59 | } 60 | sub shifted_playat_time { 61 | my $track = shift; 62 | return $track->playat_time unless $mode->{offset_run}; 63 | ::new_playat(::edit_vars($track)); 64 | } 65 | sub shifted_region_end_time { 66 | my $track = shift; 67 | return $track->region_end_time unless $mode->{offset_run}; 68 | ::new_region_end(::edit_vars($track)); 69 | } 70 | 71 | sub region_is_out_of_bounds { 72 | return unless $mode->{offset_run}; 73 | my $track = shift; 74 | ::case(::edit_vars($track)) =~ /out_of_bounds/ 75 | } 76 | 77 | } 78 | 1 79 | -------------------------------------------------------------------------------- /src/TrackComment.p: -------------------------------------------------------------------------------- 1 | package ::TrackComment; 2 | use Role::Tiny; 3 | use Modern::Perl '2020'; 4 | our $VERSION = 1.0; 5 | use ::Globals qw($project); 6 | 7 | sub is_comment { 8 | my $self = shift; 9 | $::project->{track_comments}->{$self->name} 10 | } 11 | sub is_version_comment { 12 | my $self = shift; 13 | my $version = shift; 14 | { 15 | no warnings 'uninitialized'; 16 | my $comments = $project->{track_version_comments}->{$self->name}->{$version}; 17 | $comments and $comments->{user} 18 | } 19 | } 20 | sub set_comment { 21 | my ($track, $comment) = @_; 22 | $project->{track_comments}->{$track->name} = $comment 23 | } 24 | sub comment { 25 | my ($track) = @_; 26 | $project->{track_comments}->{$track->name} 27 | } 28 | 29 | sub version_comment { 30 | my ($track, $v) = @_; 31 | return unless $project->{track_version_comments}->{$track->name}{$v}; 32 | my $text = $project->{track_version_comments}->{$track->name}{$v}{user}; 33 | $text .= " " if $text; 34 | my $system = $project->{track_version_comments}->{$track->name}{$v}{system}; 35 | $text .= "* $system" if $system; 36 | $track->name." version $v: $text\n" if $text; 37 | } 38 | sub show_version_comments { 39 | my ($track, @v) = @_; 40 | return unless @v; 41 | ::pager(map{ $track->version_comment($_) } @v); 42 | } 43 | sub add_version_comment { 44 | my ($track,$v,$text) = @_; 45 | $track->targets->{$v} or ::throw("$v: no such version"), return; 46 | $project->{track_version_comments}->{$track->name}{$v}{user} = $text; 47 | $track->version_comment($v); 48 | } 49 | sub add_system_version_comment { 50 | my ($track,$v,$text) = @_; 51 | $track->targets->{$v} or ::throw("$v: no such version"), return; 52 | $project->{track_version_comments}{$track->name}{$v}{system} = $text; 53 | $track->system_version_comment($v); 54 | } 55 | sub remove_version_comment { 56 | my ($track,$v) = @_; 57 | $track->targets->{$v} or ::throw("$v: no such version"), return; 58 | delete $project->{track_version_comments}{$track->name}{$v}{user}; 59 | $track->version_comment($v) || "$v: [comment deleted]\n"; 60 | } 61 | sub remove_system_version_comment { 62 | my ($track,$v) = @_; 63 | delete $project->{track_version_comments}{$track->name}{$v}{system} if 64 | $project->{track_version_comments}{$track->name}{$v} 65 | } 66 | sub system_version_comment { 67 | my ($track, $v) = @_; 68 | return unless $project->{track_version_comments}->{$track->name}{$v}; 69 | $project->{track_version_comments}->{$track->name}{$v}{system}; 70 | } 71 | 1; 72 | -------------------------------------------------------------------------------- /src/stereo51.nms: -------------------------------------------------------------------------------- 1 | # Patrick Shirkey's stereo-to-5.1 converter script implemented in Nama 2 | # 3 | # This is the algorithm to convert a true stereo track to "fake" 5.1 surround. 4 | # You can change the outputs to suit your 5.1 routing 5 | # 6 | # channel 1 - Left Front : left input 7 | # channel 2 - Right Front : right input 8 | # channel 3 - Center : left + right + (bandpass 200hz-16000hz) + (amplify 71%) 9 | # channel 4 - LFE : left + right + (low pass 200hz) + (amplify 71%) 10 | # channel 5 - Left Rear: inverse left + right + (amplify 50%) + 20ms delay 11 | # channel 6 - Right Rear: inverse channel 5 12 | 13 | 14 | # create tracks 15 | # 3 4 5 6 7 8 9 10 11 12 16 | add-tracks Stereo L_front R_front Center Subwoofer L_inverted Right R-L L_rear R_rear 17 | add-bunch all Stereo L_front R_front Center Subwoofer L_inverted Right R-L L_rear R_rear 18 | 19 | Stereo stereo 20 | 21 | # create a bus for summing (inverted L) + R 22 | add-bus R-L 23 | 24 | # we'll do our own routing for these tracks 25 | 26 | Stereo move-to-bus Aux 27 | R-L move-to-bus Aux 28 | 29 | # no recording to disk, remove volume and pan controls 30 | 31 | for all; mon; remove-fader-effect vol; remove-fader-effect pan 32 | 33 | # feed six tracks the stereo source 34 | 35 | for L_front R_front Center Subwoofer L_inverted Right; source track Stereo 36 | 37 | # prepare sources for R-L ('afx' is an abbreviation for # 'add-effect') 38 | 39 | L_inverted afx chmute 2; afx ea -100 40 | Right afx chmute 1 41 | 42 | # feed these two tracks to R-L 43 | 44 | for L_inverted Right; move-to-bus R-L 45 | 46 | # sum R-L source channels to mono 47 | 48 | R-L afx chmix 1 49 | 50 | # Center: sum R+L to mono, output at channel 3 51 | 52 | Center afx chmix 3; afx efh 200; afx efl 16000; afx ea 70 53 | 54 | # Subwoofer: sum R+L to mono, bandpass, output at channel 4 55 | Subwoofer afx chmix 4; afx efl 200 ; afx ea 70 56 | 57 | # L_rear and R_rear get input from R-L 58 | 59 | for L_rear R_rear; source track R-L 60 | 61 | # L_rear: output at channel 5 62 | 63 | L_rear afx chmove 1 5 64 | 65 | # R_rear: output at channel 6 66 | R_rear afx ea -100;afx chmove 1 6 67 | 68 | 69 | # ### Patrick Shirkey's script #### 70 | # 71 | # #!/bin/bash 72 | # 73 | # ecasound -z:mixmode,sum -f:s16_le,2,48000 \ 74 | # -a:1,2,3,4,5,6 -i $1 \ 75 | # -a:1 -chmute:2 \ 76 | # -a:2 -chmute:1 \ 77 | # -a:3 -chmix:3 -efh:200 -efl:16000 -ea:70 \ 78 | # -a:4 -chmix:4 -efl:200 -ea:70 \ 79 | # -a:5 -chmute:2 -ea:-100 \ 80 | # -a:6 -chmute:1 \ 81 | # -a:5,6 -o loop,1 \ 82 | # -a:7 -i loop,1 \ 83 | # -a:7 -efh:200 -efl:16000 -etd:20,0,1,100,100 -ea:50 -o loop,2 \ 84 | # -a:8,9 -i loop,2 \ 85 | # -a:8 -chmix:5 \ 86 | # -a:9 -chmix:6 -ea:-100 \ 87 | # -a:1,2,3,4,8,9 -f:s16_le,6,48000 -o $2 88 | -------------------------------------------------------------------------------- /src/fake_jack_lsp: -------------------------------------------------------------------------------- 1 | system:capture_1 2 | alsa_pcm:capture_1 3 | properties: output,can-monitor,physical,terminal, 4 | system:capture_2 5 | alsa_pcm:capture_2 6 | properties: output,can-monitor,physical,terminal, 7 | system:capture_3 8 | alsa_pcm:capture_3 9 | properties: output,can-monitor,physical,terminal, 10 | system:capture_4 11 | alsa_pcm:capture_4 12 | properties: output,can-monitor,physical,terminal, 13 | system:capture_5 14 | alsa_pcm:capture_5 15 | properties: output,can-monitor,physical,terminal, 16 | system:capture_6 17 | alsa_pcm:capture_6 18 | properties: output,can-monitor,physical,terminal, 19 | system:capture_7 20 | alsa_pcm:capture_7 21 | properties: output,can-monitor,physical,terminal, 22 | system:capture_8 23 | alsa_pcm:capture_8 24 | properties: output,can-monitor,physical,terminal, 25 | system:capture_9 26 | alsa_pcm:capture_9 27 | properties: output,can-monitor,physical,terminal, 28 | system:capture_10 29 | alsa_pcm:capture_10 30 | properties: output,can-monitor,physical,terminal, 31 | system:capture_11 32 | alsa_pcm:capture_11 33 | properties: output,can-monitor,physical,terminal, 34 | system:capture_12 35 | alsa_pcm:capture_12 36 | properties: output,can-monitor,physical,terminal, 37 | system:playback_1 38 | alsa_pcm:playback_1 39 | properties: input,physical,terminal, 40 | system:playback_2 41 | alsa_pcm:playback_2 42 | properties: input,physical,terminal, 43 | system:playback_3 44 | alsa_pcm:playback_3 45 | properties: input,physical,terminal, 46 | system:playback_4 47 | alsa_pcm:playback_4 48 | properties: input,physical,terminal, 49 | system:playback_5 50 | alsa_pcm:playback_5 51 | properties: input,physical,terminal, 52 | system:playback_6 53 | alsa_pcm:playback_6 54 | properties: input,physical,terminal, 55 | system:playback_7 56 | alsa_pcm:playback_7 57 | properties: input,physical,terminal, 58 | system:playback_8 59 | alsa_pcm:playback_8 60 | properties: input,physical,terminal, 61 | system:playback_9 62 | alsa_pcm:playback_9 63 | properties: input,physical,terminal, 64 | system:playback_10 65 | alsa_pcm:playback_10 66 | properties: input,physical,terminal, 67 | Horgand:out_1 68 | properties: output,terminal, 69 | Horgand:out_2 70 | properties: output,terminal, 71 | fluidsynth:left 72 | properties: output, 73 | fluidsynth:right 74 | properties: output, 75 | NamaEcasound:out_1 76 | properties: output, 77 | NamaEcasound:out_2 78 | properties: output, 79 | jconvolver:out_1 80 | properties: output, 81 | jconvolver:out_2 82 | properties: output, 83 | jconvolver:in_1 84 | properties: input, 85 | jconvolver:in_2 86 | properties: input, 87 | LinuxSampler:0 88 | properties: output, 89 | LinuxSampler:1 90 | properties: output, 91 | beatrix-0:output-0 92 | properties: output, 93 | beatrix-0:output-1 94 | properties: output, 95 | -------------------------------------------------------------------------------- /src/escape_codes: -------------------------------------------------------------------------------- 1 | Up \\e[A 2 | Down \\e[B 3 | Left \\e[D 4 | Right \\e[C 5 | Insert \\e[2~ 6 | Delete \\e[3~ 7 | Home \\e[1~ 8 | End \\e[4~ 9 | PageUp \\e[5~ 10 | PageDown \\e[6~ 11 | 12 | ShiftUp \\e[a 13 | ShiftDown \\e[b 14 | ShiftLeft \\e[d 15 | ShiftRight \\e[c 16 | ShiftDelete \\e[3$ 17 | ShiftHome \\e[7$ 18 | ShiftEnd \\e[8$ 19 | 20 | ControlUp \\eOa 21 | ControlDown \\eOb 22 | ControlLeft \\eOd 23 | ControlRight \\eOc 24 | ControlInsert \\e[2^ 25 | ControlDelete \\e[3^ 26 | ControlHome \\e[7^ 27 | ControlEnd \\e[8^ 28 | ControlPageUp \\e[5^ 29 | ControlPageDown \\e[6^ 30 | 31 | AltUp \\e\\e[A 32 | AltDown \\e\\e[B 33 | AltLeft \\e\\e[D 34 | AltRight \\e\\e[C 35 | AltInsert \\e\\e[2~ 36 | AltDelete \\e\\e[3~ 37 | AltHome \\e\\e[1~ 38 | AltEnd \\e\\e[4~ 39 | AltPageUp \\e\\e[5~ 40 | AltPageDown \\e\\e[6~ 41 | 42 | Keypad1 \\eOq 43 | Keypad2 \\eOr 44 | Keypad3 \\eOs 45 | Keypad4 \\eOt 46 | Keypad5 \\eOu 47 | Keypad6 \\eOv 48 | Keypad7 \\eOw 49 | Keypad8 \\eOx 50 | Keypad9 \\eOy 51 | Keypad0 \\eOp 52 | Keypad+ \\eOk 53 | Keypad- \\eOm 54 | Keypad* \\eOj 55 | Keypad/ \\eOo 56 | Keypad. \\eOn 57 | KeypadEnter \\eOM 58 | 59 | AltKeypad1 \\e\\eOq 60 | AltKeypad2 \\e\\eOr 61 | AltKeypad3 \\e\\eOs 62 | AltKeypad4 \\e\\eOt 63 | AltKeypad5 \\e\\eOu 64 | AltKeypad6 \\e\\eOv 65 | AltKeypad7 \\e\\eOw 66 | AltKeypad8 \\e\\eOx 67 | AltKeypad9 \\e\\eOy 68 | AltKeypad0 \\e\\eOp 69 | AltKeypad- \\e\\eOm 70 | AltKeypad+ \\e\\eOk 71 | AltKeypad* \\e\\eOj 72 | AltKeypad/ \\e\\eOo 73 | AltKeypad. \\e\\eOn 74 | AltKeypadEnter \\e\\eOM 75 | 76 | Escape \\e 77 | 78 | F1 \\eOP 79 | F2 \\eOQ 80 | F3 \\eOR 81 | F4 \\eOS 82 | F5 \\e[15~ 83 | F6 \\e[17~ 84 | F7 \\e[18~ 85 | F8 \\e[19~ 86 | F9 \\e[20~ 87 | F10 \\e[21~ 88 | F11 \\e[23~ 89 | F12 \\e[24~ 90 | 91 | ShiftF1 \\e[23~ 92 | ShiftF2 \\e[24~ 93 | ShiftF3 \\e[25~ 94 | ShiftF4 \\e[26~ 95 | ShiftF5 \\e[28~ 96 | ShiftF6 \\e[29~ 97 | ShiftF7 \\e[31~ 98 | ShiftF8 \\e[32~ 99 | ShiftF9 \\e[33~ 100 | ShiftF10 \\e[34~ 101 | ShiftF11 \\e[23$ 102 | ShiftF12 \\e[24$ 103 | 104 | ControlF1 \\e[11^ 105 | ControlF2 \\e[12^ 106 | ControlF3 \\e[13^ 107 | ControlF4 \\e[14^ 108 | ControlF5 \\e[15^ 109 | ControlF6 \\e[17^ 110 | ControlF7 \\e[18^ 111 | ControlF8 \\e[19^ 112 | ControlF9 \\e[20^ 113 | ControlF10 \\e[21^ 114 | ControlF11 \\e[23^ 115 | ControlF12 \\e[24^ 116 | 117 | AltF1 \\e\\eOP 118 | AltF2 \\e\\eOQ 119 | AltF3 \\e\\eOR 120 | AltF4 \\e\\eOS 121 | AltF5 \\e\\e[15~ 122 | AltF6 \\e\\e[17~ 123 | AltF7 \\e\\e[18~ 124 | AltF8 \\e\\e[19~ 125 | AltF9 \\e\\e[20~ 126 | AltF10 \\e\\e[21~ 127 | AltF11 \\e\\e[23~ 128 | AltF12 \\e\\e[24~ 129 | -------------------------------------------------------------------------------- /src/Object.p: -------------------------------------------------------------------------------- 1 | package ::Object; 2 | use Modern::Perl '2020'; 3 | our $VERSION = 1.05; 4 | use Carp; 5 | use ::Assign qw(json_out); 6 | use Storable qw(dclone); 7 | use Data::Dumper::Concise; 8 | no strict 'refs'; 9 | no strict 'subs'; 10 | 11 | BEGIN { 12 | $::Object::VERSION = '1.04'; 13 | } 14 | 15 | sub import { 16 | return unless shift eq '::Object'; 17 | my $pkg = caller; 18 | my $child = 0+@{"${pkg}::ISA"}; 19 | eval join '', 20 | "package $pkg;\n", 21 | ' use vars qw(%_is_field); ', 22 | ' map{ $_is_field{$_}++ } @_;', 23 | ($child ? () : "\@${pkg}::ISA = ::Object;\n"), 24 | map { 25 | defined and ! ref and /^[^\W\d]\w*$/s 26 | or die "Invalid accessor name '$_'"; 27 | "sub $_ { \$_[0]->{$_} }" 28 | } @_; 29 | die "Failed to generate $pkg" if $@; 30 | return 1; 31 | } 32 | 33 | sub new { 34 | my $class = shift; 35 | bless { @_ }, $class; 36 | } 37 | 38 | sub is_legal_key { 39 | 40 | # The behavior I want here is: 41 | # 42 | # Example class hierachy: ::Object, ::Wav, ::Track, ::SimpleTrack 43 | 44 | # By inheriting from Track, SimpleTrack gets all the 45 | # attributes of Track and Wav, without having to include 46 | # them in the Track class definition 47 | 48 | my ($class, $key) = @_; 49 | $class = ref $class if ref $class; # support objects 50 | return 1 if ${"$class\::_is_field"}{$key}; 51 | my ($parent_class) = @{"$class\::ISA"}; 52 | 53 | return unless $parent_class and $parent_class !~ /Object::Tiny/; 54 | 55 | # this should be: 56 | # return unless $parent_class and $parent_class !~ /Object/; 57 | 58 | is_legal_key($parent_class,$key); 59 | } 60 | sub set { 61 | my $self = shift; 62 | my $class = ref $self; 63 | #print "class: $class, args: @_\n"; 64 | croak "odd number of arguments ",join "\n--\n" ,@_ if @_ % 2; 65 | my %new_vals = @_; 66 | map{ 67 | $self->{$_} = $new_vals{$_} ; 68 | my $key = $_; 69 | is_legal_key(ref $self, $key) or croak "illegal key: $_ for object of type ", ref $self; 70 | } keys %new_vals; 71 | } 72 | sub dumpp { 73 | my $self = shift; 74 | print $self->dump 75 | } 76 | sub dump { 77 | my $self = shift; 78 | my $output = Dumper($self); 79 | return $output; 80 | } 81 | 82 | sub as_hash { 83 | my $self = shift; 84 | my $class = ref $self; 85 | bless $self, 'HASH'; # easy magic 86 | my %guts = %{ $self }; 87 | bless $self, $class; 88 | $guts{class} = $class if is_legal_key(ref $self, 'class'); 89 | return \%guts; 90 | } 91 | 1; 92 | 93 | __END__ 94 | 95 | =pod 96 | 97 | =head1 NAME 98 | 99 | ::Object - Class builder 100 | 101 | =head1 SYNOPSIS 102 | 103 | # Define a class 104 | package Foo; 105 | 106 | use ::Object qw{ bux baz }; 107 | 108 | 1; 109 | 110 | 111 | # Use the class 112 | my $object = Foo->new( bux => 1 ); 113 | 114 | $object->set( bux => 2); 115 | 116 | print "bux is " . $object->bux . "\n"; 117 | 118 | 119 | # Define a subclass (automatically inherits parent attributes) 120 | 121 | package Bar; 122 | 123 | our @ISA = 'Foo'; 124 | 125 | my $lonely_bar = Bar->new(); 126 | 127 | $lonely_bar->set(bux => 3); 128 | 129 | 130 | -------------------------------------------------------------------------------- /src/Options.p: -------------------------------------------------------------------------------- 1 | # --------- Command line options ---------- 2 | 3 | package ::; 4 | use Modern::Perl '2020'; 5 | 6 | sub process_command_line_options { 7 | 8 | my %options = qw( 9 | 10 | save-alsa a 11 | project-root=s d 12 | use-pwd p 13 | create-project c 14 | config=s f 15 | gui g 16 | text t 17 | no-state M 18 | net-eci n 19 | libecasoundc l 20 | help h 21 | regenerate-effects-cache r 22 | no-static-effects-data S 23 | no-static-effects-cache C 24 | no-reconfigure-engine R 25 | fake-jack J 26 | fake-alsa A 27 | fake-ecasound E 28 | debugging-output D 29 | execute-command=s X 30 | no-terminal T 31 | no-fade-on-transport-start F 32 | log=s L 33 | no-latency O 34 | latency Q 35 | sample-rate=s z 36 | 37 | ); 38 | 39 | map{$config->{opts}->{$_} = ''} values %options; 40 | 41 | # long options 42 | 43 | Getopt::Long::Configure ("bundling"); 44 | my $getopts = 'GetOptions( '; 45 | map{ $getopts .= qq("$options{$_}|$_" => \\\$config->{opts}->{$options{$_}}, \n)} keys %options; 46 | $getopts .= ' )' ; 47 | 48 | #say $getopts; 49 | 50 | eval $getopts or die "Stopped.\n"; 51 | 52 | if ($config->{opts}->{h}){ say $help->{usage}; exit; } 53 | 54 | } 55 | BEGIN { 56 | $help->{usage} = <{opts}->{F}; 8 | return if $tn{Main}->rw eq OFF or ::ChainSetup::really_recording(); 9 | $tn{Main}->mute; 10 | } 11 | sub unmute { 12 | return if $config->{opts}->{F}; 13 | return if $tn{Main}->rw eq OFF or ::ChainSetup::really_recording(); 14 | $tn{Main}->unmute; 15 | } 16 | sub fade_around { 17 | my ($coderef, @args) = @_; 18 | if( $this_engine->started() ) 19 | { 20 | mute(); 21 | $coderef->(@args); 22 | unmute(); 23 | } 24 | else { $coderef->(@args) } 25 | } 26 | sub solo { 27 | my @args = @_; 28 | 29 | # get list of already muted tracks if I haven't done so already 30 | 31 | if ( ! @{$fx->{muted}} ){ 32 | @{$fx->{muted}} = map{ $_->name } grep{ defined $_->old_vol_level} user_tracks() } 33 | 34 | logpkg('debug', join " ", "already muted:", sub{map{$_->name} @{$fx->{muted}}}); 35 | 36 | # convert bunches to tracks 37 | my @names = map{ bunch_tracks($_) } @args; 38 | 39 | # use hashes to store our list 40 | 41 | my %to_mute; 42 | my %not_mute; 43 | 44 | # get dependent tracks 45 | 46 | my @dependents = map{ $tn{$_}->bus_tree() } @names; 47 | 48 | # store solo tracks and dependent tracks that we won't mute 49 | 50 | map{ $not_mute{$_}++ } @names, @dependents; 51 | 52 | # find all siblings tracks not in depends list 53 | 54 | # - get buses list corresponding to our non-muting tracks 55 | 56 | my %buses; 57 | $buses{Main}++; # we always want Main 58 | 59 | map{ $buses{$_}++ } # add to buses list 60 | map { $tn{$_}->group } # corresponding bus (group) names 61 | keys %not_mute; # tracks we want 62 | 63 | # - get sibling tracks we want to mute 64 | 65 | map{ $to_mute{$_}++ } # add to mute list 66 | grep{ ! $not_mute{$_} } # those we *don't* want 67 | map{ $bn{$_}->tracks } # tracks list 68 | keys %buses; # buses list 69 | 70 | # mute all tracks on our mute list (do we skip already muted tracks?) 71 | 72 | do_many_tracks( { tracks => [ keys %to_mute ], method => 'mute' } ); 73 | 74 | # unmute all tracks on our wanted list 75 | 76 | do_many_tracks( { tracks => [ keys %not_mute ], method => 'unmute' } ); 77 | 78 | $mode->{soloing} = 1; 79 | } 80 | 81 | sub nosolo { 82 | # unmute all except in @{$fx->{muted}} list 83 | 84 | # unmute all tracks 85 | do_many_tracks( { tracks => [ map{$_->name} user_tracks() ], method => 'unmute' } ); 86 | 87 | # re-mute previously muted tracks 88 | if (@{$fx->{muted}}){ 89 | do_many_tracks( { tracks => [ @{$fx->{muted}} ], method => 'mute' } ); 90 | } 91 | 92 | # remove listing of muted tracks 93 | @{$fx->{muted}} = (); 94 | 95 | $mode->{soloing} = 0; 96 | } 97 | sub all { 98 | 99 | # unmute all tracks 100 | do_many_tracks( { tracks => [ ::Track::user() ], method => 'unmute' } ); 101 | 102 | # remove listing of muted tracks 103 | @{$fx->{muted}} = (); 104 | 105 | $mode->{soloing} = 0; 106 | } 107 | 108 | sub do_many_tracks { 109 | # args: { tracks => [ track objects ], method => method_name } 110 | my $args = shift; 111 | my $method = $args->{method}; 112 | my $delay = $args->{delay} || $config->{engine_muting_time}; 113 | map{ $tn{$_}->$method('nofade'); sleeper($delay) } @{$args->{tracks}}; 114 | } 115 | 116 | 1; 117 | __END__ 118 | -------------------------------------------------------------------------------- /src/14_latency.t_off: -------------------------------------------------------------------------------- 1 | __END__ 2 | package ::; 3 | use ::; 4 | use Test::More qw(no_plan); 5 | use Cwd; 6 | use File::Path qw(make_path remove_tree); 7 | 8 | use strict; 9 | use warnings; 10 | no warnings qw(uninitialized); 11 | 12 | our ($expected_setup_lines); 13 | our $test_dir = "/tmp/nama-test"; 14 | cleanup(); 15 | make_path($test_dir); 16 | 17 | 18 | diag ("TESTING $0\n"); 19 | 20 | diag("working directory: ",cwd); 21 | 22 | apply_ecasound_test_harness(); 23 | push @ARGV, '-L','ECI'; 24 | diag "options: @ARGV"; 25 | 26 | bootstrap_environment(); 27 | 28 | diag "Check representative variable from default .namarc"; 29 | 30 | is( $config->{mix_to_disk_format}, "s16_le,N,44100,i", "Read mix_to_disk_format"); 31 | 32 | is( jack_port_latency('output','LinuxSampler:playback_1'), 33 | 2048, "get JACK port latency"); 34 | 35 | *cmd = \&command_process; # shortcut 36 | 37 | # 'send null' doesn't work!! 38 | #cmd("Main; send null"); # so engine doesn't actually use JACK 39 | cmd("sh"); 40 | cmd("add sine; source null; afx sine_fcac 220 0.1"); 41 | cmd("Mixdown rec"); # record the cooked signal 42 | cmd("arm"); 43 | is(ecasound("cs-is-valid"),1, 'Load a valid chain setup'); 44 | #diag(::ChainSetup::ecasound_chain_setup()); 45 | #limit_processing_time(3); 46 | cmd("cs-set-length 3"); 47 | cmd("start"); 48 | sleeper(0.5); 49 | sleeper(1) while engine_running(); 50 | rec_cleanup(); 51 | my $wav = join_path(this_wav_dir(),'Mixdown_1.wav'); 52 | is( abs((-s $wav) - 528_428) < 30_000, 1, "recorded WAV file, 3s"); 53 | is($this_track->rec_status, 'MON', 'Ready to play WAV file after mixdown'); 54 | diag(::ChainSetup::ecasound_chain_setup()); 55 | cmd("setpos 0.5"); 56 | diag(ecasound("getpos")); 57 | is( abs(ecasound("getpos") - 0.5)<0.001, 1, 'Set position'); 58 | cmd("new_mark in1"); 59 | cmd("setpos 1.0"); 60 | cmd("new_mark out1"); 61 | cmd("setpos 1.5"); 62 | cmd("new_mark in2"); 63 | cmd("setpos 2.0"); 64 | cmd("new_mark out2"); 65 | is($this_track->playback_version, 1, 'Find WAV file to play, normal track'); 66 | cmd("sine off"); 67 | cmd("link_track sinuous Mixdown"); 68 | cmd("sinuous"); 69 | is($this_track->playback_version, 1, 'Find WAV file to play, link track'); 70 | cmd("arm"); 71 | 72 | symlink($wav, join_path(this_wav_dir(),'sinister.wav')); 73 | cmd("scan"); 74 | cmd("add_track sinister; mon"); 75 | reconfigure_engine(); 76 | is($this_track->playback_version, 1, 'Find WAV file to play, unnumbered WAV file'); 77 | 78 | sub gen_alsa { force_alsa(); command_process('gen')} 79 | sub gen_jack { force_jack(); command_process('gen')} 80 | sub force_alsa { $config->{opts}->{A} = 1; $config->{opts}->{J} = 0; $jack->{jackd_running} = 0; } 81 | sub force_jack{ $config->{opts}->{A} = 0; $config->{opts}->{J} = 1; $jack->{jackd_running} = 1; } 82 | sub setup_content { 83 | my @lines = split "\n", shift; 84 | my %setup; 85 | for (@lines){ 86 | next unless /^-a:/; 87 | s/\s*$//; 88 | $setup{$_}++; 89 | } 90 | \%setup; 91 | } 92 | sub check_setup { 93 | my $test_name = shift; 94 | is( yaml_out(setup_content(::ChainSetup::ecasound_chain_setup())), 95 | yaml_out(setup_content($expected_setup_lines)), 96 | $test_name); 97 | } 98 | 99 | sub cleanup { remove_tree($test_dir) } 100 | 101 | chdir "/tmp"; 102 | #my $testfile = '/tmp/nama-test/untitled/.wav/Mixdown_1.wav'; 103 | #diag "$testfile: length ",-s $testfile; 104 | #unlink $testfile; 105 | #cleanup(); 106 | 1; 107 | __END__ 108 | -------------------------------------------------------------------------------- /src/Globals.p: -------------------------------------------------------------------------------- 1 | package ::Globals; 2 | use Modern::Perl '2020'; 3 | our $VERSION = 1.0; 4 | 5 | # set aliases for common indices 6 | *bn = \%::Bus::by_name; 7 | *tn = \%::Track::by_name; 8 | *ti = \%::Track::by_index; 9 | *mn = \%::Mark::by_name; 10 | *en = \%::Engine::by_name; 11 | *fi = \%::Effect::by_id; 12 | 13 | # and the graph 14 | 15 | *g = \$::ChainSetup::g; 16 | 17 | use Exporter; 18 | use constant { 19 | REC => 'REC', 20 | PLAY => 'PLAY', 21 | MON => 'MON', 22 | OFF => 'OFF', 23 | }; 24 | our @ISA = 'Exporter'; 25 | our @EXPORT_OK = qw( 26 | 27 | [% join "\n", split " ",qx(./strip_all ./var_pronouns ./var_singletons ./var_serialize) %] 28 | 29 | ); 30 | 31 | our %EXPORT_TAGS = 32 | ( 33 | trackrw => [qw(REC PLAY MON OFF)], 34 | singletons => [qw( 35 | 36 | [% qx(./strip_all ./var_singletons) %] 37 | 38 | )], 39 | 40 | var_lists => [qw( 41 | 42 | @tracked_vars 43 | @persistent_vars 44 | @global_effect_chain_vars 45 | )], 46 | 47 | pronouns => [qw( 48 | 49 | [% qx(./strip_all ./var_pronouns) %] 50 | 51 | )], 52 | 53 | serialize => [qw( 54 | 55 | [% qx(./strip_all ./var_serialize ) %] 56 | 57 | )], 58 | ); 59 | our $ui = 'bullwinkle'; # required for testing 60 | { 61 | my %seen; 62 | push @{$EXPORT_TAGS{all}}, grep {!$seen{$_}++} @{$EXPORT_TAGS{$_}} foreach 63 | keys %EXPORT_TAGS; 64 | } 65 | 66 | 67 | 1; 68 | __END__ 69 | 70 | =head1 NAME 71 | 72 | =encoding UTF-8 73 | 74 | Audio::Nama::Globals - Nama global variables 75 | 76 | Variables are listed in multiple files in the source. 77 | 78 | =head2 Exported 79 | 80 | L exports Nama globals, 81 | which it gets by merging the contents 82 | of the following files: 83 | 84 | =over 85 | 86 | =item F 87 | 88 | Pronouns (e.g. C<$this_track>) and 89 | indices (e.g. C<%tn>, get track by name) 90 | 91 | =item F 92 | 93 | Marshalling variables for serializing/deserializing (e.g. C<@tracks_data>) 94 | 95 | =item F 96 | 97 | Simple hash structures (such as C<$config>) or objects such 98 | as F<$file> that aggregate data. The hashes can be invested 99 | with object properties as need be. 100 | 101 | =back 102 | 103 | =head2 Other lists 104 | 105 | =over 106 | 107 | =item F 108 | 109 | Maps keys in F<.namarc> (e.g. I) to the 110 | corresponding Nama internal scalar (e.g. C<$config-E{mix_to_disk_format}> 111 | 112 | =item F 113 | 114 | List of allowed singleton hash keys. 115 | 116 | Keys of variables appearing in ./var_singletons 117 | should be listed in var_keys or in var_namarc. 118 | Undeclared keys will trigger warnings during build. 119 | 120 | =back 121 | 122 | =head2 F 123 | 124 | Declares lists of variables used in 125 | serializing/deserializing. 126 | 127 | =over 128 | 129 | =item C<@global_effect_chain_vars> 130 | 131 | Mainly user defined and system-wide effect chains, 132 | stored in F in the 133 | Nama project root directory. 134 | 135 | =item C<@tracked_vars> 136 | 137 | These variables are saved to F in the project 138 | directory and placed under version control. 139 | 140 | =item C<@persistent_vars> 141 | 142 | These Variables saved to F, I under version control. 143 | including project-specific effect-chain definitions, 144 | and track/version comments. 145 | 146 | =back 147 | 148 | =cut 149 | -------------------------------------------------------------------------------- /src/TrackEffect.p: -------------------------------------------------------------------------------- 1 | package ::TrackEffect; 2 | use Modern::Perl '2020'; 3 | our $VERSION = 1.0; 4 | use Role::Tiny; 5 | use ::Effect qw(fxn); 6 | use ::Globals qw($project); 7 | use Try::Tiny; 8 | use List::MoreUtils qw(first_index); 9 | 10 | # current operator and current parameter for the track 11 | sub op { $project->{current_op}->{$_[0]->name} //= $_[0]->{ops}->[-1] } 12 | 13 | sub param { $project->{current_param}->{$_[0]->op} //= 1 } 14 | 15 | sub stepsize { 16 | $project->{param_stepsize}->{$_[0]->op}->[$_[0]->param] //= 0.01 17 | # TODO use hint if available 18 | } 19 | sub pos { 20 | my $track = shift; 21 | my $op = $track->op; 22 | my $index = first_index {$_ eq $op } @{$track->ops}; 23 | return($index || 0); 24 | } 25 | sub user_ops_o { 26 | my $track = shift; 27 | map{ fxn($_) } $track->user_ops(); 28 | } 29 | sub channel_ops { 30 | my $track = shift; 31 | grep{ $_->is_channel_op } $track->ops_o; 32 | } 33 | sub audio_ops { 34 | my $track = shift; 35 | grep{ 36 | ! $_->is_channel_op 37 | and ! $_->is_controller 38 | 39 | } $track->ops_o; 40 | } 41 | sub ops_ecasound_order { 42 | my $track = shift; 43 | $track->channel_ops, $track->audio_ops 44 | } 45 | sub ecasound_dynamic_apply_list { # audio ops and their controllers 46 | my $track = shift; 47 | grep{ ! $_->is_channel_op } $track->ops_o; 48 | } 49 | sub ops_o { 50 | my $track = shift; 51 | map{ ::fxn($_) } @{ $track->ops } 52 | } 53 | sub apply_ops { 54 | my $track = shift; 55 | $_->apply_op for $track->ecasound_dynamic_apply_list; 56 | } 57 | sub user_ops { 58 | my $track = shift; 59 | my @skip = grep {fxn($_)} # must exist 60 | map { $track->{$_} } qw(vol pan fader latency_op ); 61 | 62 | # make a dictionary of ops to exclude 63 | # that includes utility ops and their controllers 64 | 65 | my %skip; 66 | 67 | map{ $skip{$_}++ } @skip, ::expanded_ops_list(@skip); 68 | 69 | grep{ ! $skip{$_} } @{ $track->{ops} || [] }; 70 | } 71 | 72 | sub first_effect_of_type { 73 | my $track = shift; 74 | my $type = shift; 75 | for my $op ( @{$track->ops} ){ 76 | my $FX = fxn($op); 77 | return $FX if $FX->type =~ /$type/ # Plate matches el:Plate 78 | } 79 | } 80 | sub effect_id_by_name { 81 | my $track = shift; 82 | my $ident = shift; 83 | for my $FX ($track->user_ops_o) 84 | { return $FX->id if $FX->name eq $ident } 85 | } 86 | sub vol_level { my $self = shift; try { $self->vol_o->params->[0] } } 87 | sub pan_level { my $self = shift; try { $self->pan_o->params->[0] } } 88 | sub vol_o { my $self = shift; fxn($self->vol) } 89 | sub pan_o { my $self = shift; fxn($self->pan) } 90 | sub mute { 91 | 92 | my $track = shift; 93 | my $nofade = shift; 94 | 95 | # do nothing if track is already muted 96 | return if defined $track->old_vol_level(); 97 | 98 | # do nothing if track has no volume operator 99 | my $vol = $track->vol_o; 100 | return unless $vol; 101 | 102 | # store vol level for unmute 103 | $track->set(old_vol_level => $vol->params->[0]); 104 | 105 | $nofade 106 | ? $vol->_modify_effect(1, $vol->mute_level) 107 | : $vol->fadeout 108 | } 109 | sub unmute { 110 | my $track = shift; 111 | my $nofade = shift; 112 | 113 | # do nothing if we are not muted 114 | return if ! defined $track->old_vol_level; 115 | 116 | $nofade 117 | ? $track->vol_o->_modify_effect(1, $track->old_vol_level) 118 | : $track->vol_o->fadein($track->old_vol_level); 119 | 120 | $track->set(old_vol_level => undef); 121 | } 122 | sub get_inserts { 123 | my $track = shift; 124 | grep{ $_->{track} eq $track->name} values %::Insert::by_index; 125 | } 126 | 127 | 1; 128 | -------------------------------------------------------------------------------- /src/man_page_part2: -------------------------------------------------------------------------------- 1 | =head1 REALTIME OPERATION 2 | 3 | Nama selects realtime or nonrealtime parameters based on the 4 | B, B and 5 | B fields in F<.namarc>. You can 6 | optionally specify the buffersizes as a multiple of the JACK 7 | period size. Note that for best realtime operation under 8 | JACK you will have to configure jackd appropriately as well. 9 | 10 | The B and B profiles are useful when using 11 | Nama/Ecasound for live fx processing or live monitoring. 12 | 13 | The B profile sets a small buffersize and other low 14 | latency settings whenever a soundcard or JACK client is 15 | connected. 16 | 17 | The B profile uses a bigger buffer, providing 18 | extended margins for stable operation. It is suitable for 19 | post-processing, or for recording without live monitoring 20 | responsibilities. 21 | 22 | The B profile defaults to nonrealtime settings. It 23 | switches to realtime, low-latency settings when a track has 24 | a live input. 25 | 26 | =head1 DIAGNOSTICS 27 | 28 | On any change in setup, the GUI display updates and 29 | C command is executed automatically showing 30 | what to expect the next time the engine is started. 31 | 32 | You can use the C command to verify the Ecasound 33 | chain setup. (The Ecasound command C 34 | will additionally store all engine data, effects as 35 | well as routing.) 36 | 37 | The C command displays data for the current track. 38 | The C command shows all state that would be saved. 39 | 40 | This is the same output that is written to the F 41 | file when you issue the C command. 42 | 43 | =head1 BUGS AND LIMITATIONS 44 | 45 | No latency compensation across signal paths is provided at 46 | present. This feature is under development. 47 | 48 | =head1 SECURITY CONCERNS 49 | 50 | If you are using Nama with the NetECI interface (i.e. if 51 | Audio::Ecasound is I installed) you should block TCP 52 | port 2868 if your computer is exposed to the Internet. 53 | 54 | =head1 INSTALLATION 55 | 56 | The following commands, available on Unixlike systems with 57 | Perl installed, will pull in Nama and other Perl libraries 58 | required for text mode operation: 59 | 60 | C 61 | -or- 62 | C 63 | 64 | To use the GUI, you will need to install Tk: 65 | 66 | C 67 | 68 | You can pull the source code as follows: 69 | 70 | C 71 | 72 | Consult the F file for build instructions. 73 | 74 | =head1 SUPPORT 75 | 76 | The Nama mailing list is a suitable forum for questions 77 | regarding Nama installation, usage, bugs, feature requests, etc. 78 | 79 | http://www.freelists.org/list/nama 80 | 81 | For questions and discussion related to Ecasound 82 | 83 | https://lists.sourceforge.net/lists/listinfo/ecasound-list 84 | 85 | =head1 PATCHES 86 | 87 | The modules that make up this application are the 88 | preprocessed output from several source files. Patches 89 | against these source files are preferred. 90 | 91 | =head1 AUTHOR 92 | 93 | Joel Roth, Ejoelz@pobox.comE 94 | 95 | =head1 CONTRIBUTORS 96 | 97 | Alex Stone 98 | Brett McCoy 99 | Dubphil 100 | F. Silvain ++ 101 | Joy Bausch 102 | Julien Claassen ++ 103 | Kevin Utter 104 | Lars Bjørndal 105 | Philippe Schelté 106 | Philipp Überbacher 107 | Raphaël Mouneyres ++ 108 | Rusty Perez 109 | S. Massy ++ 110 | 111 | =head1 COPYRIGHT & LICENSE 112 | 113 | Copyright (c) 2009-2017 by Joel Roth. 114 | 115 | This is free software; you can redistribute it and/or modify 116 | it under the terms of the "L". 117 | -------------------------------------------------------------------------------- /src/Mix.p: -------------------------------------------------------------------------------- 1 | package ::; 2 | use Modern::Perl '2020'; 3 | 4 | sub check_level { 5 | 6 | my $track = shift; 7 | 8 | my $ev = add_effect( { track => $track, type => 'ev' } ); 9 | 10 | # disable Main so unused tracks are pruned 11 | 12 | $tn{Main}->set(rw => OFF); 13 | 14 | # direct target track to null 15 | 16 | my $null_routing = 17 | sub { my $g = shift; 18 | $g->add_path($track->name, output_node('null')) }; 19 | generate_setup($null_routing) 20 | or throw("check_level: generate_setup failed!"), return; 21 | connect_transport(); 22 | 23 | ecasound_iam('start'); # don't use heartbeat 24 | sleep 2; # time for engine to stabilize 25 | while( ecasound_iam('engine-status') ne 'finished'){ 26 | print q(.); sleep 1; update_clock_display()}; 27 | print " Done\n"; 28 | 29 | my $cs = ecasound_iam('cop-status'); 30 | 31 | my ($level_output) = $cs =~ /Status info:\s*?\n(.+)\z/s; 32 | pager($level_output); 33 | 34 | # restore previous state 35 | 36 | remove_effect($ev); 37 | $tn{Main}->set(rw => MON); 38 | ::request_setup(); 39 | } 40 | 41 | sub automix { 42 | 43 | # get working track set 44 | 45 | my @tracks = grep{ 46 | $tn{$_}->play or 47 | $bn{$_} and $tn{$_}->rec 48 | } $bn{Main}->tracks; 49 | 50 | pager("tracks: @tracks"); 51 | 52 | ## we do not allow automix if inserts are present 53 | 54 | throw("Cannot perform automix if inserts are present. Skipping."), return 55 | if grep{$tn{$_}->prefader_insert || $tn{$_}->postfader_insert} @tracks; 56 | 57 | #use Smart::Comments '###'; 58 | # add -ev to summed signal 59 | my $ev = add_effect( { chain => $tn{Main}->n, type => 'ev' } ); 60 | ### ev id: $ev 61 | 62 | # turn off audio output 63 | 64 | my $old_send_type = $tn{Main}->{send_type}; 65 | my $old_send_id = $tn{Main}->{send_id}; 66 | 67 | $tn{Main}->set(send_type => 'null', send_id => 'null'); 68 | 69 | ### Status before mixdown: 70 | 71 | nama_cmd('show'); 72 | 73 | 74 | ### reduce track volume levels to 10% 75 | 76 | ## accommodate ea and eadb volume controls 77 | 78 | my $vol_operator = fxn($tn{$tracks[0]}->vol)->type; 79 | 80 | my $reduce_vol_command = $vol_operator eq 'ea' ? 'vol / 10' : 'vol - 10'; 81 | my $restore_vol_command = $vol_operator eq 'ea' ? 'vol * 10' : 'vol + 10'; 82 | 83 | ### reduce vol command: $reduce_vol_command 84 | 85 | for (@tracks){ nama_cmd("$_ $reduce_vol_command") } 86 | 87 | nama_cmd('show'); 88 | 89 | generate_setup('automix') # pass a bit of magic 90 | or throw("automix: generate_setup failed!"), return; 91 | connect_transport(); 92 | 93 | # start_transport() does a rec_cleanup() on transport stop 94 | 95 | ecasound_iam('start'); # don't use heartbeat 96 | sleep 2; # time for engine to stabilize 97 | while( ecasound_iam('engine-status') ne 'finished'){ 98 | print q(.); sleep 1; update_clock_display()}; 99 | print " Done\n"; 100 | 101 | # parse cop status 102 | my $cs = ecasound_iam('cop-status'); 103 | ### cs: $cs 104 | my $cs_re = qr/Chain "1".+?result-max-multiplier ([\.\d]+)/s; 105 | my ($multiplier) = $cs =~ /$cs_re/; 106 | 107 | ### multiplier: $multiplier 108 | 109 | remove_effect($ev); 110 | 111 | # deal with all silence case, where multiplier is 0.00000 112 | 113 | if ( $multiplier < 0.00001 ){ 114 | 115 | throw("Signal appears to be silence. Skipping."); 116 | for (@tracks){ nama_cmd("$_ $restore_vol_command") } 117 | $tn{Main}->set(rw => MON); 118 | return; 119 | } 120 | 121 | ### apply multiplier to individual tracks 122 | 123 | for (@tracks){ nama_cmd( "$_ vol*$multiplier" ) } 124 | 125 | ### mixdown 126 | nama_cmd('mixdown; arm; start'); 127 | 128 | ### restore audio output 129 | 130 | $tn{Main}->set( send_type => $old_send_type, send_id => $old_send_id); 131 | 132 | #no Smart::Comments; 133 | 134 | } 135 | 1 136 | __END__ 137 | -------------------------------------------------------------------------------- /src/Modes.p: -------------------------------------------------------------------------------- 1 | # ----------- Modes: mastering, preview, doodle --------- 2 | 3 | package ::; 4 | use Modern::Perl '2020'; 5 | { 6 | sub set_preview_mode { 7 | 8 | # set preview mode, releasing doodle mode if necessary 9 | 10 | logsub((caller(0))[3]); 11 | 12 | # do nothing if already in 'preview' mode 13 | 14 | return if $mode->preview; 15 | disable_preview_modes(); 16 | { 17 | no warnings 'uninitialized'; 18 | $mode->{preview}++; 19 | } 20 | 21 | pager( <<'MSG'); 22 | Setting preview mode. Recording of audio files is disabled. 23 | 24 | Type 'arm' to enable recording. 25 | MSG 26 | 27 | } 28 | sub set_doodle_mode { 29 | 30 | logsub((caller(0))[3]); 31 | return if $this_engine->started() and ::ChainSetup::really_recording(); 32 | disable_preview_modes(); 33 | { 34 | no warnings 'uninitialized'; 35 | $mode->{doodle}++; 36 | } 37 | 38 | $tn{Mixdown}->set(rw => OFF); 39 | 40 | # reconfigure_engine will generate setup and start transport 41 | 42 | pager( <<'MSG' ); 43 | Setting doodle mode. Using live inputs only. Duplicate 44 | inputs are excluded. Recording of audio files is disabled. 45 | 46 | Exit using 'preview' or 'arm' commands 47 | MSG 48 | } 49 | sub exit_preview_modes { 50 | logsub((caller(0))[3]); 51 | return unless $mode->{preview} or $mode->{doodle}; 52 | disable_preview_modes(); 53 | stop_transport(); 54 | pager("Exiting preview/doodle mode"); 55 | } 56 | sub disable_preview_modes { 57 | undef $mode->{preview}; 58 | undef $mode->{doodle}; 59 | } 60 | 61 | sub master_on { 62 | 63 | return if $mode->mastering; 64 | 65 | # create mastering tracks if needed 66 | 67 | # we use hiding/unhiding status of Eq track to indicate 68 | # mastering mode, so no explicity use of $mode->{mastering} 69 | 70 | if ( ! $tn{Eq} ){ 71 | 72 | local $this_track; 73 | add_mastering_tracks(); 74 | add_mastering_effects(); 75 | } else { 76 | unhide_mastering_tracks(); 77 | map{ $ui->track_gui($tn{$_}->n) } @{$mastering->{track_names}}; 78 | } 79 | 80 | } 81 | sub master_off { 82 | return if ! $mode->mastering; 83 | hide_mastering_tracks(); 84 | map{ $ui->remove_track_gui($tn{$_}->n) 85 | } @{$mastering->{track_names}}; 86 | $this_track = $tn{Main} if grep{ $this_track->name eq $_} @{$mastering->{track_names}}; 87 | ; 88 | } 89 | 90 | sub add_mastering_tracks { 91 | 92 | map{ 93 | my $track = ::MasteringTrack->new( 94 | name => $_, 95 | rw => MON, 96 | group => 'Mastering', 97 | ); 98 | $ui->track_gui( $track->n ); 99 | 100 | } grep{ $_ ne 'Boost' } @{$mastering->{track_names}}; 101 | my $track = ::BoostTrack->new( 102 | name => 'Boost', 103 | rw => MON, 104 | group => 'Mastering', 105 | width => 2, 106 | source_type => undef, 107 | source_id => undef, 108 | ); 109 | $ui->track_gui( $track->n ); 110 | 111 | 112 | } 113 | 114 | 115 | sub add_mastering_effects { 116 | 117 | $this_track = $tn{Eq}; 118 | 119 | nama_cmd("add_effect $mastering->{fx_eq}"); 120 | 121 | $this_track = $tn{Low}; 122 | 123 | nama_cmd("add_effect $mastering->{fx_low_pass}"); 124 | nama_cmd("add_effect $mastering->{fx_compressor}"); 125 | nama_cmd("add_effect $mastering->{fx_spatialiser}"); 126 | 127 | $this_track = $tn{Mid}; 128 | 129 | nama_cmd("add_effect $mastering->{fx_mid_pass}"); 130 | nama_cmd("add_effect $mastering->{fx_compressor}"); 131 | nama_cmd("add_effect $mastering->{fx_spatialiser}"); 132 | 133 | $this_track = $tn{High}; 134 | 135 | nama_cmd("add_effect $mastering->{fx_high_pass}"); 136 | nama_cmd("add_effect $mastering->{fx_compressor}"); 137 | nama_cmd("add_effect $mastering->{fx_spatialiser}"); 138 | 139 | $this_track = $tn{Boost}; 140 | 141 | nama_cmd("add_effect $mastering->{fx_limiter}"); # insert after vol 142 | } 143 | 144 | sub unhide_mastering_tracks { 145 | nama_cmd("for Mastering; set_track hide 0 rw MON"); 146 | } 147 | 148 | sub hide_mastering_tracks { 149 | nama_cmd("for Mastering; set_track hide 1 rw OFF"); 150 | } 151 | } 152 | 153 | 1; 154 | __END__ 155 | -------------------------------------------------------------------------------- /src/Refresh_subs.pl: -------------------------------------------------------------------------------- 1 | ## refresh functions 2 | 3 | sub refresh_waveform_window { 4 | $gui->{wwcanvas}->delete('waveform',$_->name) for all_tracks(); 5 | my @playable = grep{ $_->play} user_tracks(); 6 | map{ $_->waveform->display() } @playable; 7 | configure_waveform_window(); 8 | generate_timeline( 9 | widget => $gui->{wwcanvas}, 10 | y_pos => 600, 11 | ); 12 | } 13 | sub height { $_[0] % 5 ? 5 : 10 } 14 | sub generate_timeline { 15 | my %args = @_; 16 | my $length = ecasound_iam('cs-get-length'); 17 | $length = int($length + 5.5); 18 | $args{seconds} = $length; 19 | my $pps = $config->{waveform_pixels_per_second}; 20 | for (0..$args{seconds}) 21 | { 22 | my $xpos = $_ * $pps; 23 | if ($_ % 10 == 0) 24 | { 25 | $args{widget}->createText( 26 | $xpos, $args{y_pos} - 20, 27 | -font => 'lucidasanstypewriter-bold-14', 28 | -text => $_, 29 | ); 30 | } 31 | $args{widget}->createLine( 32 | $xpos, $args{y_pos} - height($_), 33 | $xpos, $args{y_pos}, 34 | -fill => 'black', 35 | -width => 1, 36 | -tags => 'timelime' 37 | ); 38 | } 39 | 40 | } 41 | sub set_widget_color { 42 | my ($widget, $status) = @_; 43 | my %rw_foreground = ( REC => $gui->{_nama_palette}->{RecForeground}, 44 | PLAY => $gui->{_nama_palette}->{MonForeground}, 45 | MON => $gui->{_nama_palette}->{MonForeground}, 46 | OFF => $gui->{_nama_palette}->{OffForeground}, 47 | ); 48 | 49 | my %rw_background = ( REC => $gui->{_nama_palette}->{RecBackground}, 50 | PLAY => $gui->{_nama_palette}->{MonBackground}, 51 | MON => $gui->{_nama_palette}->{MonBackground}, 52 | OFF => $gui->{_nama_palette}->{OffBackground}); 53 | 54 | $widget->configure( -background => $rw_background{$status} ); 55 | $widget->configure( -foreground => $rw_foreground{$status} ); 56 | } 57 | sub refresh_group { 58 | # main group, in this case we want to skip null group 59 | logsub((caller(0))[3]); 60 | 61 | 62 | my $status; 63 | if ( grep{ $_->rec} 64 | map{ $tn{$_} } 65 | $bn{Main}->tracks ){ 66 | 67 | $status = REC 68 | 69 | }elsif( grep{ $_->play} 70 | map{ $tn{$_} } 71 | $bn{Main}->tracks ){ 72 | 73 | $status = PLAY 74 | 75 | }else{ 76 | 77 | $status = OFF } 78 | 79 | logit('::Refresh','debug', "group status: $status"); 80 | 81 | set_widget_color($gui->{group_rw}, $status); 82 | 83 | 84 | 85 | croak "some crazy status |$status|\n" if $status !~ m/rec|mon|off/i; 86 | #logit('::Refresh','debug', "attempting to set $status color: ", $take_color{$status}); 87 | 88 | set_widget_color( $gui->{group_rw}, $status) if $gui->{group_rw}; 89 | } 90 | sub refresh_track { 91 | 92 | my $ui = shift; 93 | my $n = shift; 94 | logsub((caller(0))[3]); 95 | 96 | my $rec_status = $ti{$n}->rec_status; 97 | logit('::Refresh','debug', "track: $n rec_status: $rec_status"); 98 | 99 | return unless $gui->{tracks}->{$n}; # hidden track 100 | 101 | # set the text for displayed fields 102 | 103 | $gui->{tracks}->{$n}->{rw}->configure(-text => $rec_status); 104 | $gui->{tracks}->{$n}->{ch_r}->configure( -text => 105 | $n > 2 106 | ? $ti{$n}->source 107 | : q() ); 108 | $gui->{tracks}->{$n}->{ch_m}->configure( -text => $ti{$n}->send); 109 | $gui->{tracks}->{$n}->{version}->configure(-text => $ti{$n}->current_version || ""); 110 | 111 | map{ set_widget_color( $gui->{tracks}->{$n}->{$_}, 112 | $rec_status) 113 | } qw(name rw ); 114 | 115 | set_widget_color( $gui->{tracks}->{$n}->{ch_r}, 116 | 117 | ($rec_status eq REC 118 | and $n > 2 ) 119 | ? REC 120 | : OFF); 121 | 122 | set_widget_color( $gui->{tracks}->{$n}->{ch_m}, 123 | $rec_status eq OFF 124 | ? OFF 125 | : $ti{$n}->send 126 | ? MON 127 | : OFF); 128 | } 129 | 130 | sub refresh { 131 | ::remove_riff_header_stubs(); 132 | map{ $ui->refresh_track($_) } map{$_->n} ::audio_tracks(); 133 | refresh_waveform_window() if $gui->{wwcanvas}; 134 | } 135 | ### end 136 | -------------------------------------------------------------------------------- /src/Log.p: -------------------------------------------------------------------------------- 1 | # ----------- Logging ------------ 2 | 3 | package ::Log; 4 | use Modern::Perl '2020'; 5 | our $VERSION = 1.0; 6 | use Log::Log4perl qw(get_logger :levels); 7 | use Exporter; 8 | use Carp qw(carp cluck confess croak); 9 | our @ISA = 'Exporter'; 10 | our @EXPORT_OK = qw(logit loggit logpkg logsub initialize_logger); 11 | our $appender; 12 | 13 | sub initialize_logger { 14 | my $cat_string = shift; 15 | 16 | my @all_cats = qw( 17 | [% qx(./emit_logging_categories) %] 18 | ); 19 | push @all_cats, 'ECI','SUB'; 20 | 21 | my %negate; 22 | %negate = map{ $_ => 1} map{ s/^#//; $_ } grep{ /^#/ } 23 | expand_cats(split q(,), $cat_string) if $cat_string; 24 | #say("negate\n",::json_out(\%negate)); 25 | 26 | my $layout = "[\%r] %c %m%n"; # backslash to protect from source filter 27 | my $logfile = $ENV{NAMA_LOGFILE}; 28 | $SIG{ __DIE__ } = sub { Carp::confess( @_ ) } if $cat_string; 29 | 30 | $appender = $logfile ? 'FILE' : 'STDERR'; 31 | $logfile //= "/dev/null"; 32 | 33 | my @cats; 34 | @cats = expand_cats(split ',', $cat_string) if $cat_string; 35 | #logpkg('debug',"initial logging categories: @cats"); 36 | #logpkg('trace',"all cats: @all_cats"); 37 | 38 | @cats = grep{ ! $negate{$_} } @all_cats if grep {$_ eq 'ALL'} @cats; 39 | 40 | #logpkg('debug',"Final logging categories: @cats"); 41 | 42 | my $conf = qq( 43 | #log4perl.rootLogger = DEBUG, $appender 44 | #log4perl.category.Audio.Nama = DEBUG, $appender 45 | 46 | # dummy entry - avoid no logger/no appender warnings 47 | log4perl.category.DUMMY = DEBUG, DUMMY 48 | log4perl.appender.DUMMY = Log::Log4perl::Appender::Screen 49 | log4perl.appender.DUMMY.layout = Log::Log4perl::Layout::NoopLayout 50 | 51 | # screen appender 52 | log4perl.appender.STDERR = Log::Log4perl::Appender::Screen 53 | log4perl.appender.STDERR.layout = Log::Log4perl::Layout::PatternLayout 54 | log4perl.appender.STDERR.layout.ConversionPattern = $layout 55 | 56 | # file appender 57 | log4perl.appender.FILE = Log::Log4perl::Appender::File 58 | log4perl.appender.FILE.filename = $logfile 59 | log4perl.appender.FILE.layout = Log::Log4perl::Layout::PatternLayout 60 | log4perl.appender.FILE.layout.ConversionPattern = $layout 61 | 62 | #log4perl.additivity.SUB = 0 # doesn't work... why? 63 | ); 64 | # add lines for the categories we want to log 65 | $conf .= join "\n", "", map{ cat_line($_)} @cats if @cats; 66 | #say $conf; 67 | Log::Log4perl::init(\$conf); 68 | return( { map { $_, 1 } @cats } ) 69 | } 70 | sub cat_line { "log4perl.category.$_[0] = DEBUG, $appender" } 71 | 72 | sub expand_cats { 73 | # Convert Module -> ::Module -> Audio::Nama::Module 74 | # Convert !Module -> !::Module -> !Audio::Nama::Module 75 | no warnings 'uninitialized'; 76 | my @cats = @_; 77 | map { s/^(#)?::/$1Audio::Nama::/; $_} # SKIP_PREPROC 78 | map { s/^(#)?/$1::/ unless /^::/ or /^#?ECI/ or /^#?SUB/ or /^ALL$/; $_ }# SKIP_PREPROC 79 | @cats; 80 | } 81 | { 82 | my %is_method = map { $_ => 1 } 83 | qw( trace debug info warn error fatal 84 | logwarn logdie 85 | logcarp logcroak logcluck logconfess); 86 | 87 | sub logit { 88 | my ($line_number, $category, $level, @message) = @_; 89 | #say qq($line_number, $category, $level, @message) ; 90 | #confess("first call to logit"); 91 | my $line_number_output = $line_number ? " (L $line_number) ": ""; 92 | cluck "illegal level: $level" unless $is_method{$level}; 93 | my $logger = get_logger($category); 94 | $logger->$level($line_number_output, @message); 95 | } 96 | } 97 | sub logsub { logit('SUB','debug',$_[0]) } 98 | 99 | *loggit = \&logit; # to avoid source filter on logit call below 100 | 101 | sub logpkg { 102 | my( $file, $line_no, $level, @message) = @_; 103 | # convert Effects.pm to Audio::Nama::Effects to support logpkg 104 | my $pkg = $file; 105 | ($pkg) = $file =~ m| ([^/]+)\.pm$ |x; 106 | $pkg //= "Dummy::Pkg"; 107 | $pkg = "Audio::Nama::$pkg"; # SKIP_PREPROC 108 | #say "category: $pkg"; 109 | logit ($line_no,$pkg,$level, @message) 110 | } 111 | 112 | 1; 113 | -------------------------------------------------------------------------------- /src/Wav.p: -------------------------------------------------------------------------------- 1 | package ::Wav; 2 | our $VERSION = 1.001; 3 | use ::Globals qw(:all); 4 | use ::Util qw(:all); 5 | use ::Assign qw(:all); 6 | use ::Util qw(join_path); 7 | use ::Log qw(logsub logpkg); 8 | use Memoize qw(memoize unmemoize); # called by code in ::Memoize.pm 9 | use warnings; 10 | no warnings qw(uninitialized); 11 | use Carp; 12 | 13 | use Role::Tiny; 14 | 15 | sub wav_length { 16 | my $track = shift; 17 | ::wav_length($track->full_path) 18 | } 19 | sub wav_format{ 20 | my $track = shift; 21 | ::wav_format($track->full_path) 22 | } 23 | sub wav_width { 24 | my $track = shift; 25 | no warnings 'uninitialized'; 26 | my ($depth,$width,$freq) = split ',', $track->wav_format; 27 | $width 28 | } 29 | sub wav_frequency { 30 | my $track = shift; 31 | no warnings 'uninitialized'; 32 | my ($depth,$width,$freq) = split ',', $track->wav_format; 33 | $freq 34 | } 35 | sub dir { 36 | my $self = shift; 37 | $self->project 38 | ? join_path(::project_root(), $self->project, '.wav') 39 | : ::this_wav_dir(); 40 | } 41 | 42 | sub basename { 43 | my $self = shift; 44 | $self->target || $self->name 45 | } 46 | 47 | sub full_path { my $track = shift; join_path($track->dir, $track->current_wav) } 48 | 49 | sub group_last { 50 | my $track = shift; 51 | my $bus = $bn{$track->group}; 52 | $bus->last; 53 | } 54 | 55 | sub last { $_[0]->versions->[-1] || 0 } 56 | sub current_wav { 57 | my $track = shift; 58 | my $last = $track->current_version; 59 | if ($track->rec){ 60 | $track->name . '_' . $last . '.wav' 61 | } elsif ( $track->rw ne MON){ 62 | my $filename = $track->targets->{ $track->playback_version } ; 63 | $filename 64 | } else { 65 | logpkg('debug', "track ", $track->name, ": no current version") ; 66 | undef; 67 | } 68 | } 69 | 70 | sub current_version { 71 | my $track = shift; 72 | 73 | # two possible version numbers, depending on REC/PLAY status 74 | 75 | if ($track->{rw} eq REC) 76 | { 77 | my $last = $config->{use_group_numbering} 78 | ? ::Bus::overall_last() 79 | : $track->last; 80 | return ++$last 81 | } 82 | elsif ($track->{rw} ne MON){ return $track->playback_version } 83 | else { return 0 } 84 | } 85 | 86 | sub playback_version { 87 | my $track = shift; 88 | return $track->version if $track->version 89 | and grep {$track->version == $_ } @{$track->versions} ; 90 | $track->last; 91 | } 92 | sub targets { # WAV file targets, distinct from 'target' attribute 93 | my $self = shift; 94 | _targets(dir => $self->dir, name => $self->basename) 95 | } 96 | sub versions { 97 | my $self = shift; 98 | _versions(dir => $self->dir, name => $self->basename) 99 | } 100 | 101 | 102 | sub get_versions { 103 | my %args = @_; 104 | $args{sep} //= '_'; 105 | $args{ext} //= 'wav'; 106 | my ($sep, $ext) = ($args{sep}, $args{ext}); 107 | my ($dir, $basename) = ($args{dir}, $args{name}); 108 | logpkg('debug',"getver: dir $dir basename $basename sep $sep ext $ext"); 109 | my %versions = (); 110 | for my $candidate ( candidates($dir) ) { 111 | # logpkg('debug',"candidate: $candidate"); 112 | 113 | my( $match, $dummy, $num) = 114 | ( $candidate =~ m/^ ( $basename 115 | ($sep (\d+))? 116 | \.$ext ) 117 | $/x 118 | ); # regex statement 119 | if ( $match ) { $versions{ $num || 'bare' } = $match } 120 | } 121 | logpkg('debug',sub{"get_version: " , ::json_out(\%versions)}); 122 | %versions; 123 | } 124 | 125 | sub candidates { 126 | my $dir = shift; 127 | $dir = File::Spec::Link->resolve_all( $dir ); 128 | opendir my $wavdir, $dir or die "cannot open $dir: $!"; 129 | my @candidates = readdir $wavdir; 130 | closedir $wavdir; 131 | @candidates = grep{ ! (-s join_path($dir, $_) == 44 ) } @candidates; 132 | #logpkg('debug',join $/, @candidates); 133 | @candidates; 134 | } 135 | 136 | sub _targets { 137 | 138 | my %args = @_; 139 | 140 | # $::debug2 and print "&targets\n"; 141 | 142 | my %versions = get_versions(%args); 143 | if ($versions{bare}) { $versions{1} = $versions{bare}; 144 | delete $versions{bare}; 145 | } 146 | logpkg('debug',sub{"\%versions\n================\n", json_out(\%versions)}); 147 | \%versions; 148 | } 149 | 150 | sub _versions { 151 | # $::debug2 and print "&versions\n"; 152 | my %args = @_; 153 | [ sort { $a <=> $b } keys %{ _targets(%args)} ] 154 | } 155 | 1; 156 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | =head1 NAME 2 | 3 | Nama - digital audio workstation 4 | 5 | =head1 DESCRIPTION 6 | 7 | Nama is a digital audio workstation. It is suitable for 8 | multitrack recording, effects-processing, editing, mixing, 9 | and other audio tasks. Nama uses Ecasound, developed by Kai 10 | Vehmanen, for audio processing. Nama hosts LADSPA and LV2 11 | plugins, Ecasound effects and controllers. It works well 12 | under JACK and ALSA. 13 | 14 | New projects begin with a mixer, and may include tracks 15 | (multiple takes), buses, effects, sends, inserts, 16 | marks, regions, fades, edits, sequences and submixes, with 17 | mixdown to wav, ogg, mp3, etc. 18 | 19 | Nama has a full-featured command interpreter with TAB 20 | completion, keyword help and command history; a hotkey mode 21 | for tweaking effect parameters, a Tk-based GUI, and project 22 | management (history, branching, tags) based on git. Users 23 | can define command aliases, custom commands, and key 24 | bindings for the hotkey mode. 25 | 26 | The help system provides searchable access to documentation 27 | for all Nama commands and shortcuts, and for LADSPA, LV2 and 28 | Ecasound effects. In addition to executing its own commands, 29 | Nama will pass commands to Ecasound, Midish, the perl 30 | interpreter and the shell. 31 | 32 | Nama has several templating options for project reuse: 33 | Effect chains are presets for one or more effects. Effect 34 | profiles (used to create Nama's mastering network) are 35 | templates for placing effects on multiple tracks. User 36 | scripting provides another way to reuse functionality. 37 | 38 | Nama's GUI will display if Tk is available. Nama can spawn 39 | Audacity or MHWaveedit to view/edit selected waveforms. 40 | 41 | =head2 Project management 42 | 43 | Project state is serialized as JSON files and the entire 44 | project history is managed by Git. Projects can be branched, 45 | tagged, and easily restored to earlier states. 46 | 47 | =head2 Project reuse 48 | 49 | Three types of templates are available to reuse project 50 | components: effect chains, effect profiles, and project 51 | templates. An effect chain is a series of effects with 52 | parameters. An effect profile includes one or more tracks 53 | with their effects and inserts. Nama's mastering network is 54 | stored as an effect profile. Project templates duplicate an 55 | entire project without audio files. 56 | 57 | =head1 INSTALLATION 58 | 59 | =head2 Installing Nama and its Perl Dependencies from CPAN 60 | 61 | The following command will install Nama, automatically 62 | pulling in all Perl modules required to run Nama in text mode: 63 | 64 | cpanm Audio::Nama 65 | 66 | However if you don't have cpanm, this should still work: 67 | 68 | PERL_MM_USE_DEFAULT=1 cpan Audio::Nama 69 | 70 | To use the GUI, you will need to install Tk: 71 | 72 | cpanm Tk 73 | 74 | You may optionally install Audio::Ecasound to run Ecasound 75 | via libecasoundc: 76 | 77 | cpanm Audio::Ecasound 78 | 79 | You can browse the sources or download a tarball via: 80 | 81 | http://search.cpan.org/dist/Audio-Nama 82 | 83 | =head2 Building from Source 84 | 85 | If you want to inspect or modify Nama's internals, or keep 86 | up with new developments, you can pull the source code as 87 | follows: 88 | 89 | git clone git://github.com/bolangi/nama.git 90 | 91 | Consult the F file for build instructions. 92 | 93 | =head2 Non-Perl Dependencies 94 | 95 | The Ecasound audio processing libraries should be installed. 96 | Ecasound should be compiled with support for LADSPA, libsndfile, 97 | libsamplerate and JACK. Ecasound may be obtained from 98 | http://ecasound.seul.org/ecasound/ or as precompiled binary 99 | package for your Un*x distribution. 100 | 101 | The LADSPA SDK is required to autosense LADSPA plugins and 102 | scaling hints. It is available at: 103 | 104 | http://www.ladspa.org/ladspa_sdk/download.html 105 | 106 | In particular the utility program 'analyseplugin' must be 107 | installed in a directory in your execution PATH. 108 | 109 | Nama's mastering mode uses a number of LADSPA plugins 110 | in a reasonably flat starting configuration. 111 | provided that the user installs the plugins 112 | listed in the default configuration file .namarc. 113 | 114 | Git is required to utilize Nama's project 115 | management and and undo features. 116 | 117 | =head2 COPYRIGHT 118 | 119 | Unless specified otherwise, this code is 120 | 2003 - 2014, copyright Joel Roth 121 | 122 | All rights are reserved except as provided by the Gnu Public 123 | License, version 3, as detailed in the file COPYING provided 124 | with this distribution. 125 | -------------------------------------------------------------------------------- /src/preproc: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | # 3 | # Run 'myproc' to preprocess Nama sources and generate Audio::Nama distribution 4 | # 5 | # - source filtering to change ::foo to Audio::Nama::foo 6 | # - include files and the output of scripts 7 | # 8 | # special cases: 9 | # Do NOT convert the following: 10 | # 11 | # ${$pkg}::IO # close bracket before :: 12 | # "$class\::IO" # backslash before :: 13 | # /::from/::to/ # slash before :: 14 | # qw( :: ::main main:: ) # SKIP_PREPROC # directive 15 | # 16 | 17 | use Text::Template; 18 | use Getopt::Std; 19 | use File::Find; 20 | use File::Slurp; 21 | use strict; 22 | use Cwd; 23 | use Storable qw(dclone); 24 | 25 | my( 26 | %opts, 27 | $source_dir, 28 | $target_dir, 29 | $new_root, 30 | $file, 31 | $exta , 32 | $extb , 33 | $stub , 34 | $template , 35 | $filename, 36 | ); 37 | 38 | my $debug = 0; 39 | getopts('ds:t:f:r:a:b:', \%opts); 40 | $source_dir = $opts{s}; 41 | $new_root = $opts{r}; 42 | $target_dir = $opts{t}; 43 | $exta = $opts{a}; 44 | $extb = $opts{b}; 45 | $file = $opts{f}; 46 | $debug = $opts{d}; 47 | 48 | $debug and print <new( 69 | TYPE => 'FILE', 70 | SOURCE => $file_in, 71 | DELIMITERS => [ qw( [% %] ) ], 72 | ); 73 | my $template_dump = dclone($template); 74 | delete $template_dump->{SOURCE}; 75 | use Data::Dumper::Concise; 76 | $debug and print "Text::Template object (with source omitted) is:\n", Dumper $template_dump; 77 | my $hash = {name => 'goblin' }; 78 | 79 | #### Include files and process code in [% %] directives 80 | 81 | my $text = $template->fill_in(HASH=>$hash); 82 | 83 | #### Convert ::Something to Audio::Nama::Something 84 | 85 | my $rooted_text = &expand_root($new_root,$text); 86 | 87 | #### Hack arguments to logging subroutines 88 | 89 | $rooted_text =~ s/logit\(/logit(__LINE__,/g; 90 | $rooted_text =~ s/logpkg\(/logpkg(__FILE__,__LINE__,/g; 91 | 92 | # we are going to standardize on using :: as the 93 | # root package name, so that coding will be 94 | # separate from the final place in the hierarchy. 95 | # ::, ::Text will be translated to Audio::Nama, # Audio::Nama::Text 96 | # after the file includes 97 | 98 | if ( $file_out ) { write_file($file_out, $rooted_text) } 99 | else { print $rooted_text } 100 | } 101 | sub expand_root { 102 | my ($new_root, $text) = @_; 103 | join "\n",map{ 104 | s/([^\w\}\\\/]|^)(::)([\w:])/$1$new_root$2$3/g unless /SKIP_PREPROC/; 105 | s/([^\w\}\\\/]|^)(::)([^\w])/$1$new_root$3/mg unless /SKIP_PREPROC/; 106 | $_; 107 | } split "\n",$text; 108 | } 109 | 110 | sub find_and_process { 111 | my ($source_dir, $target_dir, $exta, $extb) = @_; 112 | find(\&wanted, $source_dir); 113 | } 114 | 115 | sub wanted { 116 | return if grep { $File::Find::name =~ m(/$_/) } 117 | map{"/$_/"}qw(.git .ttree blib lib try t); 118 | my $re = qr/(\w+)\.$exta$/; 119 | $File::Find::name =~ /$re/ or return; 120 | $stub = $1; 121 | $debug and print $File::Find::name, $/; 122 | $debug and print "stub: $stub\n"; 123 | $debug and print "cwd: ", getcwd, $/; 124 | my $input = "$stub.$exta"; 125 | my $output = "$target_dir/$stub.$extb"; 126 | 127 | ## now to process 128 | 129 | &process($input, $output); 130 | 131 | } 132 | sub grammar { 133 | 134 | $debug and print "grammar replace\n"; 135 | 136 | my $list = io('commands')->all; 137 | 138 | my $body = io('grammar_body')->all; 139 | $body =~ s/::/Audio::Ecasound::Flow::/g; 140 | 141 | my (@abbrevs, @stubs, @commands); 142 | 143 | map{ 144 | 145 | my @parts = my @all_parts = split " ", $_; 146 | my $full = shift @parts; 147 | my @short = @parts; 148 | push @abbrevs, "_$full: " . join (" | " , @all_parts); 149 | push @stubs, "$full: _$full {}"; 150 | push @commands, "command: $full"; 151 | 152 | } split "\n", $list; 153 | 154 | my $command_headers = join "\n", @commands, @abbrevs, @stubs ; 155 | 156 | { 157 | commands => $command_headers, 158 | grammar_body => $body, 159 | }; 160 | 161 | } 162 | __END__ 163 | 164 | -------------------------------------------------------------------------------- /src/var_namarc: -------------------------------------------------------------------------------- 1 | ############ var_config - Nama's configuration variables 2 | 3 | # namarc file variable nama internal variable 4 | # --------------------- ------------------------- 5 | 6 | # [external resources] 7 | 8 | %devices $config->{devices} 9 | $alsa_playback_device $config->{alsa_playback_device} 10 | $alsa_capture_device $config->{alsa_capture_device} 11 | $soundcard_channels $config->{soundcard_channels} 12 | 13 | # [audio formats] 14 | 15 | %abbreviations $config->{abbreviations} 16 | $mix_to_disk_format $config->{mix_to_disk_format} 17 | $raw_to_disk_format $config->{raw_to_disk_format} 18 | $cache_to_disk_format $config->{cache_to_disk_format} 19 | $mixer_out_format $config->{mixer_out_format} 20 | $sample_rate $config->{sample_rate} 21 | 22 | # [engine] 23 | 24 | $ecasound_tcp_port $config->{engine_tcp_port} 25 | $ecasound_globals $config->{ecasound_globals} 26 | $ecasound_buffersize $config->{engine_buffersize} 27 | $realtime_profile $config->{realtime_profile} 28 | $jack_seek_delay $config->{engine_base_jack_seek_delay} 29 | $jack_transport_mode $config->{jack_transport_mode} 30 | $ecasound_jack_client_name $config->{ecasound_jack_client_name} 31 | $ecasound_engine_name $config->{ecasound_engine_name} 32 | 33 | # [midi] 34 | 35 | $midi_engine_name $config->{midi_engine_name} 36 | $use_midi $config->{use_midi} 37 | $midi_record_buffer $config->{midi_record_buffer} 38 | $midi_default_input_channel $config->{midi_default_input_channel} 39 | 40 | # [mastering] 41 | 42 | $eq $mastering->{fx_eq} 43 | $low_pass $mastering->{fx_low_pass} 44 | $mid_pass $mastering->{fx_mid_pass} 45 | $high_pass $mastering->{fx_high_pass} 46 | $compressor $mastering->{fx_compressor} 47 | $spatialiser $mastering->{fx_spatialiser} 48 | $limiter $mastering->{fx_limiter} 49 | 50 | # [other] 51 | 52 | $project_root $config->{root_dir} 53 | $use_group_numbering $config->{use_group_numbering} 54 | $press_space_to_start_transport $config->{press_space_to_start} 55 | $execute_on_project_load $config->{execute_on_project_load} 56 | $initial_mode $config->{initial_mode} 57 | $quietly_remove_tracks $config->{quietly_remove_tracks} 58 | $use_jack_plumbing $config->{use_jack_plumbing} 59 | $use_playback_version_for_mixdown $config->{sync_mixdown_and_playback_version_numbers} 60 | $mixdown_encodings $config->{mixdown_encodings} 61 | $volume_control_operator $config->{volume_control_operator} 62 | $serialize_formats $config->{serialize_formats} 63 | $use_git $config->{use_git} 64 | $eager $mode->{eager} 65 | $waveform_height $config->{waveform_height} 66 | 67 | $alias $config->{alias} 68 | $hotkeys $config->{hotkeys} 69 | $new_track_rw $config->{new_track_rw} 70 | 71 | ### other 72 | 73 | $playback_jump_seconds $config->{playback_jump_seconds} 74 | $mark_bump_seconds $config->{mark_bump_seconds} 75 | $mark_replay_seconds $config->{mark_replay_seconds} 76 | $seek_end_margin $config->{seek_end_margin} 77 | 78 | 79 | $use_pager $config->{use_pager} 80 | $use_placeholders $config->{use_placeholders} 81 | 82 | $edit_playback_end_margin $config->{edit_playback_end_margin} 83 | $edit_crossfade_time $config->{edit_crossfade_time} 84 | $default_fade_length $config->{engine_fade_default_length} 85 | $fade_time $config->{engine_fade_length_on_start_stop} 86 | 87 | %mute_level $config->{mute_level} 88 | %fade_out_level $config->{fade_out_level} 89 | $fade_resolution $config->{fade_resolution} 90 | %unity_level $config->{unity_level} 91 | 92 | $enforce_channel_bounds $config->{enforce_channel_bounds} 93 | 94 | # currently unused 95 | 96 | $midi_input_dev $midi->{input_dev} 97 | $midi_output_dev $midi->{output_dev} 98 | $controller_ports $midi->{controller_ports} 99 | $midi_inputs $midi->{inputs} 100 | 101 | 102 | $osc_listener_port $config->{osc_listener_port} 103 | $osc_reply_port $config->{osc_reply_port} 104 | $remote_control_port $config->{remote_control_port} 105 | $engines $config->{engines} 106 | 107 | $default_waveform_height $config->{default_waveform_height} 108 | $loop_chain_channel_width $config->{loop_chain_channel_width} 109 | $waveform_pixels_per_second $config->{waveform_pixels_per_second} 110 | $display_waveform $config->{display_waveform} 111 | 112 | $ticks_per_quarter_note $config->{ticks_per_quarter_note} 113 | 114 | $use_metronome $config->{use_metronome} 115 | 116 | %beep $config->{beep} 117 | 118 | 119 | # end 120 | 121 | -------------------------------------------------------------------------------- /src/emit_command_headers: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use Modern::Perl; 3 | use Carp; 4 | no warnings "uninitialized"; 5 | my $debug = 0; 6 | my (@commands, @abbrevs); 7 | use File::Slurp; 8 | use YAML::Tiny; 9 | 10 | my $output = shift @ARGV; 11 | 12 | my $in = qx(cat ./commands.yml); 13 | 14 | # preserve order for generating docs 15 | 16 | my @keys = $in =~ /^(\w+)/mg; 17 | my @types = $in =~ /^ type: (\w+)/mg; 18 | #print "$_\n" for @keys; 19 | #print "$_\n" for @types; 20 | 21 | 22 | # read in data structure 23 | 24 | my $ref = yaml_in( $in); 25 | # use hyphenated commands in pod, converting from underscore 26 | if ( $output eq 'pod' ) 27 | { 28 | s/_/-/g for @keys; 29 | my @cmds = keys %$ref; 30 | push @cmds, map{ grep{/_/} split ' ', $_->{short} } grep { $_->{short} } values %$ref; 31 | my @underscore = grep{ /_/ } @cmds; 32 | @underscore = reverse sort { length $a <=> length $b } sort { $a cmp $b } @underscore; 33 | #say for @underscore; exit; 34 | my @hyphen = @underscore; 35 | $_ =~ s/_/-/g for @hyphen; 36 | my $hyp = $in; 37 | my ($from, $to); 38 | for (0 .. $#hyphen){ 39 | $from = $underscore[$_]; 40 | $to = $hyphen[$_]; 41 | #say "from $from, to $to"; 42 | $hyp =~ s/$from/$to/g; 43 | } 44 | undef $ref; 45 | $ref = yaml_in( $hyp); 46 | 47 | } 48 | 49 | =comment testing for missing definitions 50 | 51 | my %body; 52 | my $cmd = q(perl -ne '/^(\w+):/ and print "$1\n"' grammar_body.pl | uniq); 53 | map{ $body{$_}++ } split " ", qx($cmd); 54 | 55 | map{ $ref->{$_} or print "$_\n" } keys %body; 56 | print "\n----\n"; 57 | map{ $body{$_} or print "$_\n" } keys %{$ref}; 58 | exit; 59 | 60 | =cut 61 | 62 | # generate command headers 63 | 64 | if ($output eq 'headers'){ 65 | 66 | map { my $func = $_; 67 | my @parts = ($func, split " ", $ref->{$func}->{short}); 68 | my @all_parts = @parts; 69 | my $full = shift @parts; 70 | my @short = @parts; 71 | my $end_anchor = "end"; 72 | my $grammar_entry = "_$full: " . join(" | " , add_break(@all_parts)) . qq( { "$full" } ); 73 | push @abbrevs, $grammar_entry; 74 | #push @stubs, "$full: _$full $end_anchor { 1 }"; 75 | push @commands, "command: $full"; 76 | } @keys; 77 | print join "\n", @commands, @abbrevs ; 78 | 79 | } 80 | 81 | # generate command pod 82 | 83 | elsif ($output eq 'pod'){ 84 | my $previous_type = q(); 85 | 86 | map{ 87 | 88 | # insert new category head if needed 89 | 90 | my $type = $ref->{$_}->{type}; 91 | 92 | if ( $type ne $previous_type ){ 93 | $previous_type = $type; 94 | print "=head2 ", ucfirst $type, " commands\n\n"; 95 | } 96 | my $short = $ref->{$_}->{short}; 97 | $short = "($short) " if $short; 98 | print "=head4 B<$_> $short- ", ucfirst $ref->{$_}->{what}, "\n\n"; 99 | 100 | my $param = q(); 101 | $param = $ref->{$_}->{parameters} 102 | unless $ref->{$_}->{parameters} eq 'none'; 103 | print "=over 8\n\n"; 104 | print "$_ $param\n\n"; 105 | 106 | if (my $example = $ref->{$_}->{example}){ 107 | 108 | # convert literal !n to double newlines 109 | # add C<> tags to command text 110 | 111 | $example = munge_help($example); 112 | #$example = "C<$example>"; 113 | 114 | print "$example\n\n"; 115 | } 116 | print "=back\n\n"; 117 | } @keys; 118 | 119 | } else { die "$0: parameter 'headers' or 'pod' required" } 120 | 121 | sub munge_help { 122 | my $text = shift; 123 | $text =~ s/(^\s*)!(\s*#)/$1 $2/mg; 124 | $text =~ s/(^\s*!)/#/mg; 125 | $text 126 | } 127 | 128 | sub yaml_in { 129 | 130 | # $debug2 and print "&yaml_in\n"; 131 | my $input = shift; 132 | my $yaml = $input =~ /\n/ # check whether file or text 133 | ? $input # yaml text 134 | : read_file($input); # file name 135 | if ($yaml =~ /\t/){ 136 | croak "YAML file: $input contains illegal TAB character."; 137 | } 138 | $yaml =~ s/^\n+// ; # remove leading newline at start of file 139 | $yaml =~ s/\n*$/\n/; # make sure file ends with newline 140 | $yaml = quote_yaml_scalars($yaml); 141 | my $y = YAML::Tiny->read_string($yaml); 142 | die "YAML::Tiny read error: $YAML::Tiny::errstr\n" if $YAML::Tiny::errstr; 143 | $y->[0]; 144 | } 145 | sub quote_yaml_scalars { 146 | my $yaml = shift; 147 | my @modified; 148 | map 149 | { 150 | chomp; 151 | if( /^(?(\s*\w+: )|(\s+- ))(?.+)$/ ){ 152 | my($beg,$end) = ($+{beg}, $+{end}); 153 | # quote if contains colon and not quoted 154 | if ($end =~ /:\s/ and $end !~ /^('|")/ ){ 155 | $end =~ s(')(\\')g; # escape existing single quotes 156 | $end = qq('$end') } # single-quote string 157 | push @modified, "$beg$end\n"; 158 | } 159 | else { push @modified, "$_\n" } 160 | } split "\n", $yaml; 161 | join "", @modified; 162 | } 163 | 164 | 165 | sub add_break { map{ qq(/$_\\b/) } @_ } 166 | -------------------------------------------------------------------------------- /src/Contents: -------------------------------------------------------------------------------- 1 | Contents of nama/src directory 2 | 3 | Core classes (converted to .pm files under nama/lib) 4 | 5 | 175 Bus.p - buses 6 | 247 Edit.p - edits 7 | 319 Fade.p - fades 8 | 298 Graph.p - routing graph 9 | 49 Group.p - base class for Bus.p 10 | 369 IO.p - generate Ecasound chain setup input and outputs 11 | 273 Insert.p - inserts 12 | 137 Mark.p - marks 13 | 137 Object.p - base class for all objects 14 | 988 Track.p - tracks 15 | 70 Wav.p - base class for Track.p 16 | 194 Graphical.p - GUI methods and subs 17 | 1332 Graphical_subs.pl - merged into above 18 | 112 Refresh_subs.pl - merged into above 19 | 108 Text.p - Text UI methods and subs 20 | 509 Text_methods.pl - merged into above 21 | 22 | Object Attributes (with comments) 23 | 24 | 8 bus_fields 25 | 33 io_fields 26 | 73 track_fields 27 | 28 | More core code, merged into Nama.p to make Nama.pm 29 | 30 | 365 Nama.p 31 | 10 banner.pl 32 | 320 Core_subs.pl 33 | 334 declarations.pl 34 | 1095 grammar_body.pl 35 | 388 help_topic.pl 36 | 135 var_types.pl 37 | 38 | Functional sections, recently separated into modules 39 | 40 | 252 CacheTrack.p - for track-level mixdown (track freezing) 41 | 505 ChainSetup.p - generates chain setup 42 | 95 Bus_subs.p - functions using bus objects 43 | 202 Config_subs.p - read namarc 44 | 687 Edit_subs.p - editing functions 45 | 181 Effect_chain_subs.p - effect chains and profiles 46 | 1221 Effect_subs.p - effects and controllers 47 | 346 Engine_setup_subs.p - prepare for engine run 48 | 68 Engine_cleanup_subs.p - processing after engine run 49 | 306 Initialize_subs.p - Nama startup 50 | 214 Jack_subs.p - JACK related code 51 | 140 Mark_and_jump_subs.p - marks and playback repositioning 52 | 52 Memoize_subs.p - cache the results of track and setup routines 53 | 66 Midi_subs.p - stub for future expansion (starts midish) 54 | 170 Mode_subs.p - mastering, preview, doodle 55 | 155 Mute_Solo_Fade.p - changes track and main volume during engine run 56 | 89 Option_subs.p - process command-line options 57 | 615 Persistence.p - save and restore project state 58 | 376 Project_subs.p - manage projects and project templates 59 | 209 Realtime_subs.p - manage the Ecasound engine run 60 | 42 Region_subs.p - manage regions 61 | 178 Terminal_subs.p - terminal control 62 | 141 Track_subs.p - adding and removing tracks 63 | 72 Wavinfo_subs.p - cache length and modification time 64 | 65 | Utility routines 66 | 67 | 376 Assign.p - serialization support functions 68 | 255 Util.p 69 | 70 | Data files 71 | 72 | 931 commands.yml - for grammar and docs 73 | 494 ecasound_chain_operator_hints.yml - used by GUI 74 | 30 palette.yml - default GUI colors 75 | 165 namarc - default config file 76 | 84 custom.pl - example custom commands 77 | 78 | Documentation 79 | 80 | 660 man_page_part1 81 | 77 man_page_part2 82 | 83 | Tests 84 | 85 | 72 02_assign.t 86 | 15 03_wav.t 87 | 29 04_object.t 88 | 24 11_mark.t 89 | 730 12_nama.t 90 | 23 13_io.t 91 | 92 | User scripts for preprocessing, run and test 93 | 94 | 27 myproc - preprocess (drives preproc) 95 | 32 build - preprocess; perl Makefile.PL (before make) 96 | 1 mui - preprocess and run (without make) 97 | 6 ui - run 98 | 2 mtest - preprocess and run test suite 99 | 100 | Preprocessing scripts 101 | 102 | 149 preproc - merges files and adds namespace prefix 103 | 2 makeman - generates man pages in ROFF and HTML 104 | 16 strip_all - strip comments and blank lines 105 | 5 strip_comments - strip comments 106 | 119 emit_command_headers - generates grammar and docs from commands_yml 107 | 6 add_tracked_vars - extract @tracked_vars from var_types.pl 108 | 6 add_vars - remove comments from declarations.pl 109 | 110 | Variable tracing 111 | 112 | 37 sort_vars - output to variables.sorted.txt 113 | 44 vars.bysub - locate and count variables 114 | 311 vars.count - ditto 115 | 322 vars.sub - ditto 116 | 117 | Other scripts 118 | 119 | 4 list_all_subs 120 | 39 list_calls 121 | 19 list_subs 122 | 2 make_stubs 123 | 1 linecountnocomments 124 | 1 linecount 125 | 126 | 127 | 128 | -- 129 | Joel Roth 130 | -------------------------------------------------------------------------------- /src/Waveform.p: -------------------------------------------------------------------------------- 1 | package ::Waveform; 2 | use ::Globals qw($project $config $gui %ti); 3 | use ::Util qw(join_path); 4 | use Modern::Perl '2020'; 5 | use Try::Tiny; 6 | use vars qw(%by_name); 7 | use ::Object qw(wav track project start end); 8 | 9 | # * objects of this class represent a waveform display 10 | # * each object is associated with an audio file 11 | # * object will find or generate PNG for the audio 12 | # * will display waveform 13 | # + if shift, correctly position PNG 14 | # + if region, trim the PNG existing for the track 15 | 16 | # the $track->waveform method will create a new object of this class 17 | # we will memoize since it remains constant between reconfigures 18 | 19 | # keyed to the 20 | # + name of the WAV file 21 | # + name of project 22 | # + start and end times 23 | 24 | # the get_png() method will find or generate the appropriate PNG 25 | 26 | 27 | # files are of the form # sax_1.wav.1200x200-10.png 28 | # where the numbers correspond to width and height in pixels of the audio 29 | # waveform image, and the x-scaling in pixels per second (default 10) 30 | 31 | sub new { 32 | my $class = shift; 33 | my %args = @_; 34 | bless \%args, $class 35 | } 36 | 37 | sub generate_waveform { 38 | my $self = shift; 39 | my ($width, $height, $pixels_per_second) = @_; 40 | $pixels_per_second //= $config->{waveform_pixels_per_second}; 41 | $height //= $config->{waveform_height}; 42 | $width //= int( $self->track->wav_length * $pixels_per_second); 43 | my $name = waveform_name($self->track->full_path, $width, $height, $pixels_per_second); 44 | my $cmd = join ' ', 'waveform', "-b #c2d6d6 -c #0080ff -W $width -H $height", $self->track->full_path, $name; 45 | say $cmd; 46 | system($cmd); 47 | $name; 48 | } 49 | 50 | # utility subroutine 51 | sub waveform_name { 52 | my($path, $width, $height, $pixels, $start, $end) = @_; 53 | "$path." . $width . 'x' . "$height-$pixels" . region_def($start,$end) . ".png" 54 | } 55 | sub region_def {} 56 | sub find_waveform { 57 | 58 | my $self = shift; 59 | my $match = shift() // '*'; 60 | my @files = File::Find::Rule->file() 61 | ->name( $self->wav . ".$match.png" ) 62 | ->in( ::this_wav_dir() ); 63 | @files; 64 | } 65 | sub get_waveform { 66 | my $self = shift; 67 | my ($waveform) = $self->find_waveform; 68 | $waveform or $self->generate_waveform; 69 | } 70 | sub display { 71 | my $self = shift; 72 | my ($waveform) = $self->get_waveform; 73 | my $widget = $gui->{ww}->Photo(-format => 'png', -file => $waveform); 74 | $gui->{waveform}{$self->track->name} = []; # unused? 75 | $gui->{wwcanvas}->createImage( 0, 76 | $self->y_offset_multiplier * $config->{waveform_height}, 77 | -anchor => 'nw', 78 | -tags => ['waveform', $self->track->name], 79 | -image => $widget); 80 | my ($width, $height) = ::wh($gui->{ww}); 81 | my $name_x = $width - 150; 82 | my $name_y = $config->{waveform_height} * $self->y_offset_multiplier + 20; 83 | $gui->{wwcanvas}->createText( $name_x, $name_y, -font => 84 | 'lucidasanstypewriter-bold-14', -text => uc($self->track->name) . ' - '.$self->track->current_wav); 85 | } 86 | sub width { 87 | my $self = shift; 88 | my ($waveform) = $self->get_waveform; 89 | my ($width, $height, $pixels_per_second) = $waveform =~ /(\d+)x(\d+)-(\d+)/ 90 | or ::throw("cannot parse waveform filename: $waveform"); 91 | $width 92 | } 93 | sub height { 94 | my $self = shift; 95 | my ($waveform) = $self->get_waveform; 96 | my ($width, $height, $pixels_per_second) = $waveform =~ /(\d+)x(\d+)-(\d+)/ 97 | or ::throw("cannot parse waveform filename: $waveform"); 98 | $height 99 | } 100 | sub pixels_per_second { 101 | my $self = shift; 102 | my ($waveform) = $self->get_waveform; 103 | my ($width, $height, $pixels_per_second) = $waveform =~ /(\d+)x(\d+)-(\d+)/ 104 | or ::throw("cannot parse waveform filename: $waveform"); 105 | $pixels_per_second 106 | } 107 | sub y_offset_multiplier { 108 | my $self = shift; 109 | my $before_me; 110 | for (2 .. $self->track->n - 1){ 111 | $before_me++ if $ti{$_} and $ti{$_}->play; 112 | } 113 | $before_me 114 | } 115 | 116 | 1 # obligatory 117 | 118 | __END__ 119 | =comment 120 | Usage: waveform [options] source_audio [ouput.png] 121 | -W, --width WIDTH Width (in pixels) of generated waveform image -- Default 1800. 122 | -H, --height HEIGHT Height (in pixels) of generated waveform image -- Default 280. 123 | -c, --color COLOR Color (hex code) to draw the waveform. Can also pass 'transparent' to cut it out of the background -- Default #00ccff. 124 | -b, --background COLOR Background color (hex code) to draw waveform on -- Default #666666. 125 | -m, --method METHOD Wave analyzation method (can be 'peak' or 'rms') -- Default 'peak'. 126 | -q, --quiet Don't print anything out when generating waveform 127 | -F, --force Force generationg of waveform if file exists 128 | -h, --help Display this screen 129 | 130 | =cut 131 | 132 | -------------------------------------------------------------------------------- /src/Help.p: -------------------------------------------------------------------------------- 1 | # -------------------- Help ---------------------- 2 | 3 | package ::; 4 | use Modern::Perl '2020'; 5 | 6 | { 7 | no warnings 'uninitialized'; 8 | sub helpline { 9 | my $cmd = shift; 10 | my $out = "Command: $cmd\n"; 11 | $out .= "Shortcuts: $text->{commands}->{$cmd}->{short}\n" 12 | if $text->{commands}->{$cmd}->{short}; 13 | $out .= "Category: $text->{commands}->{$cmd}->{type}\n"; 14 | my $what = munge_help($text->{commands}->{$cmd}->{what}); 15 | $out .= "Description: $what"; 16 | $out .= "Usage: $cmd "; 17 | 18 | if ( $text->{commands}->{$cmd}->{parameters} 19 | && $text->{commands}->{$cmd}->{parameters} ne 'none' ){ 20 | $out .= $text->{commands}->{$cmd}->{parameters} 21 | } 22 | $out .= "\n"; 23 | my $example = $text->{commands}->{$cmd}->{example}; 24 | $example = munge_help($example); 25 | #$example =~ s/!n/\n/g; 26 | if ($example){ 27 | $out .= "Example: "; 28 | if ($example =~ /\n/s){ 29 | $example = "\n$example"; # add leading newline 30 | $example =~ s(\n)(\n )g; # indent 31 | } 32 | $out .= $example; 33 | $out .= "\n"; 34 | } 35 | ($/, ucfirst $out, $/); 36 | 37 | } 38 | sub munge_help { 39 | my $text = shift; 40 | $text =~ s/(^\s*)!(\s*#)/$1 $2/mg; 41 | $text =~ s/(^\s*!)/#/mg; 42 | $text 43 | } 44 | } 45 | sub helptopic { 46 | my $i = shift; 47 | my $key = $help->{index}->{$i}; 48 | format_help_topic($i, $key); 49 | } 50 | 51 | sub format_help_topic { 52 | my ($index, $key) = @_; 53 | my $title = $help->{display}->[$index]; 54 | my @output; 55 | push @output, "\n-- $help->{title}->[$index] --\n\n"; 56 | push @output, $help->{topic}->{$key}, $/; 57 | @output 58 | } 59 | 60 | sub help { 61 | my $name = shift; 62 | $name =~ s/-/_/g; # help indices require underscores 63 | chomp $name; 64 | #print "seeking help for argument: $name\n"; 65 | $text->{iam}->{$name} and pager(<{topic}->{$name}){ 71 | @output = helptopic($name); 72 | } elsif ( $name =~ /^(\d+)$/ ){ 73 | @output = helptopic($name) 74 | } else { 75 | my %helped = (); 76 | my @help = (); 77 | if ( $text->{commands}->{$name} ){ 78 | push @help, helpline($name); 79 | $helped{$name}++ 80 | } 81 | map 82 | { 83 | my $cmd = $_ ; 84 | if ($cmd =~ /$name/ ) 85 | { 86 | push @help, helpline($cmd) unless $helped{$cmd} 87 | or $cmd =~ /-/; # skip hyphenated command forms 88 | # which lack full help 89 | $helped{$cmd}++ ; 90 | } 91 | no warnings 'uninitialized'; 92 | if ( ! $helped{$cmd} and 93 | grep{ /$name/ } split " ", $text->{commands}->{$cmd}->{short}) 94 | { 95 | push @help, helpline($cmd) 96 | } 97 | } keys %{$text->{commands}}; 98 | 99 | if ( @help ){ push @output, 100 | qq("$name" matches the following commands:\n\n), @help; 101 | } 102 | } 103 | if (@output){ 104 | map{ s/_/-/g } @output; 105 | ::pager( @output ); 106 | } else { throw("$name: no help found.\n"); } 107 | 108 | } 109 | sub help_effect { 110 | my ($input, $id, $no_match, @output); 111 | $id = $input = shift; 112 | push @output, "\n"; 113 | 114 | # e.g. help tap_reverb 115 | # help 2142 116 | # help var_chipmunk # preset 117 | 118 | # convert digits to LADSPA label 119 | 120 | if ($id !~ /\D/){ $id = $fx_cache->{ladspa_id_to_label}->{$id} or $no_match++ } 121 | 122 | # convert ladspa_label to el:ladspa_label 123 | # convert preset_name to pn:preset_name 124 | 125 | if ($fx_cache->{full_label_to_index}->{$id}){} # we are ready 126 | 127 | elsif ( $fx_cache->{partial_label_to_full}->{$id} ) { $id = $fx_cache->{partial_label_to_full}->{$id} } 128 | else { $no_match++ } 129 | 130 | # one-line help for Ecasound and chain operators, controllers and presets 131 | 132 | if ($id !~ /^(lv2|el):/) { 133 | push @output, grep{ /$id/ } @{$fx_cache->{user_help}}; 134 | } 135 | 136 | # full help for LADSPA/LV2 plugins 137 | 138 | elsif ( $id =~ /el:/ ) { @output = $fx_cache->{ladspa_help}->{$id} } 139 | elsif ( $id =~ /elv2:/) { @output = $fx_cache->{lv2_help}->{$id} } 140 | 141 | if( $no_match ){ throw("No effects were found matching: $input\n\n"); } 142 | else { ::pager(@output) } 143 | } 144 | 145 | sub find_effect { 146 | my @keys = @_; 147 | #print "keys: @keys\n"; 148 | #my @output; 149 | my @matches = grep{ 150 | my $_help = $_; 151 | my $didnt_match; 152 | map{ $_help =~ /\Q$_\E/i or $didnt_match++ } @keys; 153 | ! $didnt_match; # select if no cases of non-matching 154 | } grep{$_} @{$fx_cache->{user_help}}; 155 | if ( @matches ){ 156 | ::pager( $text->{wrap}->paragraphs(@matches) , "\n" ); 157 | } else { throw(join " ", "No effects were found matching:",@keys,"\n\n") } 158 | } 159 | 160 | sub parse_midi_help { 161 | my $h = get_data_section("midi_help"); 162 | my @lines = split $/, $h; 163 | my $j; 164 | my $cmd; 165 | my %acc; 166 | for (@lines) 167 | { 168 | /(^\w+)/ 169 | ? ($cmd = $1, $acc{$cmd} = [], $j++) 170 | : (push @{$acc{$cmd}}, $_ ); 171 | } 172 | $help->{midish} = \%acc; 173 | return 174 | } 175 | 176 | ## Initialization 177 | 178 | 179 | [% qx(cat ./help_topic.pl) %] 180 | 181 | 1; 182 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Changes to Audio::Nama 2 | 3 | 1.307 Dec 14, 2023 4 | 5 | * Replace Module::Install with Module::Build 6 | 7 | 1.302 Dec 14, 2023 8 | 9 | * hotkey development 10 | * attributes for marks 11 | * clip-here and gather commands for trimming audio files 12 | * metronome development 13 | * many bug fixes 14 | 15 | 1.214 Sep 26, 2019 16 | 17 | * numerous updates (1,040 commits since 1.205) 18 | 19 | 1.205 Dec 31, 2015 20 | 21 | 1.110 Jan 1, 2014 22 | * basic implementation of sequences/clips 23 | * use git is now default: retain project history, 24 | with tagging and branching of significant snapshots 25 | * add undo/redo 26 | * add remote control interface 27 | * add multi engine support 28 | * add hotkey mode 29 | * do not delete marks that fades depend on 30 | * retain playback position on project save/load 31 | * wrap seeks in fades for smooth transitions 32 | * many fixes - git repository is the authoritative source 33 | 34 | 1.102 March 3, 2013 35 | 36 | * new .namarc option 'use_git' for project management 37 | + many internal changes to support git 38 | + save/get commands handle branches similar to save/get files 39 | * drop backwards compatibility and project conversion 40 | (checkout Rosetta for this) 41 | * auto mp3/ogg encoding of mixdown files 42 | * name mixdown files using project or branch name 43 | * cleanup variable declarations 44 | * dismantle eager mode 45 | * internal latency compensation option 46 | 47 | 1.100 March 9, 2012 48 | 49 | * New serialization format, prefer json 50 | * convert_project_format() 51 | + archives project state.yml files 52 | + converts them to new format state.json 53 | + run as nama> eval convert_project_format 54 | * New class EffectChain used to specify presets, store bypass parameters 55 | * Replace hated and maligned bus MON mode filter. 56 | (Use 'rerecord' to toggle to previous REC setup.) 57 | * Eager mode - get sound to soundcard ASAP. 58 | + Declare as eager_mode: doodle in .namarc 59 | + Two varieties of eager: preview and doodle 60 | - doodle: monitor "live" inputs only 61 | - preview: monitor "live" inputs while playing back WAV files 62 | + Issue the 'arm' command when ready to record. 63 | * Optional use of Git for managing state 64 | files and therefore project development. 65 | * Rename source files 66 | * Replace 225 global variables by 16 "singletons", 67 | which are still global variables 68 | * support for multiple serialization formats 69 | * Miscellaneous fixes 70 | 71 | 72 | 1.078 August 19, 2011 73 | 74 | * new commands 75 | + view_waveform launches Mhwaveedit on current track/version/waveform 76 | + edit_waveform launches Audacity on current track/version/waveform 77 | 78 | 1.077 August 12, 2011 79 | 80 | * fix: nosolo doesn't restore previous state (umutes all tracks) 81 | * incorporate whatis.patch from debian 82 | 83 | 1.076 August 8, 2011 84 | 85 | * numerous fixes (consult git log for details) 86 | 87 | 1.073 April 9, 2011 88 | 89 | * fix bug with inserts 90 | * move entire man page to executable 91 | 92 | 1.070 March 27, 2011 93 | 94 | New features 95 | * track edits (non-destructive punch-in style recording) 96 | * track comments 97 | * version comments 98 | * project templates 99 | * autosave 100 | * support jack.plumbing and jack_connect for JACK 101 | client connections 102 | * user-defined commands (custom.pl) 103 | 104 | Other changes 105 | * expanded test coverage 106 | * initial support for Midish MIDI sequencer and filter 107 | * separate code into multiple modules 108 | * many fixes and improvements 109 | 110 | 111 | 1.064 August 6, 2010 112 | * fix Bug rt.cpan.org #60024: Audio::Nama::Assign::expand_tilde() 113 | 114 | 1.063 August 2, 2010 115 | 116 | * various minor improvements 117 | * fix Bug#591166 (Debian build support) 118 | 119 | 1.052 March 20, 2010 (summary) 120 | 121 | * prompt displays current bus and current track 122 | * configurable use of ea or eadb for volume control 123 | * Ladish Level 1 support 124 | * big speedup by caching results of Track and Wav methods 125 | * generate setup using graph representation and IO objects 126 | * rewrite send- and sub-buses 127 | * track caching (track freezing) 128 | * post-fader track inserts (send/receive) with wet/dry control 129 | * more flexible track input 130 | + manual connection to JACK port 131 | + auto connect to list of JACK ports 132 | * track normalize and fixdc commands 133 | * automix (normalized mixdown) command 134 | * import audio: copy files unless resampling or converting format 135 | * region shifting, with multiple regions per track 136 | * effect chains (presets) 137 | * effect profiles (effect chains over multiple tracks) 138 | * non-recording preview and doodle modes 139 | * unified event code for GUI and text modes 140 | * rewrite support for Ecasound controllers 141 | * test coverage for signal routing functions 142 | * new debugging options 143 | 144 | -------------------------------------------------------------------------------- /src/TrackUtils.p: -------------------------------------------------------------------------------- 1 | package ::; 2 | use Modern::Perl '2020'; 3 | 4 | sub add_track { 5 | 6 | logsub((caller(0))[3]); 7 | my ($name, @params) = @_; 8 | my %vals = (name => $name, @params); 9 | my $class = $vals{class} // '::Track'; 10 | { no warnings 'uninitialized'; 11 | logpkg('debug', "name: $name, ch_r: $gui->{_chr}, ch_m: $gui->{_chm}"); 12 | } 13 | ::throw("$name: track name already in use. Skipping."), return 14 | if $tn{$name}; 15 | ::throw("$name: reserved track name. Skipping"), return 16 | if grep $name eq $_, @{$mastering->{track_names}}; 17 | 18 | # in order to increment serially 19 | ::ChainSetup::remove_temporary_tracks(); 20 | 21 | my $track = $class->new(%vals); 22 | return if ! $track; 23 | logpkg('debug', "ref new track: ", ref $track); 24 | $track->source($gui->{_chr}) if $gui->{_chr}; 25 | # $track->send($gui->{_chm}) if $gui->{_chm}; 26 | 27 | my $bus = $bn{$track->group}; 28 | $bus->set(rw => MON) unless $track->target; # not if is alias 29 | 30 | # normal tracks set to config->new_track_rw 31 | # defaulting to MON 32 | # track aliases default to PLAY 33 | $track->set(rw => $track->{target} 34 | ? PLAY 35 | : $config->{new_track_rw} || MON ); 36 | $gui->{_track_name} = $gui->{_chm} = $gui->{_chr} = undef; 37 | 38 | set_current_bus(); 39 | logpkg('debug', "Added new track!\n", sub{$track->dump}); 40 | $track; 41 | } 42 | 43 | # create read-only track pointing at WAV files of specified 44 | # name in current project 45 | 46 | sub add_track_alias { 47 | my ($name, $track) = @_; 48 | my $target; 49 | if ( $tn{$track} ){ $target = $track } 50 | elsif ( $ti{$track} ){ $target = $ti{$track}->name } 51 | add_track( $name, target => $target, width => $tn{$target}->width); 52 | } 53 | # create read-only track pointing at WAV files of specified 54 | # track name in a different project 55 | 56 | sub add_track_alias_project { 57 | my ($name, $track, $project_name) = @_; 58 | $project_name //= $::project->{name}; 59 | my $dir = join_path(project_root(), $project_name, '.wav'); 60 | if ( -d $dir ){ 61 | if ( glob "$dir/$track*.wav"){ 62 | ::pager("Found target WAV files.\n"); 63 | my @params = ( 64 | target => $track, 65 | project => $project_name, 66 | ); 67 | add_track( $name, @params ); 68 | } else { ::throw("$project_name:$track - No WAV files found. Skipping.\n"), return; } 69 | } else { 70 | ::throw("$project_name: project does not exist. Skipping.\n"); 71 | return; 72 | } 73 | } 74 | # vol/pan requirements of mastering and mixdown tracks 75 | 76 | { my %volpan = ( 77 | Eq => {}, 78 | Low => {}, 79 | Mid => {}, 80 | High => {}, 81 | Boost => {vol => 1}, 82 | Mixdown => {}, 83 | ); 84 | 85 | sub need_vol_pan { 86 | 87 | my ($track_name, $type) = @_; 88 | 89 | # $type: vol | pan 90 | 91 | # Case 1: track already exists 92 | 93 | return 1 if $tn{$track_name} and $tn{$track_name}->$type; 94 | 95 | # Case 2: track not yet created 96 | 97 | if( $volpan{$track_name} ){ 98 | return($volpan{$track_name}{$type} ? 1 : 0 ) 99 | } 100 | return 1; 101 | } 102 | } 103 | 104 | # track width in words 105 | 106 | sub width { 107 | my $count = shift; 108 | return 'mono' if $count == 1; 109 | return 'stereo' if $count == 2; 110 | return "$count channels"; 111 | } 112 | 113 | 114 | sub add_volume_control { 115 | my $n = shift; 116 | return unless need_vol_pan($ti{$n}->name, "vol"); 117 | 118 | my $vol_id = ::Effect->new( 119 | chain => $n, 120 | type => $config->{volume_control_operator}, 121 | id => $ti{$n}->vol, # often undefined 122 | )->id; 123 | 124 | $ti{$n}->set(vol => $vol_id); # save the id for next time 125 | $vol_id; 126 | } 127 | sub add_pan_control { 128 | my $n = shift; 129 | return unless need_vol_pan($ti{$n}->name, "pan"); 130 | 131 | my $pan_id = ::Effect->new( 132 | chain => $n, 133 | type => 'epp', 134 | id => $ti{$n}->pan, # often undefined 135 | )->id; 136 | 137 | $ti{$n}->set(pan => $pan_id); # save the id for next time 138 | $pan_id; 139 | } 140 | sub rename_track { 141 | use Cwd; 142 | use File::Slurp; 143 | my ($oldname, $newname, $statefile, $dir) = @_; 144 | project_snapshot(); 145 | my $old_dir = cwd(); 146 | chdir $dir; 147 | 148 | # rename audio files 149 | 150 | qx(rename 's/^$oldname(?=[_.])/$newname/' *.wav); 151 | 152 | 153 | # rename in State.json when candidate key 154 | # is part of the specified set and the value 155 | # exactly matches $oldname 156 | 157 | my $state = read_file($statefile); 158 | 159 | $state =~ s/ 160 | " # open quote 161 | (track| # one of specified fields 162 | name| 163 | group| 164 | source| 165 | send_id| 166 | target| 167 | current_edit| 168 | source_id| 169 | return_id| 170 | wet_track| 171 | dry_track| 172 | track| 173 | host_track) 174 | " # close quote 175 | \ # space 176 | : # colon 177 | \ # space 178 | "$oldname"/"$1" : "$newname"/gx; 179 | 180 | write_file($statefile, $state); 181 | my $msg = "Rename track $oldname -> $newname"; 182 | project_snapshot($msg); 183 | ::pager($msg); 184 | load_project(name => $::project->{name}); 185 | } 186 | sub user_tracks_present { 187 | my $i = 0; 188 | $i++ for user_tracks(); 189 | $i 190 | } 191 | sub all_tracks { sort{$a->n <=> $b->n } values %::Track::by_name } 192 | sub audio_tracks { grep { $_->class !~ /Midi/ } all_tracks() } 193 | sub rec_hookable_tracks { 194 | grep{ $_->group ne 'Temp' and $_->group ne 'Insert' } all_tracks() 195 | } 196 | sub user_tracks { grep { ! $_->is_system_track } all_tracks() } 197 | sub system_tracks { grep { $_->is_system_track } all_tracks() } 198 | sub this_track_name { $this_track ? $this_track->name : "" } 199 | 200 | -------------------------------------------------------------------------------- /src/EcasoundCleanup.p: -------------------------------------------------------------------------------- 1 | # ----------- Ecasound cleanup (post-recording) ----------- 2 | package ::EcasoundCleanup; 3 | use Role::Tiny; 4 | use Modern::Perl '2020'; 5 | our $VERSION = 1.0; 6 | sub cleanup { 7 | my $self = shift; 8 | ::rec_cleanup(); 9 | } 10 | 11 | 12 | package ::; 13 | use Modern::Perl '2020'; 14 | use Cwd; 15 | use File::Spec::Functions qw(splitpath); 16 | use ::Globals qw(:all); 17 | 18 | sub rec_cleanup { 19 | logsub((caller(0))[3]); 20 | logpkg('debug',"transport still running, can't cleanup"), return if $this_engine->running; 21 | if( my (@files) = new_files_were_recorded() ) 22 | { 23 | if( my @rec_tracks = ::ChainSetup::engine_wav_out_tracks() ) 24 | { 25 | $project->{playback_position} = 0; 26 | $setup->{_last_rec_tracks} = \@rec_tracks; 27 | } 28 | 29 | if( grep /Mixdown/, @files) { 30 | mixdown_postprocessing() ; 31 | mixplay(); 32 | } 33 | post_rec_configure() 34 | } 35 | } 36 | sub mixdown_postprocessing { 37 | logsub((caller(0))[3]); 38 | nama_cmd('mixplay'); 39 | my ($oldfile) = $tn{Mixdown}->full_path =~ m{([^/]+)$}; 40 | $oldfile = join_path('.wav',$oldfile); 41 | my $tag_name = join '-', $project->{name}, current_branch(); 42 | my $version = $tn{Mixdown}->playback_version; 43 | 44 | # simplify the tagname basename 45 | # 46 | # untitled-master -> untitled 47 | # untitled-premix-branch -> untitled-premix 48 | 49 | $tag_name =~ s/-branch$//; 50 | $tag_name =~ s/-master$//; 51 | $tag_name .= "_$version"; 52 | 53 | delete_existing_mixdown_tag_and_convenience_encodings($tag_name); 54 | 55 | # create symlink in project_dir() 56 | 57 | my $was_in = getcwd; 58 | chdir project_dir() or die "couldn't chdir: $!"; 59 | my $newfile = "$tag_name.wav"; 60 | logpkg('debug',"symlinking oldfile: $oldfile, newfile: $newfile"); 61 | symlink $oldfile, $newfile or throw("symlink didn't work: $!"); 62 | tag_mixdown_commit($tag_name, $newfile, $oldfile) if $config->{use_git}; 63 | 64 | my $sha = git_sha(); # possibly undef 65 | my $encoding = $config->{mixdown_encodings}; 66 | my $comment; 67 | if ($sha or $encoding){ 68 | $comment .= "tagged " if $sha; 69 | $comment .= "and " if $sha and $encoding; 70 | $comment .= "encoded " if $encoding; 71 | $comment .= "as $tag_name "; 72 | $comment .= "(commit $sha)" if $sha; 73 | } 74 | $tn{Mixdown}->add_system_version_comment($version, $comment); 75 | pager_newline($comment); 76 | encode_mixdown_file($oldfile,$tag_name); 77 | chdir $was_in; 78 | } 79 | sub tag_mixdown_commit { 80 | logsub((caller(0))[3]); 81 | my ($name, $newfile, $mixdownfile) = @_; 82 | logpkg('debug',"tag_mixdown_commit: @_"); 83 | 84 | my ($sym) = $newfile =~ m([^/]+$); 85 | my ($mix) = $mixdownfile =~ m([^/]+$); 86 | 87 | # we want to tag the normal playback state 88 | 89 | local $quiet = 1; 90 | mixoff(); 91 | 92 | my $msg = "State for $sym ($mix)"; 93 | project_snapshot($msg); 94 | git('tag', $name, '-m', $mix); 95 | } 96 | sub delete_existing_mixdown_tag_and_convenience_encodings { 97 | logsub((caller(0))[3]); 98 | my $name = shift; 99 | logpkg('debug',"name: $name"); 100 | git('tag', '-d', $name); 101 | foreach( qw(mp3 ogg wav) ){ 102 | my $file = join_path(project_dir(),"$name.$_"); 103 | unlink $file if -e $file; 104 | } 105 | } 106 | sub encode_mixdown_file { 107 | state $shell_encode_command = { 108 | mp3 => q(lame -h --ta "$artist" --ty $year --tt "$title" $input_file $output_file), 109 | ogg => q(oggenc -o $output_file -a "$artist" -t "$title" -d "$date" $input_file) 110 | }; 111 | my($mixdownfile, $tag_name, @formats) = @_; 112 | @formats or @formats = split " ", $config->{mixdown_encodings}; 113 | logpkg('debug',"formats: @formats"); 114 | my $artist = $project->{artist} || qx(whoami); 115 | my $title = $project->{name}; 116 | my $date = qx(date); 117 | chomp($date, $artist); 118 | my ($year) = $date =~ /(\d{4})$/; 119 | my $input_file = $mixdownfile; 120 | for my $format( @formats ){ 121 | my $output_file = join_path(project_dir(),"$tag_name.$format"); 122 | logpkg('debug',"artist $artist, title $title, date $date, year $year, input file $input_file, output file $output_file"); 123 | my $cmd = eval qq(qq($shell_encode_command->{$format})); 124 | logpkg('debug',"Mixdown encoding command:\n$cmd"); 125 | system $cmd; 126 | } 127 | 128 | } 129 | 130 | sub adjust_offset_recordings { 131 | for( ::ChainSetup::engine_wav_out_tracks()){ 132 | no warnings 'uninitialized'; 133 | if (my $mark = $setup->{offset_run}->{mark}){ 134 | $_->set(playat => $mark); 135 | logpkg('debug',$_->name, ": offsetting to $mark"); 136 | } 137 | } 138 | } 139 | sub post_rec_configure { 140 | 141 | $ui->global_version_buttons(); # recreate 142 | adjust_offset_recordings(); 143 | 144 | # toggle recorded tracks to PLAY for auditioning 145 | 146 | map{ $_->set(rw => PLAY) } @{$setup->{_last_rec_tracks}}; 147 | 148 | undef $mode->{offset_run} if ! defined $this_edit; 149 | $ui->refresh(); 150 | request_setup(); 151 | reconfigure_engine(); 152 | } 153 | sub new_files_were_recorded { 154 | return unless my @files = ::ChainSetup::really_recording(); 155 | logpkg('debug',join $/, "intended recordings:", @files); 156 | my @recorded = 157 | grep { my ($name, $version) = /([^\/]+)_(\d+).wav$/; 158 | if (-e ) { 159 | if (-s > 44100) { # 0.5s x 16 bits x 44100/s 160 | logpkg('debug',"File size >44100 bytes: $_"); 161 | $tn{$name}->set(version => $version) if $tn{$name}; 162 | $ui->update_version_button($tn{$name}->n, $version); 163 | 1; 164 | } 165 | else { unlink $_; 0 } 166 | } 167 | } @files; 168 | if(@recorded){ 169 | refresh_wav_cache(); 170 | pager(join " ", "recorded:", map{ filename($_) } @recorded); 171 | } 172 | map{ _get_wav_info($_) } @recorded; 173 | @recorded 174 | } 175 | sub filename { 176 | my $path = shift; 177 | my(undef, undef, $name) = splitpath($path); 178 | $name 179 | } 180 | 1; 181 | __END__ 182 | 183 | -------------------------------------------------------------------------------- /src/Midi.p: -------------------------------------------------------------------------------- 1 | # ------------- MIDI routines ----------- 2 | 3 | package ::; 4 | use Modern::Perl '2020'; 5 | #use ::Log qw(logpkg); 6 | use Carp; 7 | 8 | { 9 | my ($pid, $sel); 10 | my @handles = my ($fh_midi_write, $fh_midi_read, $fh_midi_error) = map{ IO::Handle->new() } 1..3; 11 | map{ $_->autoflush(1) } @handles; 12 | 13 | sub start_midish_process { 14 | logsub((caller(0))[3]); 15 | my $executable = qx(which midish); 16 | chomp $executable; 17 | $executable or say("Midish not found!"), return; 18 | $pid = open3($fh_midi_write, $fh_midi_read, $fh_midi_error,"$executable -v") 19 | or warn "Midish failed to start!"; 20 | 21 | $sel = IO::Select->new(); 22 | $sel->add($fh_midi_read); 23 | $sel->add($fh_midi_error); 24 | midish_cmd( qq(print "Midish is ready.") ); 25 | write_aux_midi_commands(); 26 | midish_cmd( q(exec ").$file->aux_midi_commands.q(") ); 27 | $pid 28 | } 29 | sub midish_cmd { 30 | my $command = shift; 31 | logsub((caller(0))[3]); 32 | return unless $config->{use_midi}; 33 | 34 | print $fh_midi_write "$command\n"; 35 | #say "applied midish command: $command"; 36 | $project->{midi_history} //=[]; 37 | push @{ $project->{midi_history} },$command; 38 | 39 | my $length = 2**16; 40 | sleeper(0.05); 41 | my @result; 42 | foreach my $h ($sel->can_read) 43 | { 44 | my $buf = ''; 45 | if ($h eq $fh_midi_error) 46 | { 47 | sysread($fh_midi_error,$buf,$length); 48 | if($buf){print "MIDISH ERR-> $buf\n"} 49 | } 50 | else 51 | { 52 | sysread($fh_midi_read,$buf,$length); 53 | if($buf){push @result, grep{ !/\+ready/ } split "\n", $buf} 54 | } 55 | } 56 | join "\n", @result; 57 | } 58 | 59 | sub close_midish { 60 | save_midish(); 61 | say "reaping midish"; 62 | kill_and_reap($pid); 63 | } 64 | sub save_midish { 65 | my $fname = $file->midi_store; 66 | midish_cmd( qq); 67 | } 68 | 69 | sub reconfigure_midi { 70 | add_midi_track($config->{midi_record_buffer}, n => 999, hide => 1) 71 | if not $tn{$config->{midi_record_buffer}} 72 | and $this_track->current_midi 73 | and $this_track->rec; 74 | 75 | my $midi_rec = $tn{$config->{midi_record_buffer}}; 76 | 77 | # mute all 78 | 79 | my @all = $bn{Midi}->track_o; 80 | 81 | $_->mute for @all; # same as setting OFF for MidiTracks 82 | 83 | # unmute audible 84 | 85 | my @audible = grep{ $_->play } @all; 86 | $_->unmute for @audible; 87 | 88 | # unset filters 89 | 90 | do { $_->select_track; midish_cmd("fdel ".$_->name) } for @all; 91 | 92 | # set filters for PLAY and MON tracks 93 | 94 | do { $_->select_track; midish_cmd(join ' ', 'rnew', $_->source_id, $_->send_id) } for @audible; 95 | 96 | my ($rec) = my @rec = $en{midish}->rec_tracks; 97 | 98 | # maybe we're done? 99 | 100 | return unless @rec; 101 | throw("more than one midi REC track ", join " ", map{$_->name} @rec), 102 | return if @rec > 1; 103 | 104 | # mute the actual track since we'll record using the special-purpose track 105 | 106 | $rec->mute; 107 | $midi_rec->select_track; 108 | 109 | # use routing of target track on $midi_rec track 110 | 111 | my $cmd = 'rnew'; 112 | $cmd = join ' ', $cmd, $rec->source_id, $rec->send_id; 113 | midish_cmd($cmd); 114 | } 115 | sub start_midi_transport { 116 | my $start_command = $en{midish}->rec_tracks ? 'r' : 'p'; 117 | midish_cmd($start_command); 118 | $setup->{midish_running}++; 119 | } 120 | sub stop_midi_transport { 121 | return unless midish_running(); 122 | midish_cmd('s'); 123 | delete $setup->{midish_running}; 124 | } 125 | sub midi_rec_cleanup { 126 | my ($track) = $en{midish}->rec_tracks; 127 | # midish allows one recording track 128 | defined $track or return; 129 | my $length = midish_cmd('print [mend]'); 130 | $length > 0 or return; 131 | 132 | my $version = $track->current_version; 133 | $track->set_version($version); 134 | push @{$track->midi_versions}, $version; 135 | $track->set(rw => PLAY); 136 | my $cmd = join ' ', 'chdup', $config->{midi_record_buffer}, $track->source_id, $track->midi_version; 137 | say "cmd: $cmd"; 138 | midish_cmd($cmd); 139 | midish_cmd("clr $config->{midi_record_buffer} $length"); 140 | $track->unmute(); 141 | save_midish(); 142 | } 143 | } 144 | sub write_aux_midi_commands { 145 | write_file($file->aux_midi_commands, get_data_section('aux_midi_commands')) 146 | unless -e $file->aux_midi_commands 147 | } 148 | sub add_midi_track { 149 | my ($name, @args) = @_; 150 | my $track = ::add_track( 151 | $name, 152 | class => '::MidiTrack', 153 | group => 'Midi', 154 | source_id => 'midi', 155 | source_type => 'midi', 156 | midi_versions => [], 157 | novol => 1, 158 | engine_group => $config->{midi_engine_name}, 159 | nopan => 1, 160 | @args, 161 | ); 162 | } 163 | sub user_midi_tracks { grep { $_->class =~ /Midi/ } grep { ! $_->hide } all_tracks() } 164 | 165 | 166 | =comment 167 | chdup aux_recorder dx7 piano 168 | 169 | tnew synth 170 | rnew nord nord # play the nord keyboard sound with the nord keyboard 171 | tnew piano 172 | rnew tr dx7 # route the tr keyboard to the dx7 synth sound engine 173 | tnew aux_recorder 174 | rnew nord nord 175 | radd tr dx7 # not sure if this works, must recheck my code 176 | r 177 | s 178 | 179 | let complete_length = [mend]; 180 | 2. clear the auxiliary track 181 | clr aux_recorder $complete_length 182 | =cut 183 | 1; 184 | __END__ 185 | -------------------------------------------------------------------------------- /src/Util.p: -------------------------------------------------------------------------------- 1 | # ----------- Util.pm ----------- 2 | 3 | # this package is for small subroutines with 4 | # well-defined interfaces 5 | 6 | package ::Util; 7 | use Modern::Perl '2020'; 8 | use Carp; 9 | use Data::Dumper::Concise; 10 | use ::Assign qw(json_out); 11 | use ::Globals qw(:all); 12 | use ::Log qw(logit logsub logpkg); 13 | 14 | no warnings 'uninitialized'; 15 | 16 | require Exporter; 17 | 18 | our @ISA = qw(Exporter); 19 | 20 | our %EXPORT_TAGS = ( 'all' => [ qw( 21 | 22 | freq 23 | channels 24 | input_node 25 | output_node 26 | signal_format 27 | process_is_running 28 | d1 29 | d2 30 | dn 31 | round 32 | colonize 33 | time_tag 34 | heuristic_time 35 | dest_type 36 | dest_string 37 | 38 | create_dir 39 | join_path 40 | wav_off 41 | strip_all 42 | strip_blank_lines 43 | strip_comments 44 | remove_spaces 45 | expand_tilde 46 | resolve_path 47 | dumper 48 | route_output_channels 49 | 50 | ) ] ); 51 | 52 | our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); 53 | 54 | our @EXPORT = (); 55 | 56 | 57 | sub freq { [split ',', $_[0] ]->[2] } # e.g. s16_le,2,44100 58 | 59 | sub channels { [split ',', $_[0] ]->[1] } 60 | 61 | # these are the names of loop devices corresponding 62 | # to pre- and post-fader nodes of a track signal 63 | sub input_node { $_[0].'_in' } 64 | sub output_node {$_[0].'_out'} 65 | 66 | sub signal_format { 67 | my ($template, $channel_count) = @_; 68 | $template =~ s/N/$channel_count/; 69 | my $format = $template; 70 | } 71 | sub process_is_running { 72 | my $name = shift; 73 | my @pids = split " ", qx(pgrep $name); 74 | my @ps_ax = grep{ my $pid; 75 | /$name/ and ! /defunct/ 76 | and ($pid) = /(\d+)/ 77 | and grep{ $pid == $_ } @pids 78 | } split "\n", qx(ps ax) ; 79 | } 80 | sub d1 { 81 | my $n = shift; 82 | sprintf("%.1f", $n) 83 | } 84 | sub d2 { 85 | my $n = shift; 86 | sprintf("%.2f", $n) 87 | } 88 | sub dn { 89 | my ($n, $places) = @_; 90 | sprintf("%." . $places . "f", $n); 91 | } 92 | sub round { 93 | my $n = shift; 94 | return 0 if $n == 0; 95 | $n = int $n if $n > 10; 96 | $n = d2($n) if $n < 10; 97 | $n; 98 | } 99 | sub colonize { # convert seconds to hours:minutes:seconds 100 | my $sec = shift || 0; 101 | my $hours = int ($sec / 3600); 102 | $sec = $sec % 3600; 103 | my $min = int ($sec / 60); 104 | $sec = $sec % 60; 105 | $sec = "0$sec" if $sec < 10; 106 | $min = "0$min" if $min < 10 and $hours; 107 | ($hours ? "$hours:" : "") . qq($min:$sec); 108 | } 109 | 110 | 111 | 112 | sub time_tag { 113 | my @time = localtime time; 114 | $time[4]++; 115 | $time[5]+=1900; 116 | @time = @time[5,4,3,2,1,0]; 117 | sprintf "%4d.%02d.%02d-%02d:%02d:%02d", @time 118 | } 119 | 120 | sub heuristic_time { 121 | my $sec = shift; 122 | d1($sec) . ( $sec > 120 ? " (" . colonize( $sec ) . ") " : " " ) 123 | } 124 | 125 | sub dest_type { 126 | my $dest = shift; 127 | if($dest eq undef ) { undef } 128 | 129 | elsif($dest eq 'bus') { 'bus' } 130 | elsif($dest eq 'null') { 'null' } 131 | elsif($dest eq 'rtnull') { 'rtnull' } 132 | elsif($dest =~ /^loop,/) { 'loop' } 133 | elsif($dest !~ /\D/) { 'soundcard' } # digits only 134 | 135 | elsif($dest =~ /^man/) { 'jack_manual' } 136 | elsif($dest eq 'jack') { 'jack_manual' } 137 | elsif($dest =~ /\.ports$/) { 'jack_ports_list' } 138 | elsif( $tn{$dest} ) { 'track' } 139 | else { 'jack_client' } 140 | } 141 | sub dest_string { 142 | my ($type, $id, $width) = @_; 143 | if ($type eq 'soundcard'){ 144 | my $ch = $id; 145 | my @channels; 146 | push @channels, $_ for $ch .. ($ch + $width - 1); 147 | 'CH '.join '/', @channels 148 | } 149 | else { $id } 150 | } 151 | 152 | sub create_dir { 153 | my @dirs = @_; 154 | map{ my $dir = $_; 155 | logpkg('debug',"creating directory [ $dir ]"); 156 | -e $dir 157 | #and (carp "create_dir: '$dir' already exists, skipping...\n") 158 | or system qq( mkdir -p $dir) 159 | } @dirs; 160 | } 161 | 162 | sub join_path { 163 | 164 | my @parts = @_; 165 | my $path = join '/', @parts; 166 | $path =~ s(/{2,})(/)g; 167 | $path; 168 | } 169 | 170 | sub wav_off { 171 | my $wav = shift; 172 | $wav =~ s/\.wav\s*$//i; 173 | $wav; 174 | } 175 | 176 | sub strip_all{ strip_trailing_spaces(strip_blank_lines( strip_comments(@_))) } 177 | 178 | sub strip_trailing_spaces { 179 | map {s/\s+$//} @_; 180 | @_; 181 | } 182 | sub strip_blank_lines { 183 | map{ s/\n(\s*\n)+/\n/sg } @_; 184 | map{ s/^\n+//s } @_; 185 | @_; 186 | 187 | } 188 | 189 | sub strip_comments { # 190 | map{ s/#.*$//mg; } @_; 191 | map{ s/\s+$//mg; } @_; 192 | 193 | @_ 194 | } 195 | 196 | sub remove_spaces { 197 | my $entry = shift; 198 | # remove leading and trailing spaces 199 | 200 | $entry =~ s/^\s*//; 201 | $entry =~ s/\s*$//; 202 | 203 | # convert other spaces to underscores 204 | 205 | $entry =~ s/\s+/_/g; 206 | $entry; 207 | } 208 | sub resolve_path { 209 | my $path = shift; 210 | $path = expand_tilde($path); 211 | $path = File::Spec::Link->resolve_all($path); 212 | } 213 | sub expand_tilde { 214 | my $path = shift; 215 | 216 | my $home = File::HomeDir->my_home; 217 | 218 | 219 | # ~bob -> /home/bob 220 | $path =~ s( 221 | ^ # beginning of line 222 | ~ # tilde 223 | (\w+) # username 224 | ) 225 | (File::HomeDir->users_home($1))ex; 226 | 227 | # ~/something -> /home/bob/something 228 | $path =~ s( 229 | ^ # beginning of line 230 | ~ # tilde 231 | / # slash 232 | ) 233 | ($home/)x; 234 | $path 235 | } 236 | sub dumper { 237 | ! defined $_ and "undef" 238 | or ! (ref $_) and $_ 239 | #or (ref $_) =~ /HASH|ARRAY/ and ::json_out($_) 240 | or ref $_ and Dumper($_) 241 | } 242 | sub route_output_channels { 243 | # routes signals (1..$width) to ($dest..$dest+$width-1 ) 244 | # returns pairs as arguments to chmove 245 | 246 | my ($width, $dest) = @_; 247 | return '' if ! $dest or $dest == 1; 248 | # print "route: width: $width, destination: $dest\n\n"; 249 | my $offset = $dest - 1; 250 | my @route; 251 | for my $channel ( map{$width - $_ + 1} 1..$width ) { 252 | push @route,[$channel,($channel + $offset)]; 253 | } 254 | @route; 255 | } 256 | 257 | 1; 258 | __END__ 259 | 260 | -------------------------------------------------------------------------------- /src/namarc: -------------------------------------------------------------------------------- 1 | # 2 | # Nama Configuration file 3 | # 4 | # This file has been auto-generated by Nama 5 | # It will not be overwritten, so edit it as you like. 6 | # 7 | # Notes 8 | # 9 | # - The format of this file is YAML, preprocessed to allow 10 | # comments. Note: TAB characters are not allowed, 11 | # and will cause a fatal error. 12 | # 13 | # - A value _must_ be supplied for each 'leaf' field. 14 | # For example "mixer_out_format: cd-stereo" 15 | # 16 | # - A value must _not_ be supplied for nodes, i.e. 17 | # 'device:'. The value for 'device' is the entire indented 18 | # data structure that follows in subsequent lines. 19 | # 20 | # - white space *is* significant. Two spaces indent is 21 | # required for each sublevel. 22 | # 23 | # - You may use the tilde symbol '~' to represent a null (undef) value 24 | # For example "execute_on_project_load: ~" 25 | # 26 | # - This file is distinct from .ecasoundrc (not used by Nama.) 27 | 28 | 29 | # project root directory, all project files stored here 30 | 31 | project_root: ~ # replaced during first run 32 | 33 | # [ audio devices ] 34 | 35 | alsa_capture_device: consumer # 'consumer' is defined below 36 | alsa_playback_device: consumer 37 | 38 | # Naming ALSA audio devices, reference for "device" section below 39 | 40 | # syntax: alsa,pcm_device_name 41 | # example: alsa,default 42 | # pcm_device_name can be 'default' or any virtual devices you 43 | # have defined in .asoundrc. (see https://alsa.opensrc.org/Asoundrc) 44 | 45 | # syntax: alsaplugin,card_number,device_number[,subdevice_number] (sample rate conversion) 46 | # syntax: alsahw,card_number,device_number[,subdevice_number] (no sample rate conversion) 47 | # example: alsaplugin,1,0 (second soundcard, device 0) 48 | 49 | # Specifying audio format for recording and soundcard input/output 50 | 51 | # syntax: bit_configuration,channel_count,frequency 52 | # example: s16_le,2,44100 (16-bits little-endian, two channels, 44.1 kHz) 53 | # example: s16_le,2,frequency 54 | # You may use the 'frequency' token, defined in the "abbreviations" section below. 55 | # Set 'frequency' to specify the sample rate for your project. 56 | 57 | # onboard soundcard, card number 0 58 | 59 | devices: 60 | consumer: 61 | ecasound_id: alsa,default 62 | input_format: 16-bit-stereo 63 | output_format: 16-bit-stereo 64 | 65 | # multi-channel soundcard, card number 1, with 12 input and 10 output channels 66 | 67 | multi: 68 | ecasound_id: alsaplugin,1,0 # second card 69 | input_format: s32_le,12,frequency 70 | output_format: s32_le,10,frequency 71 | 72 | # other device settings (don't change them) 73 | 74 | jack: 75 | signal_format: f32_le,N,frequency 76 | null: 77 | ecasound_id: null 78 | output_format: ~ 79 | 80 | # audio formats 81 | 82 | # If your card allow, you'll get most boom-for-buck in 83 | # raising channel bandwidth to 24 bits 84 | 85 | mix_to_disk_format: 16-bit-n-channel 86 | mixer_out_format: 16-bit-stereo 87 | raw_to_disk_format: 16-bit-n-channel 88 | cache_to_disk_format: 16-bit-n-channel 89 | 90 | abbreviations: 91 | frequency: 44100 92 | 24-bit-mono: s24_le,1,frequency 93 | 24-bit-stereo: s24_le,2,frequency,i 94 | 24-bit-n-channel: s24_le,N,frequency,i 95 | 16-bit-mono: s16_le,1,frequency 96 | 16-bit-stereo: s16_le,2,frequency,i 97 | 16-bit-n-channel: s16_le,N,frequency,i 98 | cd-mono: s16_le,1,44100 99 | cd-stereo: s16_le,2,44100,i 100 | 101 | mixdown_encodings: mp3 ogg # files are automatically generated on mixdown 102 | # lame required for mp3 103 | # oggenc required for ogg 104 | 105 | sample_rate: frequency 106 | 107 | realtime_profile: nonrealtime # other choices: realtime or auto 108 | 109 | use_metronome: 0 110 | 111 | # The following buffer sizes apply only with ALSA (not when using JACK) 112 | 113 | ecasound_buffersize: 114 | realtime: 115 | default: 256 116 | nonrealtime: 117 | default: 1024 118 | 119 | ecasound_globals: # best not to change these 120 | common: -z:mixmode,sum 121 | realtime: -z:db,100000 -z:nointbuf 122 | nonrealtime: -z:nodb -z:intbuf 123 | 124 | waveform_height: 200 # gui display 125 | 126 | # ecasound_tcp_port: 2868 127 | 128 | # effects for use in mastering mode, you may have to install them 129 | 130 | eq: Parametric1 1 0 0 40 1 0 0 200 1 0 0 600 1 0 0 3300 1 0 131 | 132 | low_pass: lowpass_iir 106 2 133 | 134 | mid_pass: bandpass_iir 520 800 2 135 | 136 | high_pass: highpass_iir 1030 2 137 | 138 | compressor: sc4 0 3 16 0 1 3.25 0 139 | 140 | spatialiser: matrixSpatialiser 0 141 | 142 | limiter: tap_limiter 0 0 143 | 144 | mark_replay_seconds: 2.5 145 | 146 | playback_jump_seconds: 10 147 | 148 | beep: 149 | command: beep # or ecasound 150 | # percent volume is for ecasound only 151 | # Hz sec vol % 152 | clip_start: 880 0.1 5 153 | clip_end: 440 0.1 5 154 | end_of_list: 250 0.2 5 155 | command_error: 350 0.7 5 156 | 157 | hotkeys: 158 | common: 159 | Space: toggle_transport 160 | Backspace: backspace 161 | F1: clip_here 162 | Insert: previous_track 163 | Delete: next_track 164 | Keypad0: replay 165 | [: back(30) 166 | ]: forward(30) 167 | {: back(120) 168 | }: forward(120) 169 | (: backward(300) 170 | ): forward(300) 171 | jump: 172 | Home: jump_to_start 173 | End: jump_to_end 174 | PageUp: previous_mark 175 | PageDown: next_mark 176 | Right: jump_forward_1 177 | Up: jump_forward_10 178 | Left: jump_back_1 179 | Down: jump_back_10 180 | 181 | bump: 182 | Home: jump_to_start 183 | End: jump_to_end 184 | PageUp: previous_mark 185 | PageDown: next_mark 186 | Right: bump_mark_forward_1 187 | Up: bump_mark_forward_10 188 | Left: bump_mark_back_1 189 | Down: bump_mark_back_10 190 | 191 | param: 192 | Home: previous_effect 193 | End: next_effect 194 | PageUp: previous_param 195 | PageDown: next_param 196 | 197 | Left: decrement_param_1 198 | Right: increment_param_1 199 | Up: increment_param_10 200 | Down: decrement_param_10 201 | 202 | alias: 203 | command: 204 | mbs: move_to_bus 205 | pcv: promote_current_version 206 | djp: disable_jack_polling 207 | effect: 208 | reverb: gverb # now superseded by nicknames, see 'h nick' 209 | 210 | 211 | # end 212 | -------------------------------------------------------------------------------- /src/Sequence.p: -------------------------------------------------------------------------------- 1 | package ::Sequence; 2 | use Modern::Perl '2020'; use Carp; 3 | use ::Assign qw(json_out); 4 | use ::Log qw(logsub logpkg); 5 | use ::Effect qw(fxn modify_effect); 6 | use ::Object qw( items clip_counter ); 7 | use ::Globals qw(:trackrw); 8 | our @ISA = '::SubBus'; 9 | our $VERSION = 1.0; 10 | use SUPER; 11 | our %by_name; # alias to %::Bus::by_name 12 | *by_name = \%::Bus::by_name; 13 | 14 | sub new { 15 | my ($class,%args) = @_; 16 | # take out args we will process 17 | my $items = delete $args{items}; 18 | my $counter = delete $args{clip_counter}; 19 | #logpkg('debug', "items: ",map{json_out($_->as_hash)}map{$::tn{$_}}@$items) if $items; 20 | $items //= []; 21 | @_ = ($class, %args); 22 | my $self = super(); 23 | logpkg('debug',"new object: ", json_out($self->as_hash)); 24 | logpkg('debug', "items: ",json_out($items)); 25 | $self->{clip_counter} = $counter; 26 | $self->{items} = $items; 27 | $::this_sequence = $self; 28 | $self; 29 | } 30 | sub clip { 31 | my ($self, $index) = @_; 32 | return 0 if $index <= 0; 33 | $::tn{$self->{items}->[$index - 1]} 34 | } 35 | sub rw { 36 | my $self = shift; 37 | $::mode->{offset_run} ? OFF : $self->{rw} 38 | } 39 | # perl indexes arrays at zero, for nama users we number items from one 40 | sub insert_item { 41 | my $self = shift; 42 | my ($item, $index) = @_; 43 | $self->append_item($item), return if $index == @{$self->{items}} + 1; 44 | $self->verify_item($index) or die "$index: sequence index out of range"; 45 | splice @{$self->{items}}, $index - 1,0, $item->name 46 | } 47 | sub verify_item { 48 | my ($self, $index) = @_; 49 | $index >= 1 and $index <= scalar @{$self->items} 50 | } 51 | sub delete_item { 52 | my $self = shift; 53 | my $index = shift; 54 | $self->verify_item($index) or die "$index: sequence index out of range"; 55 | my $trackname = splice(@{$self->{items}}, $index - 1, 1); 56 | $::tn{$trackname} and $::tn{$trackname}->remove; 57 | } 58 | sub append_item { 59 | my $self = shift; 60 | my $item = shift; 61 | push( @{$self->{items}}, $item->name ); 62 | } 63 | sub item { 64 | my $self = shift; 65 | my $index = shift; 66 | return 0 if $index <= 0; 67 | $::tn{$self->{items}->[$index - 1]}; 68 | } 69 | sub list_output { 70 | my $self = shift; 71 | my $i; 72 | join "\n","Sequence $self->{name} clips:", 73 | map { join " ", 74 | ++$i, 75 | $::tn{$_}->n, 76 | $_, 77 | sprintf("%.3f %.3f", $::tn{$_}->duration, $::tn{$_}->endpoint), 78 | } @{$self->items} 79 | } 80 | sub remove { 81 | my $sequence = shift; 82 | 83 | # delete all clips 84 | map{$::tn{$_}->remove } $by_name{$sequence->name}->tracks; 85 | 86 | # delete clip array 87 | delete $sequence->{items}; 88 | 89 | my $mix_track = $::tn{$sequence->name}; 90 | 91 | if ( defined $mix_track ){ 92 | 93 | $mix_track->set(rw => OFF); 94 | 95 | # remove mix track unless it has some WAV files 96 | 97 | $mix_track->remove unless scalar @{ $mix_track->versions }; 98 | } 99 | 100 | # remove sequence from index 101 | 102 | delete $by_name{$sequence->name}; 103 | } 104 | sub new_clip { 105 | my ($self, $track, %args) = @_; # $track can be object or name 106 | my $markpair = delete $args{region}; 107 | logpkg('debug',json_out($self->as_hash), json_out($track->as_hash)); 108 | ref $track or $track = $::tn{$track} 109 | or die("$track: track not found."); 110 | my %region_args = ( 111 | region_start => $markpair && $markpair->[0]->name || $track->region_start, 112 | region_end => $markpair && $markpair->[1]->name || $track->region_end 113 | ); 114 | my $clip = ::Clip->new( 115 | target => $track->basename, 116 | name => $self->unique_clip_name($track->name, $track->playback_version), 117 | rw => PLAY, 118 | group => $self->name, 119 | version => $track->playback_version, 120 | hide => 1, 121 | %region_args, 122 | %args 123 | ); 124 | modify_effect( $clip->vol, 1, undef, fxn($track->vol)->params->[0]); 125 | modify_effect( $clip->pan, 1, undef, fxn($track->pan)->params->[0]); 126 | $clip 127 | } 128 | sub new_spacer { 129 | my( $self, %args ) = @_; 130 | my $position = delete $args{position}; 131 | my $spacer = ::Spacer->new( 132 | duration => $args{duration}, 133 | name => $self->unique_spacer_name(), 134 | rw => OFF, 135 | group => $self->name, 136 | ); 137 | $self->insert_item( $spacer, $position || ( scalar @{ $self->{items} } + 1 )) 138 | } 139 | sub unique_clip_name { 140 | my ($self, $trackname, $version) = @_; 141 | join '-', $self->name , ++$self->{clip_counter}, $trackname, 'v'.$version; 142 | } 143 | sub unique_spacer_name { 144 | my $self = shift; 145 | join '-', $self->name, ++$self->{clip_counter}, 'spacer'; 146 | } 147 | package ::; 148 | 149 | sub new_sequence { 150 | 151 | my %args = @_; 152 | my $name = $args{name}; 153 | my @tracks = defined $args{tracks} ? @{ $args{tracks} } : (); 154 | my $group = $args{group} || 'Main'; 155 | my $mix_track = $tn{$name} || add_track($name, group => $group); 156 | $mix_track->set( rw => MON, 157 | source_type => 'bus', 158 | source_id => $name, 159 | ); 160 | my $sequence = ::Sequence->new( 161 | name => $name, 162 | ); 163 | ; 164 | map{ $sequence->append_item($_) } 165 | map{ $sequence->new_clip($_)} @tracks; 166 | $this_sequence = $sequence; 167 | 168 | } 169 | sub compose_sequence { 170 | my ($sequence_name, $track, $markpairs) = @_; 171 | logpkg('debug',"sequence_name: $sequence_name, track:", $track->name, 172 | ", markpairs: ",::Dumper $markpairs); 173 | 174 | my $sequence = new_sequence( name => $sequence_name); 175 | logpkg('debug',"sequence\n",::Dumper $sequence); 176 | my @clips = map { 177 | $sequence->new_clip($track, region => $_) 178 | } @$markpairs; 179 | map{ $sequence->append_item($_) } @clips; 180 | $sequence 181 | } 182 | sub gather { 183 | my @list = grep{ $_->clip } ::Mark::all(); 184 | my $old = $this_track->name; 185 | my $track = $this_track; 186 | my $first = $list[0]; 187 | if ($first->discard){ @list = (0, @list, $track->length) } 188 | my @pairs; 189 | # assuming we're keeping from beginning, first mark is # discard 190 | while ( scalar @list ){ push @pairs, [splice( @list, 0, 2)] } 191 | ::compose_sequence($track->name, $track, \@pairs); 192 | nama_cmd($old); 193 | } 194 | sub delete_sequence { 195 | my $sequence_name = shift; 196 | $bn{$sequence_name}->remove; 197 | my @affected = grep{$_->source_type eq 'bus' and $_->source_id eq $sequence_name } all_tracks(); 198 | nama_cmd($_->name. ' source 1; play') for @affected; 199 | 200 | } 201 | 202 | 1 203 | __END__ 204 | -------------------------------------------------------------------------------- /src/Config.p: -------------------------------------------------------------------------------- 1 | # ------ Config subroutines ------ 2 | 3 | # To create a new config var: 4 | # 5 | # add the mapping, e.g. "$mix_to_disk_format $config->{mix_to_disk_format}" 6 | # (without quotes) to file var_config 7 | 8 | # these subs are in the main namespace 9 | 10 | package ::; 11 | 12 | use Modern::Perl '2020'; 13 | no warnings 'uninitialized'; 14 | 15 | use ::Globals qw(:all); 16 | 17 | # exclusive to this module 18 | our ( 19 | %subst, # substitutions 20 | ); 21 | 22 | ## configuration file 23 | 24 | sub global_config { 25 | 26 | # return text of config file, in the following order 27 | # or priority: 28 | # 29 | # 1. the file designated by the -f command line argument 30 | # 2. .namarc in the current project directory, i.e. ~/nama/untitled/.namarc 31 | # 3. .namarc in the home directory, i.e. ~/.namarc 32 | # 4. .namarc in the project root directory, i.e. ~/nama/.namarc 33 | if( $config->{opts}->{f} ){ 34 | pager_newline("reading config file $config->{opts}->{f}\n"); 35 | return read_file($config->{opts}->{f}); 36 | } 37 | my @search_path = (project_dir(), $ENV{HOME}, project_root() ); 38 | my $c = 0; 39 | map{ 40 | if (-d $_) { 41 | my $config_path = join_path($_, config_file()); 42 | if( -f $config_path or -l $config_path){ 43 | say "Found config file: $config_path"; 44 | my $yml = read_file($config_path); 45 | return $yml; 46 | } 47 | } 48 | } ( @search_path) 49 | } 50 | 51 | # sub global_config { 52 | # read_file( join_path($ENV{HOME}, config_file())); 53 | # } 54 | 55 | sub read_config { 56 | 57 | # read and process the configuration file 58 | # 59 | # use the embedded default file if none other is present 60 | 61 | logsub((caller(0))[3]); 62 | 63 | my $config_file = shift; 64 | 65 | my $yml = $config_file // get_data_section("default_namarc"); 66 | strip_all( $yml ); 67 | my %cfg = %{ yaml_in($yml) }; 68 | logpkg('debug', "config file:", Dumper \%cfg); 69 | *subst = \%{$cfg{abbreviations}}; # alias 70 | walk_tree(\%cfg); 71 | walk_tree(\%cfg); # second pass completes substitutions 72 | assign( 73 | data => \%cfg, 74 | vars => [ config_vars() ], 75 | class => '::', 76 | var_map => 1, 77 | ); 78 | $config->{root_dir} = $config->{opts}->{d} if $config->{opts}->{d}; 79 | $config->{root_dir} = expand_tilde($config->{root_dir}); 80 | $config->{sample_rate} = $cfg{abbreviations}{frequency}; 81 | $config->{use_git} and ! git_executable_found() and 82 | say("Config file requests Git version control, 83 | but the git executable could not be found. 84 | Please check that the git executable directory is included 85 | in your shell's \$PATH variable (currently $ENV{PATH}). 86 | 87 | Falling back to the file paradigm. :-( 88 | 89 | Note that the command 90 | 91 | nama> save initial_mix 92 | 93 | creates initial_mix.json, not a tagged commit. 94 | 95 | nama> get initial_mix 96 | 97 | loads initial_mix.json"); 98 | 99 | $config->{use_git} = $config->{use_git} && git_executable_found() ? 1 : 0; 100 | 101 | } 102 | 103 | sub git_executable_found { qx(which git) } 104 | 105 | sub walk_tree { 106 | #logsub((caller(0))[3]); 107 | my $ref = shift; 108 | map { substitute($ref, $_) } 109 | grep {$_ ne q(abbreviations)} 110 | keys %{ $ref }; 111 | } 112 | sub substitute{ 113 | my ($parent, $key) = @_; 114 | my $val = $parent->{$key}; 115 | #logpkg('debug', qq(key: $key val: $val\n) ); 116 | ref $val and walk_tree($val) 117 | or map{$parent->{$key} =~ s/$_/$subst{$_}/} keys %subst; 118 | } 119 | sub first_run { 120 | return if $config->{opts}->{f}; 121 | my $config_file = '.namarc'; 122 | my $config_path = "$ENV{HOME}/$config_file"; 123 | logpkg('debug', "config path: $config_path" ); 124 | if ( ! -e $config_path and ! -l $config_path ) { 125 | 126 | # check for missing components 127 | 128 | my $missing; 129 | my @a = `which analyseplugin`; 130 | @a or print( <; 150 | chomp $reply; 151 | print("Goodbye.\n"), exit unless $reply =~ /y/i; 152 | } 153 | print <; 163 | sleep 1; 164 | print <; 172 | chomp $reply; 173 | my $default_config; 174 | if ($reply !~ /n/i){ 175 | # write project root path into default namarc 176 | $default_config = get_data_section("default_namarc"); 177 | $default_config =~ s/^project_root.*$/project_root: $ENV{HOME}\/nama/m; 178 | 179 | # create path nama/untitled/.wav 180 | # 181 | # this creates directories for 182 | # - project root 183 | # - project name 'untitled', the default project, and 184 | # - project untitled's hidden directory for holding WAV files 185 | 186 | my $default_project_root = join_path($ENV{HOME}, 'nama'); 187 | mkpath( join_path($default_project_root, qw(untitled .wav)) ); 188 | $config->{root_dir} = $default_project_root; 189 | # needed for $file->user_customization() to resolve in next line 190 | write_file($file->user_customization(), get_data_section('custom_pl')); 191 | } else { 192 | print <init_gui interpreted? If $ui belongs to class 80 | # ::Text, Nama finds a no-op init_gui() stub in package ::Text 81 | # and does nothing. 82 | 83 | # If $ui belongs to class ::Graphical, Nama looks for 84 | # init_gui() in package ::Graphical, finds nothing, so goes to 85 | # look in the base class. All graphical methods (found in 86 | # Graphical_subs.pl) are defined in the root namespace so they can 87 | # call Nama core methods without a package prefix. 88 | 89 | ######## Nama classes ######## 90 | 91 | use ::Track; 92 | use ::Bus; 93 | use ::Sequence; 94 | use ::Mark; 95 | use ::IO; 96 | use ::Insert; 97 | use ::Fade; 98 | use ::Edit; 99 | use ::EffectChain; 100 | use ::Lat; 101 | use ::Engine; 102 | use ::Waveform; 103 | 104 | ####### Nama Roles - loaded by another class 105 | 106 | # use ::Wav; 107 | 108 | ####### Nama subroutines ###### 109 | # 110 | # The following modules serve only to define and segregate subroutines. 111 | # They occupy the root namespace (except ::ChainSetup) 112 | # and do not execute any code when use'd. 113 | 114 | use ::AnalyseLV2; 115 | use ::Initializations (); 116 | use ::Options (); 117 | use ::Config (); 118 | use ::Custom (); 119 | use ::Terminal (); 120 | use ::Grammar (); 121 | use ::Help (); 122 | 123 | use ::Project (); 124 | use ::Persistence (); 125 | use ::Git; 126 | 127 | use ::ChainSetup (); # separate namespace 128 | use ::Graph (); 129 | use ::Modes (); 130 | use ::Mix (); 131 | use ::Memoize (); 132 | 133 | use ::StatusSnapshot (); 134 | use ::EngineSetup (); 135 | use ::EffectsRegistry (); 136 | use ::Effect q(:all); 137 | use ::MuteSoloFade (); 138 | use ::Jack (); 139 | 140 | use ::Regions (); 141 | use ::CacheTrack (); 142 | use ::Bunch (); 143 | use ::Wavinfo (); 144 | use ::Midi (); 145 | use ::Latency (); 146 | use ::Log qw(logit loggit logpkg logsub initialize_logger); 147 | use ::TrackUtils (); 148 | 149 | use ::Tempo (); 150 | 151 | sub main { 152 | say eval join(get_data_section('banner'), qw(" ")); 153 | startup(); 154 | load_project(name => shift @ARGV, 155 | create => delete $config->{opts}->{c}); 156 | # remove option for next project load 157 | nama_cmd($config->{execute_on_project_load}); 158 | nama_cmd($config->{opts}->{X}); 159 | reconfigure_engine(); 160 | $ui->loop(); 161 | } 162 | 163 | sub startup { 164 | initializations(); 165 | process_command_line_options(); 166 | start_logging(); 167 | setup_grammar(); 168 | initialize_interfaces(); 169 | } 170 | sub kill_and_reap { 171 | my @pids = @_; 172 | map{ my $pid = $_; 173 | map{ my $signal = $_; 174 | kill $signal, $pid; 175 | sleeper(0.2); 176 | } (15,9); 177 | waitpid $pid, 1; 178 | } @pids; 179 | } 180 | 181 | sub cleanup_exit { 182 | logsub((caller(0))[3]); 183 | remove_riff_header_stubs(); 184 | trigger_rec_cleanup_hooks(); 185 | # for each process: 186 | # - SIGINT (1st time) 187 | # - allow time to close down 188 | # - SIGINT (2nd time) 189 | # - allow time to close down 190 | # - SIGKILL 191 | delete $project->{events}; 192 | #project_snapshot(); 193 | ::Engine::sync_action('kill_and_reap'); 194 | $term->rl_deprep_terminal() if defined $term; 195 | exit; 196 | } 197 | END { } 198 | 199 | 1; 200 | __DATA__ 201 | 202 | =head1 NAME 203 | 204 | =encoding UTF-8 205 | 206 | B - multitrack recorder and digital audio workstation 207 | 208 | See `man nama` for details. 209 | 210 | @@ commands_yml 211 | [% qx(cat ./commands.yml ) %] 212 | @@ grammar 213 | [% qx(./strip_all ./grammar_body.pl) %] 214 | [% qx(./emit_command_headers headers) %] 215 | @@ ecasound_chain_operator_hints_yml 216 | [% qx(cat ./ecasound_chain_operator_hints.yml) %]; 217 | @@ default_namarc 218 | [% qx(cat ./namarc) %] 219 | @@ custom_pl 220 | [% qx(cat ./customize.pl) %] 221 | @@ fake_jack_lsp 222 | [% qx(cat ./fake_jack_lsp) %] 223 | @@ fake_lv2_register 224 | [% qx(cat ./fake_lv2_register) %] 225 | @@ fake_jack_latency 226 | [% qx(cat ./fake_jack_latency) %] 227 | @@ midi_commands 228 | [% qx(cat ./midish_commands) %] 229 | @@ default_palette_json 230 | [% qx(cat ./palette.json) %] 231 | @@ banner 232 | [% qx(cat ./banner) %] 233 | @@ midi_help 234 | [% qx(cat ./midi_help) %] 235 | @@ aux_midi_commands 236 | [% qx(cat ./fs_midish) %] 237 | @@ test_tempo_map 238 | [% qx(cat ./tempo_map) %] 239 | @@ hotkey_grammar 240 | [% qx(cat ./hotkey_grammar.pl) %] 241 | 242 | =cut 243 | -------------------------------------------------------------------------------- /src/EcasoundRun.p: -------------------------------------------------------------------------------- 1 | package ::EcasoundRun; 2 | use Role::Tiny; 3 | use Modern::Perl '2020'; 4 | our $VERSION = 1.0; 5 | use ::Globals qw(:all); 6 | use ::Log qw(logpkg logsub); 7 | sub start { 8 | package ::; 9 | my $self = shift; 10 | 11 | $self->valid_setup 12 | or throw("\nAudio engine is not configured. Cannot start.\n"),return; 13 | 14 | 15 | # use gradual unmuting to avoid pop on start 16 | # 17 | # 18 | # mute unless recording 19 | # start 20 | # wait 0.5s 21 | # unmute 22 | # start heartbeat 23 | # report engine status 24 | # sleep 1s 25 | # 26 | 27 | pager("\n\nStarting at ". current_position()) unless $quiet; 28 | schedule_wraparound(); 29 | mute(); 30 | $self->start_command; 31 | $self->{started}++; 32 | start_midi_transport() if midi_run_ready(); 33 | 34 | # limit engine run time if we are in mixdown or edit mode, 35 | # or if requested by user, set timer to specified time 36 | # defaulting to the result of cs-get-length 37 | limit_processing_time( ($setup->{runtime_limit} || $setup->{audio_length}) + $setup->{extra_run_time}) 38 | if mixing_only() 39 | or edit_mode() 40 | or defined $setup->{runtime_limit}; 41 | # TODO and live processing 42 | #$project->{events}->{post_start_unmute} = AE::timer(0.5, 0, sub{unmute()}); 43 | sleeper(0.5); 44 | unmute(); 45 | sleeper(0.5); 46 | $ui->set_engine_mode_color_display(); 47 | start_heartbeat(); 48 | engine_status() unless $quiet; 49 | } 50 | sub stop { 51 | package ::; 52 | my $self = shift; 53 | if ($self->running()) 54 | { 55 | # Since the playback position advances slightly during 56 | # the fade, we restore the position to exactly where the 57 | # stop command was issued. 58 | 59 | my $pos; 60 | $pos = $self->ecasound_iam('getpos') if ! ::ChainSetup::really_recording(); 61 | mute(); 62 | $self->stop_command; 63 | disable_length_timer(); 64 | if ( ! $quiet ){ 65 | sleeper(0.5); 66 | engine_status(current_position(),2,0); 67 | } 68 | unmute(); 69 | stop_heartbeat(); 70 | $ui->project_label_configure(-background => $gui->{_old_bg}); 71 | 72 | # restore exact position transport stop command was issued 73 | 74 | set_position($pos) if $pos 75 | } 76 | } 77 | sub stop_command { $_[0]->ecasound_iam('stop-sync') } 78 | sub start_command { $_[0]->ecasound_iam('start') } 79 | ### routines defined in the root namespace 80 | 81 | package ::; 82 | use Modern::Perl '2020'; use Carp; 83 | no warnings 'uninitialized'; 84 | use ::Util qw(process_is_running); 85 | 86 | sub mixing_only { 87 | my $i; 88 | my $am_mixing; 89 | for (::ChainSetup::really_recording()){ 90 | $i++; 91 | $am_mixing++ if /Mixdown/; 92 | } 93 | $i == 1 and $am_mixing 94 | } 95 | 96 | sub sync_transport_position { } 97 | 98 | sub midish_running { $setup->{midish_running} } 99 | 100 | sub toggle_transport { $this_engine->running() ? stop_transport() : start_transport() } 101 | 102 | sub disconnect_transport { 103 | return if $this_engine->running; 104 | teardown_engine(); 105 | } 106 | sub engine_is { 107 | my $pos = shift; 108 | "\n\nEngine is ". $this_engine->ecasound_iam("engine-status"). ( $pos ? " at $pos" : "" ) 109 | } 110 | sub engine_status { 111 | my ($pos, $before_newlines, $after_newlines) = @_; 112 | pager("\n" x $before_newlines, engine_is($pos), "\n" x $after_newlines); 113 | } 114 | sub current_position { 115 | my $pos = $this_engine->ecasound_iam("getpos"); 116 | colonize(int($pos || 0)) 117 | } 118 | sub start_heartbeat { 119 | $project->{events}->{poll_engine} = AE::timer(0, 1, \&::heartbeat); 120 | $ui->setup_playback_indicator(); 121 | } 122 | sub stop_heartbeat { 123 | # the following test avoids double-tripping rec_cleanup() 124 | # following manual stop 125 | return unless $project->{events}->{poll_engine}; 126 | undef $project->{events}->{poll_engine}; 127 | undef $project->{events}->{update_playback_position_display}; 128 | $ui->reset_engine_mode_color_display(); 129 | rec_cleanup() 130 | } 131 | sub heartbeat { 132 | 133 | # print "heartbeat fired\n"; 134 | 135 | my $here = $this_engine->ecasound_iam("getpos"); 136 | my $status = $this_engine->ecasound_iam('engine-status'); 137 | if( $status =~ /finished|error/ ){ 138 | engine_status(current_position(),2,1); 139 | revise_prompt(); 140 | stop_heartbeat(); 141 | sleeper(0.2); 142 | delete $this_engine->{started}; 143 | set_position(0); 144 | } 145 | #print join " ", $status, colonize($here), $/; 146 | my ($start, $end); 147 | $start = ::Mark::loop_start(); 148 | $end = ::Mark::loop_end(); 149 | schedule_wraparound() 150 | if $mode->{loop_enable} 151 | and defined $start 152 | and defined $end 153 | and ! ::ChainSetup::really_recording(); 154 | 155 | update_clock_display(); 156 | 157 | } 158 | 159 | sub update_clock_display { 160 | $ui->clock_config(-text => current_position()); 161 | } 162 | sub schedule_wraparound { 163 | 164 | return unless $mode->{loop_enable}; 165 | my $here = $this_engine->ecasound_iam("getpos"); 166 | my $start = ::Mark::loop_start(); 167 | my $end = ::Mark::loop_end(); 168 | my $diff = $end - $here; 169 | logpkg('debug', "here: $here, start: $start, end: $end, diff: $diff"); 170 | if ( $diff < 0 ){ # go at once 171 | set_position($start); 172 | cancel_wraparound(); 173 | } elsif ( $diff < 3 ) { #schedule the move 174 | wraparound($diff, $start); 175 | } 176 | } 177 | sub cancel_wraparound { 178 | $project->{events}->{wraparound} = undef; 179 | } 180 | sub limit_processing_time { 181 | my $length = shift; 182 | $project->{events}->{processing_time} 183 | = AE::timer($length, 0, sub { ::stop_transport(); print prompt() }); 184 | } 185 | sub disable_length_timer { 186 | $project->{events}->{processing_time} = undef; 187 | undef $setup->{runtime_limit}; 188 | } 189 | sub wraparound { 190 | my ($diff, $start) = @_; 191 | #print "diff: $diff, start: $start\n"; 192 | $project->{events}->{wraparound} = undef; 193 | $project->{events}->{wraparound} = AE::timer($diff,0, sub{set_position($start)}); 194 | } 195 | sub stop_do_start { 196 | my ($coderef, $delay) = @_; 197 | $this_engine->started() ? _stop_do_start( $coderef, $delay) 198 | : $coderef->() 199 | 200 | } 201 | sub _stop_do_start { 202 | my ($coderef, $delay) = @_; 203 | $this_engine->stop_command(); 204 | my $result = $coderef->(); 205 | sleeper($delay) if $delay; 206 | $this_engine->start_command(); 207 | $result 208 | } 209 | sub restart_ecasound { 210 | pager_newline("killing ecasound processes @{$en{$::config->{ecasound_engine_name}}->{pids}}"); 211 | kill_my_ecasound_processes(); 212 | pager_newline(q(restarting Ecasound engine - your may need to use the "arm" command)); 213 | initialize_ecasound_engine(); 214 | request_setup(); 215 | reconfigure_engine(); 216 | } 217 | sub kill_my_ecasound_processes { 218 | my @signals = (15, 9); 219 | map{ kill $_, @{$en{$::config->{ecasound_engine_name}}->{pids}}; sleeper(1)} @signals; 220 | } 221 | 222 | 223 | 1 224 | -------------------------------------------------------------------------------- /src/Git.p: -------------------------------------------------------------------------------- 1 | # ---------- Git Support ---------- 2 | package ::; 3 | use Modern::Perl '2020'; 4 | sub git { 5 | return if is_test_script(); 6 | $config->{use_git} or warn("@_: git command, but git is not enabled. 7 | You may want to set use_git: 1 in .namarc"), return; 8 | logpkg('debug',"VCS command: git @_"); 9 | $project->{repo}->run(@_) 10 | } 11 | sub repo_git_dir { join_path(project_dir(),'.git') } 12 | sub init_repo_obj { $project->{repo} = Git::Repository->new( work_tree => project_dir() ) } 13 | sub create_repo { Git::Repository->run( init => project_dir() )} 14 | 15 | sub initialize_project_repository { 16 | logsub((caller(0))[3]); 17 | ::throw("either a test script running or use_git: 0 is configured in .namarc. ", 18 | "No repo created for project ", project_dir()), 19 | return if not $config->{use_git} or is_test_script(); 20 | if (not -d repo_git_dir()){ 21 | pager("Creating git repository in ". repo_git_dir()); 22 | create_repo; 23 | init_repo_obj(); 24 | create_file_stubs(); 25 | git_commit('initialize_repository'); 26 | } else { 27 | init_repo_obj(); 28 | #git_commit('committing prior changes') if git_diff(); 29 | } 30 | } 31 | sub git_diff { 32 | my @files = @_; 33 | my $diff = git('diff', @files); 34 | $diff =~ /\S/ ? $diff : undef 35 | } 36 | sub git_tag_exists { 37 | logsub((caller(0))[3]); 38 | my $tag = shift; 39 | grep { $tag eq $_ } git( 'tag','--list'); 40 | } 41 | 42 | # on command "get foo", Nama opens a branch name 'foo-branch', 43 | # or returns to HEAD of existing branch 'foo-branch' 44 | 45 | sub tag_branch { "$_[0]-branch" } 46 | 47 | sub restore_state_from_vcs { 48 | logsub((caller(0))[3]); 49 | my $name = shift; # tag or branch 50 | 51 | # checkout branch if matching branch exists 52 | 53 | if (git_branch_exists($name)){ 54 | pager_newline( qq($name: branch exists. Checking out branch $name.) ); 55 | git_checkout($name); 56 | 57 | } 58 | 59 | # checkout branch diverging at tag if matching that tag 60 | 61 | elsif ( git_tag_exists($name) ){ 62 | 63 | my $tag = $name; 64 | my $branch = tag_branch($tag); 65 | 66 | if (git_branch_exists($branch)){ 67 | pager_newline( qq(tag $tag: matching branch exists. Checking out $branch.) ); 68 | git_checkout($branch); 69 | } 70 | 71 | else { 72 | pager_newline( "Creating and checking out branch $branch from tag $tag"); 73 | git_create_branch($branch, $tag); 74 | 75 | } 76 | } 77 | else { throw("$name: tag doesn't exist. Cannot checkout."), return } 78 | 79 | restore_state_from_file(); 80 | } 81 | 82 | sub project_snapshot { 83 | logsub((caller(0))[3]); 84 | return if $config->{opts}->{R} 85 | or $this_engine->running and ::ChainSetup::really_recording(); 86 | # we skip storing commands that do not affect project state 87 | 88 | save_state(); 89 | reset_command_buffer(), return if not state_changed(); 90 | 91 | return if not $config->{use_git} 92 | or not $project->{name} 93 | or not $project->{repo}; 94 | 95 | my $commit_message = shift() || ""; 96 | git_commit($commit_message); 97 | } 98 | 99 | sub reset_command_buffer { $project->{command_buffer} = [] } 100 | 101 | sub command_buffer_contents { 102 | no warnings 'uninitialized'; 103 | scalar @{$project->{command_buffer}} and join("\n", 104 | undef, 105 | (map{ $_->{command} } @{$project->{command_buffer}}), 106 | # context for first command of group 107 | "* track: $project->{command_buffer}->[0]->{context}->{track}", 108 | "* bus: $project->{command_buffer}->[0]->{context}->{bus}", 109 | "* op: $project->{command_buffer}->[0]->{context}->{op}" 110 | ) or undef 111 | } 112 | sub git_commit { 113 | logsub((caller(0))[3]); 114 | my $commit_message = shift; 115 | my @defaults = ($file->state_store, $file->midi_store, $file->tempo_map); 116 | my @files = scalar @_ ? @_ : @defaults; 117 | no warnings 'uninitialized'; 118 | @files = @defaults if not @files; 119 | $commit_message .= command_buffer_contents(); 120 | use utf8; 121 | git( add => @files); 122 | git( commit => '--quiet', '--message', $commit_message); 123 | reset_command_buffer(); 124 | } 125 | 126 | sub git_checkout { 127 | logsub((caller(0))[3]); 128 | my ($branchname, @args) = @_; 129 | return unless $config->{use_git}; 130 | 131 | my $exist_message = git_branch_exists($branchname) 132 | ? undef 133 | : "$branchname: branch does not exist."; 134 | my $dirty_tree_msg = !! state_changed() 135 | ? "You have changes to working files. 136 | You cannot switch branches until you commit 137 | these changes, or throw them away." 138 | : undef; 139 | 140 | my $conjunction = ($dirty_tree_msg and $exist_message) 141 | ? "And by the way, " 142 | : undef; 143 | 144 | throw( $dirty_tree_msg, 145 | $conjunction, 146 | $exist_message, 147 | "No action taken."), return 148 | if $dirty_tree_msg or $exist_message; 149 | 150 | git(checkout => $branchname, @args); 151 | 152 | } 153 | 154 | sub git_create_branch { 155 | logsub((caller(0))[3]); 156 | my ($branchname, $branchfrom) = @_; 157 | return unless $config->{use_git}; 158 | # create new branch 159 | my @args; 160 | my $from_target; 161 | $from_target = "from $branchfrom" if $branchfrom; 162 | push @args, $branchname; 163 | push(@args, $branchfrom) if $branchfrom; 164 | pager("Creating branch $branchname $from_target"); 165 | git(checkout => '-b', @args) 166 | } 167 | 168 | sub state_changed { 169 | logsub((caller(0))[3]); 170 | return unless $config->{use_git}; 171 | git_diff(); 172 | } 173 | 174 | sub git_branch_exists { 175 | logsub((caller(0))[3]); 176 | return unless $config->{use_git}; 177 | my $branchname = shift; 178 | grep{ $_ eq $branchname } 179 | map{ s/^\s+//; s/^\* //; $_} 180 | git("branch"); 181 | } 182 | 183 | sub current_branch { 184 | logsub((caller(0))[3]); 185 | return unless $project->{repo}; 186 | my ($b) = map{ /\* (\S+)/ } grep{ /\*/ } split "\n", git('branch'); 187 | $b 188 | } 189 | 190 | sub git_sha { 191 | my $commit = shift || 'HEAD'; 192 | my ($sha) = git(show => $commit) =~ /commit ([0-9a-f]{10})/; 193 | $sha 194 | } 195 | sub git_branch_display { 196 | logsub((caller(0))[3]); 197 | my $display = $::project->{name}; 198 | return $display unless $config->{use_git}; 199 | my $cb = current_branch(); 200 | $display .= ":$cb" if $cb and $cb ne 'master'; 201 | $display 202 | } 203 | sub list_branches { 204 | pager_newline( 205 | "---Branches--- (asterisk marks current branch)", 206 | $project->{repo}->run('branch'), 207 | "", 208 | "-----Tags-----", 209 | $project->{repo}->run('tag','--list') 210 | ); 211 | } 212 | 213 | sub redo { 214 | if ($project->{redo}){ 215 | git('cherry-pick',$project->{redo}); 216 | load_project(name => $project->{name}); 217 | delete $project->{redo}; 218 | } else {throw("nothing to redo")} 219 | 1 220 | } 221 | sub undo { 222 | pager("removing last commit"); 223 | local $quiet = 1; 224 | 225 | # get the commit id 226 | my $show = git(qw/show HEAD/); 227 | my ($commit) = $show =~ /commit ([a-z0-9]{10})/; 228 | 229 | # blow it away 230 | git(qw/reset --hard HEAD^/); 231 | load_project( name => $project->{name}); 232 | 233 | # remember it 234 | $project->{redo} = $commit; 235 | } 236 | sub show_head_commit { 237 | my $show = git(qw/show HEAD/); 238 | my ($commit) = $show =~ /commit ([a-z0-9]{10})/; 239 | my (undef,$msg) = split "\n\n",$show; 240 | pager_newline("commit: $commit",$msg); 241 | } 242 | 1 243 | --------------------------------------------------------------------------------