Audio-Nama-1.078/0000755000175000017500000000000011623340132012475 5ustar jrothjrothAudio-Nama-1.078/lib/0000755000175000017500000000000011623340132013243 5ustar jrothjrothAudio-Nama-1.078/lib/Audio/0000755000175000017500000000000011623340132014304 5ustar jrothjrothAudio-Nama-1.078/lib/Audio/Nama/0000755000175000017500000000000011623340132015160 5ustar jrothjrothAudio-Nama-1.078/lib/Audio/Nama/IO.pm0000644000175000017500000002726511623337667016064 0ustar jrothjroth# ---------- IO ----------- # # IO objects for writing Ecasound chain setup file # # Object values can come from three sources: # # 1. As arguments to the constructor new() while walking the # routing graph: # + assigned by dispatch: chain_id, loop_id, track, etc. # + override by graph node (higher priority) # + override by graph edge (highest priority) # 2. (sub)class methods called as $object->method_name # + defined as _method_name (access via AUTOLOAD, overrideable by constructor) # + defined as method_name (not overrideable) # 3. AUTOLOAD # + any other method calls are passed to the the associated track # + illegal track method call generate an exception package Audio::Nama::IO; use Modern::Perl; use Carp; our $VERSION = 1.0; # we will use the following to map from graph node names # to IO class names our %io_class = qw( null_in Audio::Nama::IO::from_null null_out Audio::Nama::IO::to_null soundcard_in Audio::Nama::IO::from_soundcard soundcard_out Audio::Nama::IO::to_soundcard soundcard_device_in Audio::Nama::IO::from_soundcard_device soundcard_device_out Audio::Nama::IO::to_soundcard_device wav_in Audio::Nama::IO::from_wav wav_out Audio::Nama::IO::to_wav loop_source Audio::Nama::IO::from_loop loop_sink Audio::Nama::IO::to_loop jack_manual_in Audio::Nama::IO::from_jack_port jack_manual_out Audio::Nama::IO::to_jack_port jack_ports_list_in Audio::Nama::IO::from_jack_port jack_ports_list_out Audio::Nama::IO::to_jack_port jack_multi_in Audio::Nama::IO::from_jack_multi jack_multi_out Audio::Nama::IO::to_jack_multi jack_client_in Audio::Nama::IO::from_jack_client jack_client_out Audio::Nama::IO::to_jack_client ); ### class descriptions # === CLASS Audio::Nama::IO::from_jack_port === # # is triggered by source_type codes: # # + jack_manual_in # + jack_ports_list_in # # For track 'piano', the class creates an input similar to: # # -i:jack,,piano_in # # which receives input from JACK node: # # + ecasound:piano_in, # # If piano is stereo, the actual ports will be: # # + ecasound:piano_in_1 # + ecasound:piano_in_2 # (CLASS Audio::Nama::IO::to_jack_port is similar) ### class definition our $AUTOLOAD; # add underscore to field names so that regular method # access will go through AUTOLOAD # we add an underscore to each key use Audio::Nama::Object qw(track_ chain_id_ endpoint_ format_ format_template_ width_ ecs_extra_ direction_ device_id_); sub new { my $class = shift; my %vals = @_; my @args = map{$_."_", $vals{$_}} keys %vals; # add underscore to key # note that we won't check for illegal fields # so we can pass any value and allow AUTOLOAD to # check the hash for it. bless {@args}, $class } sub ecs_string { my $self = shift; my @parts; push @parts, '-f:'.$self->format if $self->format; push @parts, '-'.$self->io_prefix.':'.$self->device_id; join ' ',@parts; } sub format { my $self = shift; Audio::Nama::signal_format($self->format_template, $self->width) if $self->format_template and $self->width } sub _format_template {} # the leading underscore allows override # by a method without the underscore sub _ecs_extra {} # allow override sub direction { (ref $_[0]) =~ /::from/ ? 'input' : 'output' } sub io_prefix { substr $_[0]->direction, 0, 1 } # 'i' or 'o' sub AUTOLOAD { my $self = shift; # get tail of method call my ($call) = $AUTOLOAD =~ /([^:]+)$/; my $result = q(); my $field = "$call\_"; my $method = "_$call"; return $self->{$field} if exists $self->{$field}; return $self->$method if $self->can($method); if ( my $track = $Audio::Nama::tn{$self->{track_}} ){ return $track->$call if $track->can($call) # ->can is reliable here because Track has no AUTOLOAD } print $self->dump; croak "Autoload fell through. Object type: ", (ref $self), ", illegal method call: $call\n"; } sub DESTROY {} # The following methods were moved here from the Track class # because they are only used in generating chain setups. # They retain $track as the $self variable. sub _mono_to_stereo{ # Truth table #REC status, Track width stereo: null #REC status, Track width mono: chcopy #MON status, WAV width mono: chcopy #MON status, WAV width stereo: null #Higher channel count (WAV or Track): null my $self = shift; my $status = $self->rec_status(); my $copy = "-chcopy:1,2"; my $nocopy = ""; my $is_mono_track = sub { $self->width == 1 }; my $is_mono_wav = sub { Audio::Nama::channels($self->wav_format) == 1}; if ( $status eq 'REC' and $is_mono_track->() or $status eq 'MON' and $is_mono_wav->() ) { $copy } else { $nocopy } } sub _playat_output { my $track = shift; return unless $track->adjusted_playat_time; join ',',"playat" , $track->adjusted_playat_time; } sub _select_output { my $track = shift; my $start = $track->adjusted_region_start_time + Audio::Nama::hardware_latency(); my $end = $track->adjusted_region_end_time; return unless Audio::Nama::hardware_latency() or defined $start and defined $end; my $length; # CASE 1: a region is defined if ($end) { $length = $end - $start; } # CASE 2: only hardware latency else { $length = $track->wav_length - $start } join ',',"select", $start, $length } ### utility subroutines sub get_class { my ($type,$direction) = @_; Audio::Nama::Graph::is_a_loop($type) and return $io_class{ $direction eq 'input' ? "loop_source" : "loop_sink"}; $io_class{$type} or croak "unrecognized IO type: $type" } sub soundcard_input_type_string { $Audio::Nama::jack_running ? 'jack_multi_in' : 'soundcard_device_in' } sub soundcard_output_type_string { $Audio::Nama::jack_running ? 'jack_multi_out' : 'soundcard_device_out' } sub soundcard_input_device_string { $Audio::Nama::jack_running ? 'system' : $Audio::Nama::alsa_capture_device } sub soundcard_output_device_string { $Audio::Nama::jack_running ? 'system' : $Audio::Nama::alsa_playback_device } sub jack_multi_route { my ($client, $direction, $start, $width) = @_; # can we route to these channels? my $end = $start + $width - 1; # the following logic avoids deferencing undef for a # non-existent client, and correctly handles # the case of a portname (containing colon) my $count_maybe_ref = $Audio::Nama::jack{$client}{$direction}; my $max = ref $count_maybe_ref eq 'ARRAY' ? scalar @$count_maybe_ref : $count_maybe_ref; #my $max = scalar @{$Audio::Nama::jack{$client}{$direction}}; die qq(JACK client "$client", direction: $direction channel ($end) is out of bounds. $max channels maximum.\n) if $end > $max; join q(,),q(jack_multi), map{quote_jack_port($_)} @{$Audio::Nama::jack{$client}{$direction}}[$start-1..$end-1]; } sub default_jack_ports_list { my ($track_name) = shift; "$track_name.ports" } sub quote_jack_port { my $port = shift; ($port =~ /\s/ and $port !~ /^"/) ? qq("$port") : $port } ### subclass definitions ### method names with a preceding underscore ### can be overridded by the object constructor package Audio::Nama::IO::from_null; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; sub _device_id { 'null' } # package Audio::Nama::IO::to_null; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; sub _device_id { 'null' } # underscore for testing package Audio::Nama::IO::from_wav; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; sub device_id { my $io = shift; my @modifiers; push @modifiers, $io->playat_output if $io->playat_output; push @modifiers, $io->select_output if $io->select_output; push @modifiers, split " ", $io->modifiers if $io->modifiers; push @modifiers, $io->full_path; join(q[,],@modifiers); } sub ecs_extra { $_[0]->mono_to_stereo} package Audio::Nama::IO::to_wav; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; sub device_id { $_[0]->full_path } sub _format_template { $Audio::Nama::raw_to_disk_format } package Audio::Nama::IO::from_loop; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; sub new { my $class = shift; my %vals = @_; $class->SUPER::new( %vals, device_id => "loop,$vals{endpoint}"); } package Audio::Nama::IO::to_loop; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO::from_loop'; package Audio::Nama::IO::from_soundcard; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; sub new { shift; # throw away class my $class = $io_class{Audio::Nama::IO::soundcard_input_type_string()}; $class->new(@_); } package Audio::Nama::IO::to_soundcard; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; sub new { shift; # throw away class my $class = $io_class{Audio::Nama::IO::soundcard_output_type_string()}; $class->new(@_); } package Audio::Nama::IO::to_jack_multi; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; sub device_id { my $io = shift; # maybe source_id is an input number my $client = $io->direction eq 'input' ? $io->source_id : $io->send_id; my $channel = 1; # we want the direction with respect to the client, i.e. # reversed my $client_direction = $io->direction eq 'input' ? 'output' : 'input'; if( Audio::Nama::dest_type($client) eq 'soundcard'){ $channel = $client; $client = Audio::Nama::IO::soundcard_input_device_string(); # system, okay for output } Audio::Nama::IO::jack_multi_route($client,$client_direction,$channel,$io->width ) } # don't need to specify format, since we take all channels package Audio::Nama::IO::from_jack_multi; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO::to_jack_multi'; sub ecs_extra { $_[0]->mono_to_stereo } package Audio::Nama::IO::to_jack_port; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; sub format_template { $Audio::Nama::devices{jack}{signal_format} } sub device_id { 'jack,,'.$_[0]->port_name.'_out' } package Audio::Nama::IO::from_jack_port; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO::to_jack_port'; sub device_id { 'jack,,'.$_[0]->port_name.'_in' } sub ecs_extra { $_[0]->mono_to_stereo } package Audio::Nama::IO::to_jack_client; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; sub device_id { "jack," . Audio::Nama::IO::quote_jack_port($_[0]->send_id); } package Audio::Nama::IO::from_jack_client; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; sub device_id { 'jack,'. Audio::Nama::IO::quote_jack_port($_[0]->source_id); } sub ecs_extra { $_[0]->mono_to_stereo} package Audio::Nama::IO::from_soundcard_device; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; sub ecs_extra { join ' ', $_[0]->rec_route, $_[0]->mono_to_stereo } sub device_id { $Audio::Nama::devices{$Audio::Nama::alsa_capture_device}{ecasound_id} } sub input_channel { $_[0]->source_id } sub rec_route { # works for mono/stereo only! no warnings qw(uninitialized); my $self = shift; # needed only if input channel is greater than 1 return '' if ! $self->input_channel or $self->input_channel == 1; my $route = "-chmove:" . $self->input_channel . ",1"; if ( $self->width == 2){ $route .= " -chmove:" . ($self->input_channel + 1) . ",2"; } return $route; } { package Audio::Nama::IO::to_soundcard_device; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; sub device_id { $Audio::Nama::devices{$Audio::Nama::alsa_playback_device}{ecasound_id} } sub ecs_extra {route($_[0]->width,$_[0]->output_channel) } sub output_channel { $_[0]->send_id } sub route2 { my ($from, $to, $width) = @_; } sub route { # routes signals (1..$width) to ($dest..$dest+$width-1 ) my ($width, $dest) = @_; return '' if ! $dest or $dest == 1; # print "route: width: $width, destination: $dest\n\n"; my $offset = $dest - 1; my $route ; for my $c ( map{$width - $_ + 1} 1..$width ) { $route .= " -chmove:$c," . ( $c + $offset); } $route; } } package Audio::Nama::IO::any; use Modern::Perl; use vars qw(@ISA); @ISA = 'Audio::Nama::IO'; 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Graphical.pm0000644000175000017500000012147111623337670017433 0ustar jrothjroth# ------------ Graphical Interface ------------ package Audio::Nama; our $VERSION = 1.071; our ( $attribs, $term, $prompt, $debug, $debug2, $preview, $main, $ui, %ti, %tn, %bn, %effect_i, %effect_j, @effects, %cops, %copp, %copp_exp, %mute_level, %unity_level, %fade_out_level, $project_name, $project_root, $unit, %event_id, $soundcard_channels, $tk_input_channels,# for menubutton %e_bound, @ladspa_sorted, %oid_status, $default_palette_yml, # default GUI colors $palette_file, # where to save selections %palette, %nama_palette, ); our ( # variables for GUI text input widgets $project, $track_name, $ch_r, # recording channel assignment $ch_m, # monitoring channel assignment $save_id, # name for save file # Widgets $mw, # main window $ew, # effects window $canvas, # to lay out the effects window # each part of the main window gets its own frame # to control the layout better $load_frame, $add_frame, $group_frame, $time_frame, $clock_frame, $oid_frame, $track_frame, $effect_frame, $iam_frame, $perl_eval_frame, $transport_frame, $mark_frame, $fast_frame, # forward, rewind, etc. ## collected widgets (i may need to destroy them) %parent, # ->{mw} = $mw; # main window # ->{ew} = $ew; # effects window # eventually will contain all major frames $group_label, $group_rw, # $group_version, # %track_widget, # for chains (tracks) %track_widget_remove, # what to destroy by remove_track %effects_widget, # for effects @widget_o, # for templates (oids) %widget_o, # %mark_widget, # marks @global_version_buttons, # to set the same version for # all tracks $markers_armed, # set true to enable removing a mark $mark_remove, # a button that sets $markers_armed $time_step, # widget shows jump multiplier unit (seconds or minutes) $clock, # displays clock $setup_length, # displays setup running time $project_label, # project name $sn_label, # project load/save/quit $sn_text, $sn_load, $sn_new, $sn_quit, $sn_palette, # configure default master window colors $sn_namapalette, # configure nama-specific master-window colors $sn_effects_palette, # configure effects window colors @palettefields, # set by setPalette method @namafields, # field names for color palette used by nama %namapalette, # nama's indicator colors $rec, # background color $mon, # background color $off, # background color ### A separate box for entering IAM (and other) commands $iam_label, $iam_text, $iam, # variable for text entry $iam_execute, $iam_error, # unused # add track gui # $build_track_label, $build_track_text, $build_track_add_mono, $build_track_add_stereo, $build_track_rec_label, $build_track_rec_text, $build_track_mon_label, $build_track_mon_text, $build_new_take, # transport controls $transport_label, $transport_setup_and_connect, $transport_setup, # unused $transport_connect, # unused $transport_disconnect, $transport_new, $transport_start, $transport_stop, $old_bg, # initial background color. $old_abg, # initial active background color $sn_save_text,# text entry widget $sn_save, # button to save settings $sn_recall, # button to recall settings ); package Audio::Nama::Graphical; ## gui routines use Modern::Perl; use Carp; use Module::Load::Conditional qw(can_load); use Audio::Nama::Assign qw(:all); use Audio::Nama::Util qw(colonize); no warnings 'uninitialized'; our @ISA = 'Audio::Nama'; ## default to root class # widgets ## The following methods belong to the Graphical interface class sub hello {"make a window";} sub loop { package Audio::Nama; $attribs->{already_prompted} = 0; $term->tkRunning(1); while (1) { my ($user_input) = $term->readline($prompt) ; Audio::Nama::process_line( $user_input ); } } sub initialize_tk { can_load( modules => { Tk => undef } ) } # the following graphical methods are placed in the root namespace # allowing access to root namespace variables # with a package path package Audio::Nama; # gui handling # sub init_gui { $debug2 and print "&init_gui\n"; init_palettefields(); # keys only ### Tk root window # Tk main window $mw = MainWindow->new; get_saved_colors(); $mw->optionAdd('*font', 'Helvetica 12'); $mw->optionAdd('*BorderWidth' => 1); $mw->title("Ecasound/Nama"); $mw->deiconify; $parent{mw} = $mw; ### init effect window $ew = $mw->Toplevel; $ew->title("Effect Window"); $ew->deiconify; # $ew->withdraw; $parent{ew} = $ew; ### Exit via Ctrl-C $mw->bind('' => \&cleanup_exit); $ew->bind('' => \&cleanup_exit); ## Press SPACE to start/stop transport $mw->bind('' => \&toggle_transport); $ew->bind('' => \&toggle_transport); $canvas = $ew->Scrolled('Canvas')->pack; $canvas->configure( scrollregion =>[2,2,10000,10000], -width => 1200, -height => 700, ); $effect_frame = $canvas->Frame; my $id = $canvas->createWindow(30,30, -window => $effect_frame, -anchor => 'nw'); $project_label = $mw->Label->pack(-fill => 'both'); $time_frame = $mw->Frame( # -borderwidth => 20, # -relief => 'groove', )->pack( -side => 'bottom', -fill => 'both', ); $mark_frame = $time_frame->Frame->pack( -side => 'bottom', -fill => 'both'); $fast_frame = $time_frame->Frame->pack( -side => 'bottom', -fill => 'both'); $transport_frame = $mw->Frame->pack(-side => 'bottom', -fill => 'both'); # $oid_frame = $mw->Frame->pack(-side => 'bottom', -fill => 'both'); $clock_frame = $mw->Frame->pack(-side => 'bottom', -fill => 'both'); #$group_frame = $mw->Frame->pack(-side => 'bottom', -fill => 'both'); my $track_canvas = $mw->Scrolled('Canvas')->pack(-side => 'bottom', -fill => 'both'); $track_canvas->configure( -scrollregion =>[2,2,400,9600], -width => 400, -height => 400, ); $track_frame = $track_canvas->Frame; # ->pack(-fill => 'both'); #$track_frame = $mw->Frame; my $id2 = $track_canvas->createWindow(0,0, -window => $track_frame, -anchor => 'nw'); #$group_label = $group_frame->Menubutton(-text => "GROUP", # -tearoff => 0, # -width => 13)->pack(-side => 'left'); $add_frame = $mw->Frame->pack(-side => 'bottom', -fill => 'both'); $perl_eval_frame = $mw->Frame->pack(-side => 'bottom', -fill => 'both'); $iam_frame = $mw->Frame->pack(-side => 'bottom', -fill => 'both'); $load_frame = $mw->Frame->pack(-side => 'bottom', -fill => 'both'); # my $blank = $mw->Label->pack(-side => 'left'); $sn_label = $load_frame->Label( -text => " Project name: " )->pack(-side => 'left'); $sn_text = $load_frame->Entry( -textvariable => \$project, -width => 25 )->pack(-side => 'left'); $sn_load = $load_frame->Button->pack(-side => 'left');; $sn_new = $load_frame->Button->pack(-side => 'left');; $sn_quit = $load_frame->Button->pack(-side => 'left'); $sn_save = $load_frame->Button->pack(-side => 'left'); my $sn_save_text = $load_frame->Entry( -textvariable => \$save_id, -width => 15 )->pack(-side => 'left'); $sn_recall = $load_frame->Button->pack(-side => 'left'); $sn_palette = $load_frame->Menubutton(-tearoff => 0) ->pack( -side => 'left'); $sn_namapalette = $load_frame->Menubutton(-tearoff => 0) ->pack( -side => 'left'); #$sn_effects_palette = $load_frame->Menubutton(-tearoff => 0) # ->pack( -side => 'left'); # $sn_dump = $load_frame->Button->pack(-side => 'left'); $build_track_label = $add_frame->Label( -text => "New track name: ")->pack(-side => 'left'); $build_track_text = $add_frame->Entry( -textvariable => \$track_name, -width => 12 )->pack(-side => 'left'); # $build_track_mon_label = $add_frame->Label( # -text => "Aux send: (channel/client):", # -width => 18 # )->pack(-side => 'left'); # $build_track_mon_text = $add_frame->Entry( # -textvariable => \$ch_m, # -width => 10 # )->pack(-side => 'left'); $build_track_rec_label = $add_frame->Label( -text => "Input channel or client:" )->pack(-side => 'left'); $build_track_rec_text = $add_frame->Entry( -textvariable => \$ch_r, -width => 10 )->pack(-side => 'left'); $build_track_add_mono = $add_frame->Button->pack(-side => 'left');; $build_track_add_stereo = $add_frame->Button->pack(-side => 'left');; $sn_load->configure( -text => 'Load', -command => sub{ load_project( name => remove_spaces($project), )}); $sn_new->configure( -text => 'Create', -command => sub{ load_project( name => remove_spaces($project), create => 1)}); $sn_save->configure( -text => 'Save settings', -command => #sub { print "save_id: $save_id\n" }); sub {save_state($save_id) }); $sn_recall->configure( -text => 'Recall settings', -command => sub {load_project (name => $project_name, settings => $save_id)}, ); $sn_quit->configure(-text => "Quit", -command => sub { return if transport_running(); save_state($save_id); print "Exiting... \n"; #$term->tkRunning(0); #$ew->destroy; #$mw->destroy; #Audio::Nama::Text::command_process('quit'); exit; }); $sn_palette->configure( -text => 'Palette', -relief => 'raised', ); $sn_namapalette->configure( -text => 'Nama palette', -relief => 'raised', ); # $sn_effects_palette->configure( # -text => 'Effects palette', # -relief => 'raised', # ); my @color_items = map { [ 'command' => $_, -command => colorset('mw', $_ ) ] } @palettefields; $sn_palette->AddItems( @color_items); @color_items = map { [ 'command' => $_, -command => namaset( $_ ) ] } @namafields; # $sn_effects_palette->AddItems( @color_items); # # @color_items = map { [ 'command' => $_, # -command => namaset($_, $namapalette{$_})] # } @namafields; $sn_namapalette->AddItems( @color_items); $build_track_add_mono->configure( -text => 'Add Mono Track', -command => sub { return if $track_name =~ /^\s*$/; add_track(remove_spaces($track_name)) } ); $build_track_add_stereo->configure( -text => 'Add Stereo Track', -command => sub { return if $track_name =~ /^\s*$/; add_track(remove_spaces($track_name)); Audio::Nama::Text::command_process('stereo'); }); my @labels = qw(Track Name Version Status Source Send Volume Mute Unity Pan Center Effects); my @widgets; map{ push @widgets, $track_frame->Label(-text => $_) } @labels; $widgets[0]->grid(@widgets[1..$#widgets]); # unified command processing by command_process # $iam_label = $iam_frame->Label( # -text => " Command: " )->pack(-side => 'left');; # $iam_text = $iam_frame->Entry( # -textvariable => \$iam, -width => 45) # ->pack(-side => 'left');; # $iam_execute = $iam_frame->Button( # -text => 'Execute', # -command => sub { Audio::Nama::Text::command_process( $iam ) } # # )->pack(-side => 'left');; # # #join " ", # # grep{ $_ !~ add fxa afx } split /\s*;\s*/, $iam) } sub transport_gui { my $ui = shift; $debug2 and print "&transport_gui\n"; $transport_label = $transport_frame->Label( -text => 'TRANSPORT', -width => 12, )->pack(-side => 'left');; # disable Arm button # $transport_setup_and_connect = $transport_frame->Button->pack(-side => 'left');; $transport_start = $transport_frame->Button->pack(-side => 'left'); $transport_stop = $transport_frame->Button->pack(-side => 'left'); #$transport_setup = $transport_frame->Button->pack(-side => 'left');; #$transport_connect = $transport_frame->Button->pack(-side => 'left');; #$transport_disconnect = $transport_frame->Button->pack(-side => 'left');; # $transport_new = $transport_frame->Button->pack(-side => 'left');; $transport_stop->configure(-text => "Stop", -command => sub { stop_transport(); } ); $transport_start->configure( -text => "Start", -command => sub { return if transport_running(); my $color = engine_mode_color(); $ui->project_label_configure(-background => $color); start_transport(); }); # $transport_setup_and_connect->configure( # -text => 'Arm', # -command => sub {arm()} # ); # preview_button(); #mastering_button(); } sub time_gui { my $ui = shift; $debug2 and print "&time_gui\n"; my $time_label = $clock_frame->Label( -text => 'TIME', -width => 12); #print "bg: $namapalette{ClockBackground}, fg:$namapalette{ClockForeground}\n"; $clock = $clock_frame->Label( -text => '0:00', -width => 8, -background => $namapalette{ClockBackground}, -foreground => $namapalette{ClockForeground}, ); my $length_label = $clock_frame->Label( -text => 'LENGTH', -width => 10, ); $setup_length = $clock_frame->Label( # -width => 8, ); for my $w ($time_label, $clock, $length_label, $setup_length) { $w->pack(-side => 'left'); } $mark_frame = $time_frame->Frame->pack( -side => 'bottom', -fill => 'both'); my $fast_frame = $time_frame->Frame->pack( -side => 'bottom', -fill => 'both'); # jump my $jump_label = $fast_frame->Label(-text => q(JUMP), -width => 12); my @pluses = (1, 5, 10, 30, 60); my @minuses = map{ - $_ } reverse @pluses; my @fw = map{ my $d = $_; $fast_frame->Button( -text => $d, -command => sub { jump($d) }, ) } @pluses ; my @rew = map{ my $d = $_; $fast_frame->Button( -text => $d, -command => sub { jump($d) }, ) } @minuses ; my $beg = $fast_frame->Button( -text => 'Beg', -command => \&to_start, ); my $end = $fast_frame->Button( -text => 'End', -command => \&to_end, ); $time_step = $fast_frame->Button( -text => 'Sec', ); for my $w($jump_label, @rew, $beg, $time_step, $end, @fw){ $w->pack(-side => 'left') } $time_step->configure (-command => sub { &toggle_unit; &show_unit }); # Marks my $mark_label = $mark_frame->Label( -text => q(MARK), -width => 12, )->pack(-side => 'left'); my $drop_mark = $mark_frame->Button( -text => 'Place', -command => \&drop_mark, )->pack(-side => 'left'); $mark_remove = $mark_frame->Button( -text => 'Remove', -command => \&arm_mark_toggle, )->pack(-side => 'left'); } sub toggle_unit { if ($unit == 1){ $unit = 60; } else{ $unit = 1; } } sub show_unit { $time_step->configure( -text => ($unit == 1 ? 'Sec' : 'Min') )} # the following is based on previous code for multiple buttons # needs cleanup sub preview_button { $debug2 and print "&preview\n"; my $ui = shift; #my $outputs = $oid_frame->Label(-text => 'OUTPUTS', -width => 12); my $oid_button = $transport_frame->Button( ); $oid_button->configure( -text => 'Preview', -command => sub { if ($preview ){ # set normal } else { # set preview } $oid_button->configure( -background => $preview ? $old_bg : $namapalette{Preview} , -text => $preview ? 'Preview' : 'PREVIEW MODE' ); }); push @widget_o, $oid_button; map { $_ -> pack(-side => 'left') } (@widget_o); } sub paint_button { my $ui = shift; my ($button, $color) = @_; $button->configure(-background => $color, -activebackground => $color); } sub engine_mode_color { if ( user_rec_tracks() ){ $rec # live recording } elsif ( Audio::Nama::ChainSetup::really_recording() ){ $namapalette{Mixdown} # mixdown only } elsif ( user_mon_tracks() ){ $namapalette{Play}; # just playback } else { $old_bg } } sub user_rec_tracks { some_user_tracks('REC') } sub user_mon_tracks { some_user_tracks('MON') } sub some_user_tracks { my $which = shift; my @user_tracks = Audio::Nama::Track::all(); splice @user_tracks, 0, 2; # drop Master and Mixdown tracks return unless @user_tracks; my @selected_user_tracks = grep { $_->rec_status eq $which } @user_tracks; return unless @selected_user_tracks; map{ $_->n } @selected_user_tracks; } sub flash_ready { my $color = engine_mode_color(); $debug and print "flash color: $color\n"; $ui->length_display(-background => $color); $ui->project_label_configure(-background => $color) unless $preview; $event_id{heartbeat} = AE::timer(5, 0, \&reset_engine_mode_color_display); } sub reset_engine_mode_color_display { $ui->project_label_configure(-background => $off) } sub set_engine_mode_color_display { $ui->project_label_configure(-background => engine_mode_color()) } sub group_gui { my $ui = shift; my $group = $main; my $dummy = $track_frame->Label(-text => ' '); $group_label = $track_frame->Label( -text => "G R O U P", -foreground => $namapalette{GroupForeground}, -background => $namapalette{GroupBackground}, ); $group_version = $track_frame->Menubutton( -text => q( ), -tearoff => 0, -foreground => $namapalette{GroupForeground}, -background => $namapalette{GroupBackground}, ); $group_rw = $track_frame->Menubutton( -text => $group->rw, -tearoff => 0, -foreground => $namapalette{GroupForeground}, -background => $namapalette{GroupBackground}, ); $group_rw->AddItems([ 'command' => 'REC', -background => $old_bg, -command => sub { return if Audio::Nama::eval_iam("engine-status") eq 'running'; $group->set(rw => 'REC'); $group_rw->configure(-text => 'REC'); refresh(); Audio::Nama::reconfigure_engine() } ],[ 'command' => 'MON', -background => $old_bg, -command => sub { return if Audio::Nama::eval_iam("engine-status") eq 'running'; $group->set(rw => 'MON'); $group_rw->configure(-text => 'MON'); refresh(); Audio::Nama::reconfigure_engine() } ],[ 'command' => 'OFF', -background => $old_bg, -command => sub { return if Audio::Nama::eval_iam("engine-status") eq 'running'; $group->set(rw => 'OFF'); $group_rw->configure(-text => 'OFF'); refresh(); Audio::Nama::reconfigure_engine() } ]); $dummy->grid($group_label, $group_version, $group_rw); $ui->global_version_buttons; } sub global_version_buttons { local $debug = 0; my $version = $group_version; $version and map { $_->destroy } $version->children; $debug and print "making global version buttons range:", join ' ',1..$main->last, " \n"; $version->radiobutton( -label => (''), -value => 0, -command => sub { $main->set(version => 0); $version->configure(-text => " "); Audio::Nama::reconfigure_engine(); refresh(); } ); for my $v (1..$main->last) { # the highest version number of all tracks in the # $main group my @user_track_indices = grep { $_ > 2 } map {$_->n} Audio::Nama::Track::all; next unless grep{ grep{ $v == $_ } @{ $ti{$_}->versions } } @user_track_indices; $version->radiobutton( -label => ($v ? $v : ''), -value => $v, -command => sub { $main->set(version => $v); $version->configure(-text => $v); Audio::Nama::reconfigure_engine(); refresh(); } ); } } sub track_gui { $debug2 and print "&track_gui\n"; my $ui = shift; my $n = shift; return if $ti{$n}->hide; $debug and print "found index: $n\n"; my @rw_items = @_ ? @_ : ( [ 'command' => "REC", -foreground => 'red', -command => sub { return if Audio::Nama::eval_iam("engine-status") eq 'running'; $ti{$n}->set(rw => "REC"); $ui->refresh_track($n); refresh_group(); Audio::Nama::reconfigure_engine(); }], [ 'command' => "MON", -command => sub { return if Audio::Nama::eval_iam("engine-status") eq 'running'; $ti{$n}->set(rw => "MON"); $ui->refresh_track($n); refresh_group(); Audio::Nama::reconfigure_engine(); }], [ 'command' => "OFF", -command => sub { return if Audio::Nama::eval_iam("engine-status") eq 'running'; $ti{$n}->set(rw => "OFF"); $ui->refresh_track($n); refresh_group(); Audio::Nama::reconfigure_engine(); }], ); my ($number, $name, $version, $rw, $ch_r, $ch_m, $vol, $mute, $solo, $unity, $pan, $center); $number = $track_frame->Label(-text => $n, -justify => 'left'); my $stub = " "; $stub .= $ti{$n}->version; $name = $track_frame->Label( -text => $ti{$n}->name, -justify => 'left'); $version = $track_frame->Menubutton( -text => $stub, # -relief => 'sunken', -tearoff => 0); my @versions = ''; #push @versions, @{$ti{$n}->versions} if @{$ti{$n}->versions}; my $ref = ref $ti{$n}->versions ; $ref =~ /ARRAY/ and push (@versions, @{$ti{$n}->versions}) or croak "chain $n, found unexpectedly $ref\n";; my $indicator; for my $v (@versions) { $version->radiobutton( -label => $v, -value => $v, -variable => \$indicator, -command => sub { $ti{$n}->set( version => $v ); return if $ti{$n}->rec_status eq "REC"; $version->configure( -text=> $ti{$n}->current_version ); Audio::Nama::reconfigure_engine(); } ); } $ch_r = $track_frame->Menubutton( # -relief => 'groove', -tearoff => 0, ); my @range; push @range, 1..$soundcard_channels if $n > 2; # exclude Master/Mixdown for my $v (@range) { $ch_r->radiobutton( -label => $v, -value => $v, -command => sub { return if Audio::Nama::eval_iam("engine-status") eq 'running'; # $ti{$n}->set(rw => 'REC'); $ti{$n}->source($v); $ui->refresh_track($n) } ) } @range = (); push @range, "off" if $n > 2; push @range, 1..$soundcard_channels if $n != 2; # exclude Mixdown $ch_m = $track_frame->Menubutton( -tearoff => 0, # -relief => 'groove', ); for my $v (@range) { $ch_m->radiobutton( -label => $v, -value => $v, -command => sub { return if Audio::Nama::eval_iam("engine-status") eq 'running'; $ti{$n}->set_send($v); $ui->refresh_track($n); Audio::Nama::reconfigure_engine(); } ) } $rw = $track_frame->Menubutton( -text => $ti{$n}->rw, -tearoff => 0, # -relief => 'groove', ); map{$rw->AddItems($_)} @rw_items; my $p_num = 0; # needed when using parameter controllers # Volume if ( Audio::Nama::need_vol_pan($ti{$n}->name, "vol") ){ my $vol_id = $ti{$n}->vol; local $debug = 0; $debug and print "vol cop_id: $vol_id\n"; my %p = ( parent => \$track_frame, chain => $n, type => 'ea', cop_id => $vol_id, p_num => $p_num, length => 300, ); $debug and do {my %q = %p; delete $q{parent}; print "=============\n%p\n",yaml_out(\%q)}; $vol = make_scale ( \%p ); # Mute $mute = $track_frame->Button( -command => sub { if ($copp{$vol_id}->[0] != $mute_level{$cops{$vol_id}->{type}} and $copp{$vol_id}->[0] != $fade_out_level{$cops{$vol_id}->{type}} ) { # non-zero volume $ti{$n}->mute; $mute->configure(-background => $namapalette{Mute}); } else { $ti{$n}->unmute; $mute->configure(-background => $off); } } ); # Unity $unity = $track_frame->Button( -command => sub { Audio::Nama::effect_update_copp_set( $vol_id, 0, $unity_level{$cops{$vol_id}->{type}}); } ); } else { $vol = $track_frame->Label; $mute = $track_frame->Label; $unity = $track_frame->Label; } if ( Audio::Nama::need_vol_pan($ti{$n}->name, "pan") ){ # Pan my $pan_id = $ti{$n}->pan; $debug and print "pan cop_id: $pan_id\n"; $p_num = 0; # first parameter my %q = ( parent => \$track_frame, chain => $n, type => 'epp', cop_id => $pan_id, p_num => $p_num, ); # $debug and do { my %q = %p; delete $q{parent}; print "x=============\n%p\n",yaml_out(\%q) }; $pan = make_scale ( \%q ); # Center $center = $track_frame->Button( -command => sub { Audio::Nama::effect_update_copp_set($pan_id, 0, 50); } ); } else { $pan = $track_frame->Label; $center = $track_frame->Label; } my $effects = $effect_frame->Frame->pack(-fill => 'both');; # effects, held by track_widget->n->effects is the frame for # all effects of the track @{ $track_widget{$n} }{qw(name version rw ch_r ch_m mute effects)} = ($name, $version, $rw, $ch_r, $ch_m, $mute, \$effects);#a ref to the object #$debug and print "=============\n\%track_widget\n",yaml_out(\%track_widget); my $independent_effects_frame = ${ $track_widget{$n}->{effects} }->Frame->pack(-fill => 'x'); my $controllers_frame = ${ $track_widget{$n}->{effects} }->Frame->pack(-fill => 'x'); # parents are the independent effects # children are controllers for various paramters $track_widget{$n}->{parents} = $independent_effects_frame; $track_widget{$n}->{children} = $controllers_frame; $independent_effects_frame ->Label(-text => uc $ti{$n}->name )->pack(-side => 'left'); #$debug and print( "Number: $n\n"),MainLoop if $n == 2; my @tags = qw( EF P1 P2 L1 L2 L3 L4 ); my @starts = ( $e_bound{cop}{a}, $e_bound{preset}{a}, $e_bound{preset}{b}, $e_bound{ladspa}{a}, $e_bound{ladspa}{b}, $e_bound{ladspa}{c}, $e_bound{ladspa}{d}, ); my @ends = ( $e_bound{cop}{z}, $e_bound{preset}{b}, $e_bound{preset}{z}, $e_bound{ladspa}{b}-1, $e_bound{ladspa}{c}-1, $e_bound{ladspa}{d}-1, $e_bound{ladspa}{z}, ); my @add_effect; map{push @add_effect, effect_button($n, shift @tags, shift @starts, shift @ends)} 1..@tags; $number->grid($name, $version, $rw, $ch_r, $ch_m, $vol, $mute, $unity, $pan, $center, @add_effect); $track_widget_remove{$n} = [ grep{ $_ } ( $number, $name, $version, $rw, $ch_r, $ch_m, $vol, $mute, $unity, $pan, $center, @add_effect, $effects, ) ]; $ui->refresh_track($n); } sub remove_track_gui { my $ui = shift; my $n = shift; $debug2 and say "&remove_track_gui"; return unless $track_widget_remove{$n}; map {$_->destroy } @{ $track_widget_remove{$n} }; delete $track_widget_remove{$n}; delete $track_widget{$n}; } sub paint_mute_buttons { map{ $track_widget{$_}{mute}->configure( -background => $namapalette{Mute}, )} grep { $ti{$_}->old_vol_level}# muted tracks map { $_->n } Audio::Nama::Track::all; # track numbers } sub create_master_and_mix_tracks { $debug2 and print "&create_master_and_mix_tracks\n"; my @rw_items = ( [ 'command' => "MON", -command => sub { return if Audio::Nama::eval_iam("engine-status") eq 'running'; $tn{Master}->set(rw => "MON"); $ui->refresh_track($tn{Master}->n); }], [ 'command' => "OFF", -command => sub { return if Audio::Nama::eval_iam("engine-status") eq 'running'; $tn{Master}->set(rw => "OFF"); $ui->refresh_track($tn{Master}->n); }], ); $ui->track_gui( $tn{Master}->n, @rw_items ); $ui->track_gui( $tn{Mixdown}->n); $ui->group_gui('Main'); } sub update_version_button { my $ui = shift; my ($n, $v) = @_; carp ("no version provided \n") if ! $v; my $w = $track_widget{$n}->{version}; $w->radiobutton( -label => $v, -value => $v, -command => sub { $track_widget{$n}->{version}->configure(-text=>$v) unless $ti{$n}->rec_status eq "REC" } ); } sub add_effect_gui { $debug2 and print "&add_effect_gui\n"; my $ui = shift; my %p = %{shift()}; my ($n,$code,$id,$parent_id,$parameter) = @p{qw(chain type cop_id parent_id parameter)}; my $i = $effect_i{$code}; $debug and print yaml_out(\%p); $debug and print "cop_id: $id, parent_id: $parent_id\n"; # $id is determined by cop_add, which will return the # existing cop_id if supplied # check display format, may be 'scale' 'field' or 'hidden' my $display_type = $cops{$id}->{display}; # individual setting defined $display_type or $display_type = $effects[$i]->{display}; # template $debug and print "display type: $display_type\n"; return if $display_type eq q(hidden); my $frame ; if ( ! $parent_id ){ # independent effect $frame = $track_widget{$n}->{parents}->Frame->pack( -side => 'left', -anchor => 'nw',) } else { # controller $frame = $track_widget{$n}->{children}->Frame->pack( -side => 'top', -anchor => 'nw') } $effects_widget{$id} = $frame; # we need a separate frame so title can be long # here add menu items for Add Controller, and Remove my $parentage = $effects[ $effect_i{ $cops{$parent_id}->{type}} ] ->{name}; $parentage and $parentage .= " - "; $debug and print "parentage: $parentage\n"; my $eff = $frame->Menubutton( -text => $parentage. $effects[$i]->{name}, -tearoff => 0,); $eff->AddItems([ 'command' => "Remove", -command => sub { remove_effect($id) } ]); $eff->grid(); my @labels; my @sliders; # make widgets for my $p (0..$effects[$i]->{count} - 1 ) { my @items; #$debug and print "p_first: $p_first, p_last: $p_last\n"; for my $j ($e_bound{ctrl}{a}..$e_bound{ctrl}{z}) { push @items, [ 'command' => $effects[$j]->{name}, -command => sub { add_effect ({ parent_id => $id, chain => $n, parameter => $p, type => $effects[$j]->{code} } ) } ]; } push @labels, $frame->Menubutton( -text => $effects[$i]->{params}->[$p]->{name}, -menuitems => [@items], -tearoff => 0, ); $debug and print "parameter name: ", $effects[$i]->{params}->[$p]->{name},"\n"; my $v = # for argument vector { parent => \$frame, cop_id => $id, p_num => $p, }; push @sliders,make_scale($v); } if (@sliders) { $sliders[0]->grid(@sliders[1..$#sliders]); $labels[0]->grid(@labels[1..$#labels]); } } sub project_label_configure{ my $ui = shift; $project_label->configure( @_ ) } sub length_display{ my $ui = shift; $setup_length->configure(@_)}; sub clock_config { my $ui = shift; $clock->configure( @_ )} sub manifest { $ew->deiconify() } sub destroy_widgets { map{ $_->destroy } map{ $_->children } $effect_frame; #my @children = $group_frame->children; #map{ $_->destroy } @children[1..$#children]; my @children = $track_frame->children; # leave field labels (first row) map{ $_->destroy } @children[11..$#children]; # fragile %mark_widget and map{ $_->destroy } values %mark_widget; } sub remove_effect_gui { my $ui = shift; $debug2 and print "&remove_effect_gui\n"; my $id = shift; my $n = $cops{$id}->{chain}; $debug and print "id: $id, chain: $n\n"; $debug and print "i have widgets for these ids: ", join " ",keys %effects_widget, "\n"; $debug and print "preparing to destroy: $id\n"; return unless defined $effects_widget{$id}; $effects_widget{$id}->destroy(); delete $effects_widget{$id}; } sub effect_button { local $debug = 0; $debug2 and print "&effect_button\n"; my ($n, $label, $start, $end) = @_; $debug and print "chain $n label $label start $start end $end\n"; my @items; my $widget; my @indices = ($start..$end); if ($start >= $e_bound{ladspa}{a} and $start <= $e_bound{ladspa}{z}){ @indices = (); @indices = @ladspa_sorted[$start..$end]; $debug and print "length sorted indices list: ".scalar @indices. "\n"; $debug and print "Indices: @indices\n"; } for my $j (@indices) { push @items, [ 'command' => "$effects[$j]->{count} $effects[$j]->{name}" , -command => sub { add_effect( {chain => $n, type => $effects[$j]->{code} } ); $ew->deiconify; # display effects window } ]; } $widget = $track_frame->Menubutton( -text => $label, -tearoff =>0, # -relief => 'raised', -menuitems => [@items], ); $widget; } sub make_scale { $debug2 and print "&make_scale\n"; my $ref = shift; my %p = %{$ref}; # %p contains following: # cop_id => operator id, to access dynamic effect params in %copp # parent => parent widget, i.e. the frame # p_num => parameter number, starting at 0 # length => length widget # optional my $id = $p{cop_id}; my $n = $cops{$id}->{chain}; my $code = $cops{$id}->{type}; my $p = $p{p_num}; my $i = $effect_i{$code}; $debug and print "id: $id code: $code\n"; # check display format, may be text-field or hidden, $debug and print "i: $i code: $effects[$i]->{code} display: $effects[$i]->{display}\n"; my $display_type = $cops{$id}->{display}; defined $display_type or $display_type = $effects[$i]->{display}; $debug and print "display type: $display_type\n"; return if $display_type eq q(hidden); $debug and print "to: ", $effects[$i]->{params}->[$p]->{end}, "\n"; $debug and print "p: $p code: $code\n"; $debug and print "is_log_scale: ".is_log_scale($i,$p), "\n"; # set display type to individually specified value if it exists # otherwise to the default for the controller class if ($display_type eq q(scale) ) { # return scale type controller widgets my $frame = ${ $p{parent} }->Frame; #return ${ $p{parent} }->Scale( my $log_display; my $controller = $frame->Scale( -variable => \$copp{$id}->[$p], -orient => 'horizontal', -from => $effects[$i]->{params}->[$p]->{begin}, -to => $effects[$i]->{params}->[$p]->{end}, -resolution => resolution($i, $p), -width => 12, -length => $p{length} ? $p{length} : 100, -command => sub { Audio::Nama::effect_update($id, $p, $copp{$id}->[$p]) } ); # auxiliary field for logarithmic display if ( is_log_scale($i, $p) ) # or $code eq 'ea') { my $log_display = $frame->Label( -text => exp $effects[$i]->{params}->[$p]->{default}, -width => 5, ); $controller->configure( -variable => \$copp_exp{$id}->[$p], -command => sub { $copp{$id}->[$p] = exp $copp_exp{$id}->[$p]; Audio::Nama::effect_update($id, $p, $copp{$id}->[$p]); $log_display->configure( -text => $effects[$i]->{params}->[$p]->{name} =~ /hz|frequency/i ? int $copp{$id}->[$p] : dn($copp{$id}->[$p], 1) ); } ); $log_display->grid($controller); } else { $controller->grid; } return $frame; } elsif ($display_type eq q(field) ){ # then return field type controller widget return ${ $p{parent} }->Entry( -textvariable =>\$copp{$id}->[$p], -width => 6, # -command => sub { Audio::Nama::effect_update($id, $p, $copp{$id}->[$p]) }, # doesn't work with Entry widget ); } else { croak "missing or unexpected display type: $display_type" } } sub is_log_scale { my ($i, $p) = @_; $effects[$i]->{params}->[$p]->{hint} =~ /logarithm/ } sub resolution { my ($i, $p) = @_; my $res = $effects[$i]->{params}->[$p]->{resolution}; return $res if $res; my $end = $effects[$i]->{params}->[$p]->{end}; my $beg = $effects[$i]->{params}->[$p]->{begin}; return 1 if abs($end - $beg) > 30; return abs($end - $beg)/100 } sub arm_mark_toggle { if ($markers_armed) { $markers_armed = 0; $mark_remove->configure( -background => $off); } else{ $markers_armed = 1; $mark_remove->configure( -background => $namapalette{MarkArmed}); } } sub marker { my $ui = shift; my $mark = shift; # Mark #print "mark is ", ref $mark, $/; my $pos = $mark->time; #print $pos, " ", int $pos, $/; $mark_widget{$pos} = $mark_frame->Button( -text => (join " ", colonize( int $pos ), $mark->name), -background => $off, -command => sub { Audio::Nama::mark($mark) }, )->pack(-side => 'left'); } sub restore_time_marks { my $ui = shift; # map {$_->dumpp} Audio::Nama::Mark::all(); # Audio::Nama::Mark::all() and map{ $ui->marker($_) } Audio::Nama::Mark::all() ; $time_step->configure( -text => $unit == 1 ? q(Sec) : q(Min) ) } sub destroy_marker { my $ui = shift; my $pos = shift; $mark_widget{$pos}->destroy; } sub get_saved_colors { $debug2 and print "&get_saved_colors\n"; # aliases *Audio::Nama::old_bg = \$palette{mw}{background}; *Audio::Nama::old_abg = \$palette{mw}{activeBackground}; $old_bg = '#d915cc1bc3cf' unless $old_bg; #print "pb: $palette{mw}{background}\n"; my $pal = join_path($project_root, $palette_file); -f $pal or $pal = $default_palette_yml; Audio::Nama::assign_var( $pal, qw[%palette %namapalette]); *Audio::Nama::rec = \$namapalette{RecBackground}; *Audio::Nama::mon = \$namapalette{MonBackground}; *Audio::Nama::off = \$namapalette{OffBackground}; $old_abg = $palette{mw}{activeBackground}; $old_abg = $project_label->cget('-activebackground') unless $old_abg; #print "1palette: \n", yaml_out( \%palette ); #print "\n1namapalette: \n", yaml_out(\%namapalette); my %setformat; map{ $setformat{$_} = $palette{mw}{$_} if $palette{mw}{$_} } keys %{$palette{mw}}; #print "\nsetformat: \n", yaml_out(\%setformat); $mw->setPalette( %setformat ); } sub colorset { my ($widgetid, $field) = @_; sub { my $widget = eval "\$$widgetid"; #print "ancestor: $widgetid\n"; my $new_color = colorchooser($field,$widget->cget("-$field")); if( defined $new_color ){ # install color in palette listing $palette{$widgetid}{$field} = $new_color; # set the color my @fields = ($field => $new_color); push (@fields, 'background', $widget->cget('-background')) unless $field eq 'background'; #print "fields: @fields\n"; $widget->setPalette( @fields ); } }; } sub namaset { my ($field) = @_; sub { #print "f: $field np: $namapalette{$field}\n"; my $color = colorchooser($field,$namapalette{$field}); if ($color){ # install color in palette listing $namapalette{$field} = $color; # set those objects who are not # handled by refresh *rec = \$namapalette{RecBackground}; *mon = \$namapalette{MonBackground}; *off = \$namapalette{OffBackground}; $clock->configure( -background => $namapalette{ClockBackground}, -foreground => $namapalette{ClockForeground}, ); $group_label->configure( -background => $namapalette{GroupBackground}, -foreground => $namapalette{GroupForeground}, ); refresh(); } } } sub colorchooser { #print "colorchooser\n"; #my $debug = 1; my ($field, $initialcolor) = @_; $debug and print "field: $field, initial color: $initialcolor\n"; my $new_color = $mw->chooseColor( -title => $field, -initialcolor => $initialcolor, ); #print "new color: $new_color\n"; $new_color; } sub init_palettefields { @palettefields = qw[ foreground background activeForeground activeBackground selectForeground selectBackground selectColor highlightColor highlightBackground disabledForeground insertBackground troughColor ]; @namafields = qw [ RecForeground RecBackground MonForeground MonBackground OffForeground OffBackground ClockForeground ClockBackground Capture Play Mixdown GroupForeground GroupBackground SendForeground SendBackground SourceForeground SourceBackground Mute MarkArmed ]; } sub save_palette { serialize ( file => join_path(project_root(), $palette_file), format => 'yaml', vars => [ qw( %palette %namapalette ) ], class => 'Audio::Nama') } ### end ## refresh functions sub set_widget_color { my ($widget, $status) = @_; my %rw_foreground = ( REC => $namapalette{RecForeground}, MON => $namapalette{MonForeground}, OFF => $namapalette{OffForeground}, ); my %rw_background = ( REC => $rec, MON => $mon, OFF => $off ); #print "namapalette:\n",yaml_out( \%namapalette); #print "rec: $rec, mon: $mon, off: $off\n"; $widget->configure( -background => $rw_background{$status} ); $widget->configure( -foreground => $rw_foreground{$status} ); } sub refresh_group { # main group, in this case we want to skip null group $debug2 and print "&refresh_group\n"; my $status; if ( grep{ $_->rec_status eq 'REC'} map{ $tn{$_} } $main->tracks ){ $status = 'REC' }elsif( grep{ $_->rec_status eq 'MON'} map{ $tn{$_} } $main->tracks ){ $status = 'MON' }else{ $status = 'OFF' } $debug and print "group status: $status\n"; set_widget_color($group_rw, $status); croak "some crazy status |$status|\n" if $status !~ m/rec|mon|off/i; #$debug and print "attempting to set $status color: ", $take_color{$status},"\n"; set_widget_color( $group_rw, $status) if $group_rw; } sub refresh_track { my $ui = shift; my $n = shift; $debug2 and print "&refresh_track\n"; my $rec_status = $ti{$n}->rec_status; $debug and print "track: $n rec_status: $rec_status\n"; return unless $track_widget{$n}; # hidden track # set the text for displayed fields $track_widget{$n}->{rw}->configure(-text => $rec_status); $track_widget{$n}->{ch_r}->configure( -text => $n > 2 ? $ti{$n}->source : q() ); $track_widget{$n}->{ch_m}->configure( -text => $ti{$n}->send); $track_widget{$n}->{version}->configure(-text => $ti{$n}->current_version || ""); map{ set_widget_color( $track_widget{$n}->{$_}, $rec_status) } qw(name rw ); set_widget_color( $track_widget{$n}->{ch_r}, ($rec_status eq 'REC' and $n > 2 ) ? 'REC' : 'OFF'); set_widget_color( $track_widget{$n}->{ch_m}, $rec_status eq 'OFF' ? 'OFF' : $ti{$n}->send ? 'MON' : 'OFF'); } sub refresh { Audio::Nama::remove_riff_header_stubs(); $ui->refresh_group(); #map{ $ui->refresh_track($_) } map{$_->n} grep{! $_->hide} Audio::Nama::Track::all(); #map{ $ui->refresh_track($_) } grep{$remove_track_widget{$_} map{$_->n} Audio::Nama::Track::all(); map{ $ui->refresh_track($_) } map{$_->n} Audio::Nama::Track::all(); } sub refresh_oids{ # OUTPUT buttons map{ $widget_o{$_}->configure( # uses hash -background => $oid_status{$_} ? 'AntiqueWhite' : $old_bg, -activebackground => $oid_status{$_} ? 'AntiqueWhite' : $old_bg ) } keys %widget_o; } ### end 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Mark.pm0000644000175000017500000001357311623337667016444 0ustar jrothjroth # ----------- Mark ------------ package Audio::Nama::Mark; our $VERSION = 1.0; use Carp; use warnings; no warnings qw(uninitialized); our @ISA; use vars qw($n %by_name @all); use Audio::Nama::Object qw( name time active ); sub initialize { map{ $_->remove} Audio::Nama::Mark::all(); @all = (); %by_name = (); # return ref to Mark by name @Audio::Nama::marks_data = (); # for save/restore } sub new { my $class = shift; my %vals = @_; croak "undeclared field: @_" if grep{ ! $_is_field{$_} } keys %vals; # to support set_edit_points, we now allow marks to be overwritten # #croak "name already in use: $vals{name}\n" # if $by_name{$vals{name}}; # null name returns false my $object = bless { ## defaults ## active => 1, name => "", @_ }, $class; #print "object class: $class, object type: ", ref $object, $/; if ($object->name) { $by_name{ $object->name } = $object; } push @all, $object; $Audio::Nama::this_mark = $object; $object; } sub set_name { my $mark = shift; my $name = shift; print "name: $name\n"; if ( defined $by_name{ $name } ){ carp "you attempted to assign to name already in use\n"; } else { $mark->set(name => $name); $by_name{ $name } = $mark; } } sub jump_here { my $mark = shift; Audio::Nama::eval_iam( "setpos " . $mark->time); $Audio::Nama::this_mark = $mark; } sub adjusted_time { # for marks within current edit my $mark = shift; return $mark->time unless $Audio::Nama::offset_run_flag; my $time = $mark->time - Audio::Nama::play_start_time(); $time > 0 ? $time : 0 } sub remove { my $mark = shift; if ( $mark->name ) { delete $by_name{$mark->name}; } $Audio::Nama::debug and warn "marks found: ",scalar @all, $/; # @all = (), return if scalar @all @all = grep { $_->time != $mark->time } @all; } sub next { my $mark = shift; Audio::Nama::next_mark(); } sub previous { my $mark = shift; Audio::Nama::previous_mark(); } # -- Class Methods sub all { sort { $a->{time} <=> $b->{time} }@all } sub loop_start { my @points = sort { $a <=> $b } grep{ $_ } map{ mark_time($_)} @Audio::Nama::loop_endpoints[0,1]; #print "points @points\n"; $points[0]; } sub loop_end { my @points =sort { $a <=> $b } grep{ $_ } map{ mark_time($_)} @Audio::Nama::loop_endpoints[0,1]; $points[1]; } sub unadjusted_mark_time { my $tag = shift; $tag or $tag = ''; #print "tag: $tag\n"; my $mark; if ($tag =~ /\./) { # we assume raw time if decimal #print "mark time: ", $tag, $/; return $tag; } elsif ($tag =~ /^\d+$/){ #print "mark index found\n"; $mark = $Audio::Nama::Mark::all[$tag]; } else { #print "mark name found\n"; $mark = $Audio::Nama::Mark::by_name{$tag}; } return undef if ! defined $mark; #print "mark time: ", $mark->time, $/; return $mark->time; } sub mark_time { my $tag = shift; my $time = unadjusted_mark_time($tag); return unless defined $time; $time -= Audio::Nama::play_start_time() if Audio::Nama::edit_mode(); $time } # ---------- Mark and jump routines -------- { package Audio::Nama; use Modern::Perl; our ( $debug, $debug2, $ui, $this_mark, $unit, $length, $jack_running, $seek_delay, $markers_armed, ); sub drop_mark { $debug2 and print "drop_mark()\n"; my $name = shift; my $here = eval_iam("getpos"); if( my $mark = $Audio::Nama::Mark::by_name{$name}){ say "$name: a mark with this name exists already at: ", colonize($mark->time); return } if( my ($mark) = grep { $_->time == $here} Audio::Nama::Mark::all()){ say q(This position is already marked by "),$mark->name,q("); return } my $mark = Audio::Nama::Mark->new( time => $here, name => $name); $ui->marker($mark); # for GUI } sub mark { # GUI_CODE $debug2 and print "mark()\n"; my $mark = shift; my $pos = $mark->time; if ($markers_armed){ $ui->destroy_marker($pos); $mark->remove; arm_mark_toggle(); # disarm } else{ set_position($pos); } } sub next_mark { my $jumps = shift; $jumps and $jumps--; my $here = eval_iam("cs-get-position"); my @marks = Audio::Nama::Mark::all(); for my $i ( 0..$#marks ){ if ($marks[$i]->time - $here > 0.001 ){ $debug and print "here: $here, future time: ", $marks[$i]->time, $/; eval_iam("setpos " . $marks[$i+$jumps]->time); $this_mark = $marks[$i]; return; } } } sub previous_mark { my $jumps = shift; $jumps and $jumps--; my $here = eval_iam("getpos"); my @marks = Audio::Nama::Mark::all(); for my $i ( reverse 0..$#marks ){ if ($marks[$i]->time < $here ){ eval_iam("setpos " . $marks[$i+$jumps]->time); $this_mark = $marks[$i]; return; } } } ## jump recording head position sub to_start { return if Audio::Nama::ChainSetup::really_recording(); set_position( 0 ); } sub to_end { # ten seconds shy of end return if Audio::Nama::ChainSetup::really_recording(); my $end = eval_iam('cs-get-length') - 10 ; set_position( $end); } sub jump { return if Audio::Nama::ChainSetup::really_recording(); my $delta = shift; $debug2 and print "&jump\n"; my $here = eval_iam('getpos'); $debug and print "delta: $delta\nhere: $here\nunit: $unit\n\n"; my $new_pos = $here + $delta * $unit; $new_pos = $new_pos < $length ? $new_pos : $length - 10; set_position( $new_pos ); sleeper( 0.6) if engine_running(); } sub set_position { return if Audio::Nama::ChainSetup::really_recording(); # don't allow seek while recording my $seconds = shift; my $coderef = sub{ eval_iam("setpos $seconds") }; if( $jack_running and eval_iam('engine-status') eq 'running') { engine_stop_seek_start( $coderef ) } else { $coderef->() } update_clock_display(); } sub engine_stop_seek_start { my $coderef = shift; eval_iam('stop'); $coderef->(); sleeper($seek_delay); eval_iam('start'); } sub forward { my $delta = shift; my $here = eval_iam('getpos'); my $new = $here + $delta; set_position( $new ); } sub rewind { my $delta = shift; forward( -$delta ); } } # end package 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Group.pm0000644000175000017500000000156111623337667016640 0ustar jrothjrothpackage Audio::Nama::Group; use Modern::Perl; no warnings qw(uninitialized redefine); our $VERSION = 1.0; #use Exporter qw(import); #our @EXPORT_OK =qw(group); use Carp; our(%by_name, $debug); *debug = \$Audio::Nama::debug; our @ISA; # use Audio::Nama::Object qw( name # rw # version # n # ); sub tracks { # returns list of track names in group my $group = shift; map{ $_->name } grep{ $_->group eq $group->name } Audio::Nama::Track::all(); } sub last { #$debug and say "group: @_"; my $group = shift; my $max = 0; map{ my $track = $_; my $last; $last = $track->last || 0; #print "track: ", $track->name, ", last: $last\n"; $max = $last if $last > $max; } map { $Audio::Nama::Track::by_name{$_} } $group->tracks; $max; } sub all { values %by_name } sub remove { my $group = shift; delete $by_name{$group->name}; } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Engine_cleanup_subs.pm0000644000175000017500000000332111623337667021510 0ustar jrothjroth# ----------- Engine cleanup (post-recording) ----------- package Audio::Nama; use Modern::Perl; our ( $debug, $debug2, $offset_run_flag, $offset_mark, $ui, %bn, %tn, $this_edit, ); sub rec_cleanup { $debug2 and print "&rec_cleanup\n"; $debug && print("transport still running, can't cleanup"),return if transport_running(); if( my (@files) = new_files_were_recorded() ){ say join $/, "Now reviewing your recorded files...", (@files); (grep /Mixdown/, @files) ? command_process('mixplay') : post_rec_configure(); undef $offset_run_flag if ! defined $this_edit; reconfigure_engine(); } } sub adjust_offset_recordings { map { $_->set(playat => $offset_mark); say $_->name, ": offsetting to $offset_mark"; } Audio::Nama::ChainSetup::engine_wav_out_tracks(); } sub post_rec_configure { $ui->global_version_buttons(); # recreate adjust_offset_recordings(); # toggle buses of recorded tracks to MON map{ $bn{$_->group}->set(rw => 'MON') } Audio::Nama::ChainSetup::engine_wav_out_tracks(); $ui->refresh(); } sub new_files_were_recorded { return unless my @files = Audio::Nama::ChainSetup::really_recording(); $debug and print join $/, "intended recordings:", @files; my @recorded = grep { my ($name, $version) = /([^\/]+)_(\d+).wav$/; if (-e ) { if (-s > 44100) { # 0.5s x 16 bits x 44100/s $debug and print "found bigger than 44100 bytes:\n"; $debug and print "$_\n"; $tn{$name}->set(version => undef) if $tn{$name}; $ui->update_version_button($tn{$name}->n, $version); 1; } else { unlink $_; 0 } } } @files; if(@recorded){ rememoize(); say join $/,"recorded:",@recorded; } map{ get_wav_info($_) } @recorded; @recorded } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Text.pm0000644000175000017500000003711011623337670016461 0ustar jrothjroth# -------- Text Interface ----------- ## The following methods belong to the Text interface class package Audio::Nama; our ( $preview, $mastering_mode, %tn, %ti, %bn, $attribs, $term, $this_track, $this_bus, %effect_i, %effect_j, @effects, %cops, %copp, $main, $length, $run_time, $use_placeholders, $format_top, $format_divider, @format_fields, $debug, %bunch, %commands, %ladspa_label, @effects_help, @help_topic, %help_topic, %ladspa_help, $text_wrap, $project_name, %iam_cmd, $ui, ); package Audio::Nama::Text; use Modern::Perl; no warnings 'uninitialized'; use Carp; use Audio::Nama::Assign qw(:all); our @ISA = 'Audio::Nama'; our $VERSION = 1.071; sub hello {"hello world!";} sub loop { package Audio::Nama; issue_first_prompt(); $Event::DIED = sub { my ($event, $errmsg) = @_; say $errmsg; $attribs->{line_buffer} = q(); $term->clear_message(); $term->rl_reset_line_state(); }; Event::loop(); } sub show_versions { if (@{$this_track->versions} ){ my $cache_map = $this_track->cache_map; "All versions: ". join(" ", map { $_ . ( $cache_map->{$_} and 'c') } @{$this_track->versions} ). $/ } else {} } sub show_send { "Send: ". $this_track->send_id. $/ if $this_track->rec_status ne 'OFF' and $this_track->send_id } sub show_bus { "Bus: ". $this_track->group. $/ if $this_track->group ne 'Main' } sub show_effects { Audio::Nama::sync_effect_parameters(); join "", map { show_effect($_) } @{ $this_track->ops }; } sub show_effect { my $op_id = shift; my @lines; my @params; my $i = $effect_i{ $cops{ $op_id }->{type} }; push @lines, $op_id. ": " . $effects[ $i ]->{name}. "\n"; my @pnames = @{$effects[ $i ]->{params}}; map{ push @lines, " ".($_+1).q(. ) . $pnames[$_]->{name} . ": ". $copp{$op_id}->[$_] . "\n"; } (0..scalar @pnames - 1); map{ push @lines, " ".($_+1).": ". $copp{$op_id}->[$_] . "\n"; } (scalar @pnames .. (scalar @{$copp{$op_id}} - 1) ) if scalar @{$copp{$op_id}} - scalar @pnames - 1; #push @lines, join("; ", @params) . "\n"; @lines } sub show_modifiers { join "", "Modifiers: ",$this_track->modifiers, $/ if $this_track->modifiers; } sub show_effect_chain_stack { return "Bypassed effect chains: " .scalar @{ $this_track->effect_chain_stack }.$/ if @{ $this_track->effect_chain_stack } ; undef; } sub show_region { my $t = $Audio::Nama::this_track; return unless $t->rec_status eq 'MON'; my @lines; push @lines,join " ", "Length:",time2($t->adjusted_length),"\n"; $t->playat and push @lines,join " ", "Play at:",time2($t->adjusted_playat_time), join($t->playat, qw[ ( ) ])."\n"; $t->region_start and push @lines,join " ", "Region start:",time2($t->adjusted_region_start_time), join($t->region_start, qw[ ( ) ])."\n"; $t->region_end and push @lines,join " ", "Region end:",time2($t->adjusted_region_end_time), join($t->region_end, qw[ ( ) ])."\n"; return(join "", @lines); } sub time2 { package Audio::Nama; my $n = shift; dn($n,3),"/",colonize(int ($n + 0.5)); } sub show_status { print "\n"; package Audio::Nama; my @modes; push @modes, $preview if $preview; push @modes, "master" if $mastering_mode; push @modes, "edit" if Audio::Nama::edit_mode(); push @modes, "offset run" if Audio::Nama::offset_run_mode(); say "Modes settings: ", join(", ", @modes) if @modes; my @actions; push @actions, "record" if grep{ ! /Mixdown/ } Audio::Nama::ChainSetup::really_recording(); push @actions, "playback" if grep { $_->rec_status eq 'MON' } map{ $tn{$_} } $main->tracks, q(Mixdown); # We only check Main bus for playback. # sub-buses will route their playback signals through the # Main bus, however it may be that sub-bus mixdown # tracks are set to REC (with rec-to-file disabled) push @actions, "mixdown" if $tn{Mixdown}->rec_status eq 'REC'; say "Pending actions: ", join(", ", @actions) if @actions; say "Main bus allows: ", $main->allows, " track status"; say "Main bus version: ",$Audio::Nama::main->version if $Audio::Nama::main->version; say "Setup length is: ", Audio::Nama::heuristic_time($length); say "Run time limit: ", Audio::Nama::heuristic_time($run_time) if $run_time; } sub placeholder { my $val = shift; return $val if defined $val; $use_placeholders ? q(--) : q() } sub show_inserts { my $output; $output = $Audio::Nama::Insert::by_index{$this_track->prefader_insert}->dump if $this_track->prefader_insert; $output .= $Audio::Nama::Insert::by_index{$this_track->postfader_insert}->dump if $this_track->postfader_insert; "Inserts:\n".join( "\n",map{" "x4 . $_ } split("\n",$output))."\n" if $output; } $format_top = <> @<<<<<<<<<<<<<<< @> @<< @|||| @||||||||||||| @<<<<<<<<< @>> @>> PICTURE sub show_tracks_section { no warnings; #$^A = $format_top; my @tracks = grep{ ref $_ } @_; # HACK! undef should not be passed map { formline $format_picture, $_->n, $_->name, placeholder( $_->current_version || undef ), lc $_->rw, $_->rec_status_display, placeholder($_->source_status), placeholder($_->group), placeholder($copp{$_->vol}->[0]), placeholder($copp{$_->pan}->[0]), } @tracks; my $output = $^A; $^A = ""; #$output .= show_tracks_extra_info(); $output; } sub show_tracks { my @array_refs = @_; my @list = $format_top; for( @array_refs ){ my ($mix,$bus) = splice @$_, 0, 2; push @list, Audio::Nama::Bus::settings_line($mix, $bus), show_tracks_section(@$_), } @list } sub showlist { package Audio::Nama; my @list = grep{ ! $_->hide } Audio::Nama::Track::all(); my $section = [undef,undef,@list]; my ($screen_lines, $columns) = $term->get_screen_size(); return $section if scalar @list <= $screen_lines - 5; my @sections; push @sections, [undef,undef, map $tn{$_},qw(Master Mixdown)]; push @sections, [$tn{Master},$bn{Main},map $tn{$_},$bn{Main}->tracks ]; if( $mastering_mode ){ push @sections, [undef,undef, map $tn{$_},$bn{Mastering}->tracks] } elsif($this_bus ne 'Main'){ push @sections, [$tn{$this_bus},$bn{$this_bus}, map $tn{$_}, $this_bus, $bn{$this_bus}->tracks] } @sections } format STDOUT_TOP = Track Name Ver. Setting Status Source Send Vol Pan ============================================================================= . format STDOUT = @>> @<<<<<<<<< @> @<< @<< @|||||||||||||| @|||||||||||||| @>> @>> ~~ splice @format_fields, 0, 9 . sub helpline { my $cmd = shift; my $text = "Command: $cmd\n"; $text .= "Shortcuts: $commands{$cmd}->{short}\n" if $commands{$cmd}->{short}; $text .= "Description: $commands{$cmd}->{what}\n"; $text .= "Usage: $cmd "; if ( $commands{$cmd}->{parameters} && $commands{$cmd}->{parameters} ne 'none' ){ $text .= $commands{$cmd}->{parameters} } $text .= "\n"; my $example = $commands{$cmd}->{example}; #$example =~ s/!n/\n/g; if ($example){ $text .= "Example: "; if ($example =~ /\n/s){ $example = "\n$example"; # add leading newline $example =~ s(\n)(\n )g; # indent } $text .= $example; $text .= "\n"; } ($/, ucfirst $text, $/); } sub helptopic { my $index = shift; $index =~ /^(\d+)$/ and $index = $help_topic[$index]; my @output; push @output, "\n-- ", ucfirst $index, " --\n\n"; push @output, $help_topic{$index}, $/; @output; } sub help { my $name = shift; chomp $name; #print "seeking help for argument: $name\n"; $iam_cmd{$name} and print <{short} ){ push @help, helpline($cmd) } } keys %commands; if ( @help ){ push @output, qq("$name" matches the following commands:\n\n), @help; } } if (@output){ Audio::Nama::pager( @output ); } else { print "$name: no help found.\n"; } } sub help_effect { my ($input, $id, $no_match, @output); $id = $input = shift; push @output, "\n"; # e.g. help tap_reverb # help 2142 # help var_chipmunk # preset # convert digits to LADSPA label if ($id !~ /\D/){ $id = $ladspa_label{$id} or $no_match++ } # convert ladspa_label to el:ladspa_label # convert preset_name to pn:preset_name if ($effect_i{$id}){} # we are ready elsif ( $effect_j{$id} ) { $id = $effect_j{$id} } else { $no_match++ } # one-line help for Ecasound presets if ($id =~ /pn:/) { push @output, grep{ /$id/ } @effects_help; } # full help for LADSPA plugins elsif ( $id =~ /el:/) { @output = $ladspa_help{$id}; } else { @output = qq("$id" is an Ecasound chain operator. Type 'man ecasound' at a shell prompt for details.); } if( $no_match ){ print "No effects were found matching: $input\n\n"; } else { Audio::Nama::pager(@output) } } sub find_effect { my @keys = @_; #print "keys: @keys\n"; #my @output; my @matches = grep{ my $help = $_; my $didnt_match; map{ $help =~ /\Q$_\E/i or $didnt_match++ } @keys; ! $didnt_match; # select if no cases of non-matching } @effects_help; if ( @matches ){ # push @output, <paragraphs(@matches) , "\n" ); } else { print join " ", "No effects were found matching:",@keys,"\n\n" } } sub t_load_project { package Audio::Nama; return if engine_running() and Audio::Nama::ChainSetup::really_recording(); my $name = shift; print "input name: $name\n"; my $newname = remove_spaces($name); $newname =~ s(/$)(); # remove trailing slash print("Project $newname does not exist\n"), return unless -d join_path(project_root(), $newname); stop_transport(); if(my $savefile = autosave()){ say "Unsaved changes to previous project stored as:"; say $savefile, "\n"; } load_project( name => $newname ); print "loaded project: $project_name\n"; $debug and print "hook: $Audio::Nama::execute_on_project_load\n"; Audio::Nama::command_process($Audio::Nama::execute_on_project_load); } sub t_create_project { package Audio::Nama; my $name = shift; load_project( name => remove_spaces($name), create => 1, ); print "created project: $project_name\n"; } sub t_insert_effect { package Audio::Nama; my ($before, $code, $values) = @_; say("$code: unknown effect. Skipping.\n"), return if ! effect_code($code); $code = effect_code( $code ); my $running = engine_running(); print("Cannot insert effect while engine is recording.\n"), return if $running and Audio::Nama::ChainSetup::really_recording(); print("Cannot insert effect before controller.\n"), return if $cops{$before}->{belongs_to}; if ($running){ $ui->stop_heartbeat; Audio::Nama::mute(); eval_iam('stop'); sleeper( 0.05); } my $n = $cops{ $before }->{chain} or print(qq[Insertion point "$before" does not exist. Skipping.\n]), return; my $track = $ti{$n}; $debug and print $track->name, $/; #$debug and print join " ",@{$track->ops}, $/; # find offset my $offset = 0; for my $id ( @{$track->ops} ){ last if $id eq $before; $offset++; } # remove ops after insertion point if engine is connected # note that this will _not_ change the $track->ops list my @ops = @{$track->ops}[$offset..$#{$track->ops}]; $debug and print "ops to remove and re-apply: @ops\n"; my $connected = eval_iam('cs-connected'); if ( $connected ){ map{ remove_op($_)} reverse @ops; # reverse order for correct index } Audio::Nama::Text::t_add_effect( $track, $code, $values ); $debug and print join " ",@{$track->ops}, $/; # the new op_id is added to the end of the $track->ops list # so we need to move it to specified insertion point my $op = pop @{$track->ops}; # the above acts directly on $track, because ->ops returns # a reference to the array # insert the effect id splice @{$track->ops}, $offset, 0, $op; $debug and print join " ",@{$track->ops}, $/; # replace the ops that had been removed if ($connected ){ map{ apply_op($_, $n) } @ops; } if ($running){ eval_iam('start'); sleeper(0.3); Audio::Nama::unmute(); $ui->start_heartbeat; } $op } sub t_add_effect { package Audio::Nama; my ($track, $code, $values) = @_; say("$code: unknown effect. Skipping.\n"), return if ! effect_code($code); $code = effect_code( $code ); $debug and print "code: ", $code, $/; my %p = ( chain => $track->n, values => $values, type => $code, ); #print "adding effect\n"; $debug and print(yaml_out(\%p)); add_effect( \%p ); } sub t_add_ctrl { package Audio::Nama; my ($parent, $code, $values, $id) = @_; if ( $effect_i{$code} ) {} # do nothing elsif ( $effect_j{$code} ) { $code = $effect_j{$code} } else { warn "effect code not found: $code\n"; return } $debug and print "code: ", $code, $/; my %p = ( chain => $cops{$parent}->{chain}, cop_id => $id, parent_id => $parent, values => $values, type => $code, ); add_effect( \%p ); } sub mixdown { print "Enabling mixdown to file.\n"; $tn{Mixdown}->set(rw => 'REC'); $tn{Master}->set(rw => 'OFF'); $main->set(rw => 'MON'); } sub mixplay { print "Setting mixdown playback mode.\n"; $tn{Mixdown}->set(rw => 'MON'); $tn{Master}->set(rw => 'MON'); $main->set(rw => 'OFF'); } sub mixoff { print "Leaving mixdown mode.\n"; $tn{Mixdown}->set(rw => 'OFF'); $tn{Master}->set(rw => 'MON'); $main->set(rw => 'MON') if $main->rw eq 'OFF'; } sub bunch { package Audio::Nama; my ($bunchname, @tracks) = @_; if (! $bunchname){ Audio::Nama::pager(yaml_out( \%bunch )); } elsif (! @tracks){ $bunch{$bunchname} and print "bunch $bunchname: @{$bunch{$bunchname}}\n" or print "bunch $bunchname: does not exist.\n"; } elsif (my @mispelled = grep { ! $tn{$_} and ! $ti{$_}} @tracks){ print "@mispelled: mispelled track(s), skipping.\n"; } else { $bunch{$bunchname} = [ @tracks ]; } } sub add_to_bunch {} sub remove_fade { my $i = shift; my $fade = $Audio::Nama::Fade::by_index{$i} or print("fade index $i not found. Aborting."), return 1; print "removing fade $i from track " .$fade->track ."\n"; $fade->remove; } ## NO-OP GRAPHIC METHODS no warnings qw(redefine); sub init_gui {} sub transport_gui {} sub group_gui {} sub track_gui {} sub preview_button {} sub create_master_and_mix_tracks {} sub time_gui {} sub refresh {} sub refresh_group {} sub refresh_track {} sub flash_ready {} sub update_master_version_button {} sub update_version_button {} sub paint_button {} sub refresh_oids {} sub project_label_configure{} sub length_display{} sub clock_display {} sub clock_config {} sub manifest {} sub global_version_buttons {} sub destroy_widgets {} sub destroy_marker {} sub restore_time_marks {} sub show_unit {} sub add_effect_gui {} sub remove_effect_gui {} sub marker {} sub init_palette {} sub save_palette {} sub paint_mute_buttons {} sub remove_track_gui {} sub reset_engine_mode_color_display {} sub set_engine_mode_color_display {} 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Config_subs.pm0000644000175000017500000001077211623337667020011 0ustar jrothjroth# ------ Config subroutines ------ package Audio::Nama; use Modern::Perl; no warnings 'uninitialized'; # global variables our ( %opts, # command line options $project_root, # directory $project_name, # startup value @config_vars, # vars to read from namarc $sampling_frequency, # set from 'frequency' abbreviation in namarc $default, # default namarc $custom_pl, # user customizations $debug, $debug2, ); # exclusive to this module our ( %subst, # substitutions ); ## configuration file sub global_config { # return text of config file, in the following order # or priority: # # 1. the file designated by the -f command line argument # 2. .namarc in the current project directory, i.e. ~/nama/untitled/.namarc # 3. .namarc in the home directory, i.e. ~/.namarc # 4. .namarc in the project root directory, i.e. ~/nama/.namarc if( $opts{f} ){ print("reading config file $opts{f}\n"); return read_file($opts{f}); } my @search_path = (project_dir(), $ENV{HOME}, project_root() ); my $c = 0; map{ if (-d $_) { my $config = join_path($_, config_file()); if( -f $config or -l $config){ say "Found config file: $config"; my $yml = read_file($config); return $yml; } } } ( @search_path) } # sub global_config { # read_file( join_path($ENV{HOME}, config_file())); # } sub read_config { # read and process the configuration file # # use the embedded default file if none other is present $debug2 and print "&read_config\n"; my $config = shift; my $yml = length $config > 100 ? $config : $default; strip_all( $yml ); my %cfg = %{ yaml_in($yml) }; *subst = \%{ $cfg{abbreviations} }; # alias walk_tree(\%cfg); walk_tree(\%cfg); # second pass completes substitutions assign_var( \%cfg, @config_vars); $project_root = $opts{d} if $opts{d}; $project_root = expand_tilde($project_root); $sampling_frequency = $cfg{abbreviations}{frequency}; } sub walk_tree { #$debug2 and print "&walk_tree\n"; my $ref = shift; map { substitute($ref, $_) } grep {$_ ne q(abbreviations)} keys %{ $ref }; } sub substitute{ my ($parent, $key) = @_; my $val = $parent->{$key}; #$debug and print qq(key: $key val: $val\n); ref $val and walk_tree($val) or map{$parent->{$key} =~ s/$_/$subst{$_}/} keys %subst; } sub first_run { return if $opts{f}; my $config = config_file(); $config = "$ENV{HOME}/$config" unless -e $config; $debug and print "config: $config\n"; if ( ! -e $config and ! -l $config ) { # check for missing components my $missing; my @a = `which analyseplugin`; @a or print( <; chomp $reply; print("Goodbye.\n"), exit unless $reply =~ /y/i; } print <; sleep 1; print <; chomp $reply; if ($reply !~ /n/i){ # write project root path into default namarc $default =~ s/^project_root.*$/project_root: $ENV{HOME}\/nama/m; # create path nama/untitled/.wav # # this creates directories for # - project root # - project name 'untitled', the default project, and # - project untitled's hidden directory for holding WAV files mkpath( join_path($ENV{HOME}, qw(nama untitled .wav)) ); write_file(user_customization_file(), $custom_pl); } else { print < $n, fades => [], @_ }, $class; $by_name{ $self->edit_name } = $self; $by_index{ $self->n } = $self; #print "self class: $class, self type: ", ref $self, $/; my $name = $self->host_track; my $host = $Audio::Nama::tn{$name}; # Routing: # # sax-v5-original --+ # | # sax-v5-edit1 -----+--- sax-v5 (bus/track) --- sax (bus/track) ----- # prepare top-level bus and mix track $host->busify; # i.e. sax (bus/track) # create the version-level bus and mix track # i.e. sax-v5 (bus/track) # (maybe it already exists) Audio::Nama::Track->new( name => $self->edit_root_name, # i.e. sax-v5 # rw => 'REC', # set by ->busify source_type => 'bus', source_id => 'bus', width => 2, # default to stereo # rec_defeat => 1, # set by ->busify group => $self->host_track, # i.e. sax hide => 1, ); $self->version_mix->busify; # create sub-bus # create host track alias if necessary # To ensure that users don't get into trouble, we would like to # restrict this track: # - version number must *not* be allowed to change # - rw setting must be fixed to 'MON' # # The easiest way may be to subclass the 'set' routine my $host_track_alias = $Audio::Nama::tn{$self->host_alias} // Audio::Nama::VersionTrack->new( name => $self->host_alias, version => $host->monitor_version, # static target => $host->name, rw => 'MON', # do not REC group => $self->edit_root_name, # i.e. sax-v5 hide => 1, ); # create edit track # - same name as edit # - we expect to record # - source_type and source_id come from host track my $edit_track = Audio::Nama::EditTrack->new( name => $self->edit_name, rw => 'REC', source_type => $host->source_type, source_id => $host->source_id, group => $self->edit_root_name, # i.e. sax-v5 hide => 1, ); $self } sub edit_root_name { my $self = shift; join '-', $self->host_track, 'v'.$self->host_version; } sub edit_name { my $self = shift; join '-', $self->edit_root_name, 'edit'.$self->n } sub host_alias { my $self = shift; join '-', $self->edit_root_name, 'original' } # default mark names sub play_start_name { my $self = shift; $self->play_start_mark_name || (join '-', $self->edit_name,'play-start') } sub rec_start_name { my $self = shift; $self->rec_start_mark_name || (join '-', $self->edit_name,'rec-start') } sub rec_end_name { my $self = shift; $self->rec_end_mark_name || (join '-', $self->edit_name,'rec-end') } sub play_start_mark { $Audio::Nama::Mark::by_name{$_[0]->play_start_name} } sub rec_start_mark { $Audio::Nama::Mark::by_name{$_[0]->rec_start_name} } sub rec_end_mark { $Audio::Nama::Mark::by_name{$_[0]->rec_end_name} } # the following are unadjusted values sub play_start_time { my $self = shift; $self->marktime('play_start_name') } sub rec_start_time { my $self = shift; $self->marktime('rec_start_name') } sub rec_end_time { my $self = shift; $self->marktime('rec_end_name') } sub play_end_time { my $self = shift; $self->marktime('rec_end_name') + $Audio::Nama::edit_playback_end_margin } sub marktime { my ($self,$markfield) = @_; $Audio::Nama::Mark::by_name{$self->$markfield}->{time} } sub store_fades { # replacing previous my $edit = shift; my @fades = @_; my @indices = map{$_->n} @fades; $edit->remove_fades; $edit->set(fades => \@indices) } sub remove_fades { my $edit = shift; map{ $_->remove } map{ $Audio::Nama::Fade::by_index{$_} } @{$edit->fades}; $edit->set(fades => []); } sub destroy { my $edit = shift; # remove object from index hash delete $by_index{$edit->n}; delete $by_name{$edit->edit_name}; # list edit track WAV files my @wavs = values %{$edit->edit_track->targets}; # track removal also takes care of fades # VERIFY # my $fades = $edit->fades; # map{ $Audio::Nama::Fade::by_index{$_}->remove } @$fades; # remove edit track $edit->edit_track->remove; my @sister_edits = grep{ $edit->host_track eq $_->host_track and $edit->host_version == $_->host_version } values %by_index; # if we are the last edit, remove all auxiliary tracks/buses if ( ! @sister_edits ){ $edit->host_alias_track->remove; $edit->version_bus->remove; # note: bus->remove will not delete a mix track with WAV files # The host may have a version symlinked to a WAV file # belonging to the version mix track. So we remove # the track, but not the wav files. $edit->version_mix->remove if defined $edit->version_mix; $edit->host_bus->remove; } # remove edit track WAV files if we've reached here map{ my $file = Audio::Nama::join_path(Audio::Nama::this_wav_dir(), $_); say "removing $file"; #unlink $file; } @wavs; } sub host { $Audio::Nama::tn{$_[0]->host_track} } # top-level mix track, i.e. 'sax' sub host_bus { $Audio::Nama::Bus::by_name{$_[0]->host_track} } # top-level bus sub version_mix { $Audio::Nama::tn{$_[0]->edit_root_name} } # in top-level bus sub version_bus { $Audio::Nama::Bus::by_name{$_[0]->edit_root_name} } # version-level bus sub host_alias_track{ $Audio::Nama::tn{$_[0]->host_alias} } # in version_bus sub edit_track { $Audio::Nama::tn{$_[0]->edit_name} } # in version_bus # utility routines # -------- Edit routines; Main Namespace ------ { package Audio::Nama; use Modern::Perl; use Carp; no warnings 'uninitialized'; our ( %event_id, $term, $attribs, %tn, %ti, %bn, @edit_points, $this_track, $regenerate_setup, $offset_run_flag, $loop_enable, $this_edit, $offset_run_start_time, $offset_run_end_time, $offset_mark, $edit_crossfade_time, ); sub detect_keystroke_p { $event_id{stdin} = AE::io(*STDIN, 0, sub { &{$attribs->{'callback_read_char'}}(); abort_set_edit_points(), return if $attribs->{line_buffer} eq "q" or $attribs->{line_buffer} eq "Q"; if ( $attribs->{line_buffer} eq "p" or $attribs->{line_buffer} eq "P"){ get_edit_mark()} else{ reset_input_line() } }); } sub reset_input_line { $attribs->{line_buffer} = q(); $attribs->{point} = 0; $attribs->{end} = 0; } { my $p; my @edit_points; my @names = qw(dummy play-start rec-start rec-end); sub initialize_edit_points { $p = 0; @edit_points = (); } sub abort_set_edit_points { say "...Aborting!"; reset_input_line(); eval_iam('stop'); initialize_edit_points(); detect_spacebar(); } sub get_edit_mark { $p++; if($p <= 3){ # record mark my $pos = eval_iam('getpos'); push @edit_points, $pos; say " got $names[$p] position ".d1($pos); reset_input_line(); if( $p == 3){ complete_edit_points() } else{ $term->stuff_char(10); &{$attribs->{'callback_read_char'}}(); } } } sub complete_edit_points { @Audio::Nama::edit_points = @edit_points; # save to global eval_iam('stop'); say "\nEngine is stopped\n"; detect_spacebar(); print prompt(), " "; } } sub set_edit_points { $tn{$this_edit->edit_name}->set(rw => 'OFF') if defined $this_edit; say("You must use a playback-only mode to setup edit marks. Aborting"), return 1 if Audio::Nama::ChainSetup::really_recording(); say("You need stop the engine first. Aborting"), return 1 if engine_running(); say "Ready to set edit points!"; sleeper(0.2); say q(Press the "P" key three times to mark positions for: + play-start + record-start + record-end say q(Press "Q" to quit.) Engine will start in 2 seconds.); initialize_edit_points(); $event_id{set_edit_points} = AE::timer(2, 0, sub { reset_input_line(); detect_keystroke_p(); eval_iam('start'); say "\n\nEngine is running\n"; print prompt(); }); } sub transfer_edit_points { say("Use 'set_edit_points' command to specify edit region"), return unless scalar @edit_points; my $edit = shift; Audio::Nama::Mark->new( name => $edit->play_start_name, time => $edit_points[0]); Audio::Nama::Mark->new( name => $edit->rec_start_name, time => $edit_points[1]); Audio::Nama::Mark->new( name => $edit->rec_end_name, time => $edit_points[2]); @edit_points = (); } sub generate_edit_record_setup { # for current edit # set edit track to REC # set global region start offset # set global region length cutoff # set regenerate_setup flag # insert host track fades # mute edit track # schedule unmuting at rec-start point - fade-in # schedule muting at rec-end point - fade-out } sub new_edit { #my @edit_points = @_; # abort for many different reasons say("You must use 'set_edit_points' before creating a new edit. Aborting."), return unless @edit_points; my $overlap = grep { my $fail; my $rst = $_->rec_start_time; my $ret = $_->rec_end_time; my $nst = $edit_points[1]; my $net = $edit_points[2]; my $rst1 = d1($rst); my $ret1 = d1($ret); my $nst1 = d1($nst); my $net1 = d1($net); say("New rec-start time $nst1 conflicts with Edit ", $_->n, ": $rst1 < $nst1 < $ret1"), $fail++ if $rst < $nst and $nst < $ret; say("New rec-end time $net1 conflicts with Edit ", $_->n, ": $rst1 < $net1 < $ret1"), $fail++ if $rst < $net and $net < $ret; say("New rec interval $nst1 - $net1 conflicts with Edit ", $_->n, ": $rst1 - $ret1"), $fail++ if $nst < $rst and $ret < $net; $fail } grep{ $_->host_track eq $this_track->name} values %Audio::Nama::Edit::by_name; say("Aborting."), return if $overlap; my $name = $this_track->name; my $editre = qr($name-v\d+-edit\d+); say("$name: editing of edits is not currently allowed."), return if $name =~ /-v\d+-edit\d+/; say("$name: must be in MON mode. Edits will be applied against current version"), return unless $this_track->rec_status eq 'MON' or $this_track->rec_status eq 'REC' and grep{ /$editre/ } keys %Audio::Nama::Track::by_name; # create edit my $v = $this_track->monitor_version; say "$name: creating new edit against version $v"; my $edit = Audio::Nama::Edit->new( host_track => $this_track->name, host_version => $v, ); $this_track->current_edit->{$v} = $edit->n; $this_edit = $edit; transfer_edit_points($edit); #select_edit($this_edit->n); edit_action('preview_edit_in'); } {my %edit_actions = ( record_edit => sub { $this_edit->edit_track->set(rw => 'REC'); $this_edit->store_fades(std_host_fades(), edit_fades()); }, play_edit => sub { $this_edit->edit_track->set(rw => 'MON'); $this_edit->store_fades(std_host_fades(), edit_fades()); }, preview_edit_in => sub { $this_edit->edit_track->set(rw => 'OFF'); $this_edit->store_fades(std_host_fades()); }, preview_edit_out => sub { $this_edit->edit_track->set(rw => 'OFF'); $this_edit->store_fades(reverse_host_fades()); }, ); sub edit_action { my $action = shift; defined $this_edit or say("Please select an edit and try again."), return; set_edit_mode(); $this_edit->host_alias_track->set(rw => 'MON'); # all $edit_actions{$action}->(); $regenerate_setup++; # TODO: looping # my $is_setup = generate_setup(); # return unless $is_setup; # if ($action !~ /record/){ # $loop_enable++; # @loop_endpoints = (0,$length - 0.05); # # and transport_start() # } # connect_transport(); } } sub end_edit_mode { # regenerate fades $offset_run_flag = 0; $loop_enable = 0; offset_run_mode(0); $this_track = $this_edit->host if defined $this_edit; undef $this_edit; $regenerate_setup++ } sub destroy_edit { say("no edit selected"), return unless $this_edit; my $reply = $term->readline('destroy edit "'.$this_edit->edit_name. qq(" and all its WAV files?? [n] )); if ( $reply =~ /y/i ){ say "permanently removing edit"; $this_edit->destroy; } $term->remove_history($term->where_history); $this_track = $this_edit->host; end_edit_mode(); } sub set_edit_mode { $offset_run_flag = edit_mode_conditions() ? 1 : 0 } sub edit_mode { $offset_run_flag and defined $this_edit} sub edit_mode_conditions { defined $this_edit or say('No edit is defined'), return; defined $this_edit->play_start_time or say('No edit points defined'), return; $this_edit->host_alias_track->rec_status eq 'MON' or say('host alias track : ',$this_edit->host_alias, " status must be MON"), return; # the following conditions should never be triggered $this_edit->host_alias_track->monitor_version == $this_edit->host_version or die('host alias track: ',$this_edit->host_alias, " must be set to version ",$this_edit->host_version), return 1; } sub reverse_host_fades { host_fades('in','out') } sub std_host_fades { host_fades('out','in') } sub host_fades { my ($first,$second) = @_; Audio::Nama::Fade->new( type => $first, mark1 => $this_edit->rec_start_name, duration => $edit_crossfade_time, relation => 'fade_from_mark', track => $this_edit->host_alias, ), Audio::Nama::Fade->new( type => $second, mark1 => $this_edit->rec_end_name, duration => $edit_crossfade_time, relation => 'fade_from_mark', track => $this_edit->host_alias, ), } sub edit_fades { Audio::Nama::Fade->new( type => 'in', mark1 => $this_edit->rec_start_name, duration => $edit_crossfade_time, relation => 'fade_from_mark', track => $this_edit->edit_name, ), Audio::Nama::Fade->new( type => 'out', mark1 => $this_edit->rec_end_name, duration => $edit_crossfade_time, relation => 'fade_from_mark', track => $this_edit->edit_name, ); } ### edit region computations { # use internal lexical values for the computations # track values my( $trackname, $playat, $region_start, $region_end, $length); # edit values my( $edit_play_start, $edit_play_end); # dispatch table my( %playat, %region_start, %region_end); # test variables # my ($index, $new_playat, $new_region_start, $new_region_end); %region_start = ( out_of_bounds_near => sub{ "*" }, out_of_bounds_far => sub{ "*" }, play_start_during_playat_delay => sub {$region_start }, no_region_play_start_during_playat_delay => sub { 0 }, play_start_within_region => sub {$region_start + $edit_play_start - $playat }, no_region_play_start_after_playat_delay => sub {$region_start + $edit_play_start - $playat }, ); %playat = ( out_of_bounds_near => sub{ "*" }, out_of_bounds_far => sub{ "*" }, play_start_during_playat_delay => sub{ $playat - $edit_play_start }, no_region_play_start_during_playat_delay => sub{ $playat - $edit_play_start }, play_start_within_region => sub{ 0 }, no_region_play_start_after_playat_delay => sub{ 0 }, ); %region_end = ( out_of_bounds_near => sub{ "*" }, out_of_bounds_far => sub{ "*" }, play_start_during_playat_delay => sub { $region_start + $edit_play_end - $playat }, no_region_play_start_during_playat_delay => sub { $edit_play_end - $playat }, play_start_within_region => sub { $region_start + $edit_play_end - $playat }, no_region_play_start_after_playat_delay => sub { $edit_play_end - $playat }, ); sub new_playat { $playat{edit_case()}->() }; sub new_region_start { $region_start{edit_case()}->() }; sub new_region_end { my $end = $region_end{edit_case()}->(); return $end if $end eq '*'; $end < $length ? $end : $length }; # the following value will always allow enough time # to record the edit. it may be longer than the # actual WAV file in some cases. (I doubt that # will be a problem.) sub edit_case { # logic for no-region case if ( ! $region_start and ! $region_end ) { if( $edit_play_end < $playat) { "out_of_bounds_near" } elsif( $edit_play_start > $playat + $length) { "out_of_bounds_far" } elsif( $edit_play_start >= $playat) {"no_region_play_start_after_playat_delay"} elsif( $edit_play_start < $playat and $edit_play_end > $playat ) { "no_region_play_start_during_playat_delay"} } # logic for region present case elsif ( defined $region_start and defined $region_end ) { if ( $edit_play_end < $playat) { "out_of_bounds_near" } elsif ( $edit_play_start > $playat + $region_end - $region_start) { "out_of_bounds_far" } elsif ( $edit_play_start >= $playat) { "play_start_within_region"} elsif ( $edit_play_start < $playat and $playat < $edit_play_end) { "play_start_during_playat_delay"} else {carp "$trackname: fell through if-then"} } else { carp "$trackname: improperly defined region" } } sub set_edit_vars { my $track = shift; $trackname = $track->name; $playat = $track->playat_time; $region_start = $track->region_start_time; $region_end = $track->region_end_time; $edit_play_start= play_start_time(); $edit_play_end = play_end_time(); $length = wav_length($track->full_path); } sub play_start_time { defined $this_edit ? $this_edit->play_start_time : $offset_run_start_time # zero unless offset run mode } sub play_end_time { defined $this_edit ? $this_edit->play_end_time : $offset_run_end_time # undef unless offset run mode } sub set_edit_vars_testing { ($playat, $region_start, $region_end, $edit_play_start, $edit_play_end, $length) = @_; } } sub list_edits { my @edit_data = map{ s/^---//; s/...\s$//; $_ } map{ $_->dump } sort{$a->n <=> $b->n} values %Audio::Nama::Edit::by_index; pager(@edit_data); } sub explode_track { my $track = shift; # quit if I am already a mix track say($track->name,": I am already a mix track. I cannot explode!"),return if $track->is_mix_track; my @versions = @{ $track->versions }; # quit if I have only one version say($track->name,": Only one version. Skipping."), return if scalar @versions == 1; $track->busify; my $host = $track->name; my @names = map{ "$host-v$_"} @versions; my @exists = grep{ $Audio::Nama::tn{$_} } @names; say("@exists: tracks already exist. Aborting."), return if @exists; my $current = cwd; chdir this_wav_dir(); for my $i (@versions){ # make a track my $name = "$host-v$i"; Audio::Nama::Track->new( name => $name, rw => 'MON', group => $host, ); # symlink the WAV file we want symlink $track->targets->{$i}, "$name.wav"; } chdir $current; } sub select_edit { my $n = shift; my ($edit) = grep{ $_->n == $n } values %Audio::Nama::Edit::by_name; # check that conditions are met say("Edit $n not found. Skipping."),return if ! $edit; say( qq(Edit $n applies to track "), $edit->host_track, qq(" version ), $edit->host_version, ". This does does not match the current monitor version (", $edit->host->monitor_version,"). Set the correct version and try again."), return if $edit->host->monitor_version != $edit->host_version; # select edit $this_edit = $edit; # turn on top-level bus and mix track $edit->host_bus->set(rw => 'REC'); $edit->host->busify; # turn off all version level buses/mix_tracks map{ $tn{$_}->set(rw => 'OFF'); # version mix tracks $bn{$_}->set(rw => 'OFF'); # version buses } $this_edit->host_bus->tracks; # use same name for track/bus # turn on what we want $edit->version_bus->set(rw => 'REC'); $edit->version_mix->busify; $edit->host_alias_track->set(rw => 'MON'); $edit->edit_track->set(rw => 'MON'); $this_track = $edit->host; } sub apply_fades { # use info from Fade objects in %Audio::Nama::Fade::by_name # applying to tracks that are part of current # chain setup map{ Audio::Nama::Fade::refresh_fade_controller($_) } grep{$_->{fader} } # only if already exists Audio::Nama::ChainSetup::engine_tracks(); } sub disable_edits { say("Please select an edit and try again."), return unless defined $this_edit; my $edit = $this_edit; $edit->host_bus->set( rw => 'OFF'); $edit->version_bus->set( rw => 'OFF'); # reset host track $edit->host->unbusify; } sub merge_edits { my $edit = $this_edit; say("Please select an edit and try again."), return unless defined $edit; say($edit->host_alias, ": track must be MON status. Aborting."), return unless $edit->host_alias_track->rec_status eq 'MON'; say("Use exit_edit_mode and try again."), return if edit_mode(); # create merge message my $v = $edit->host_version; my %edits = map{ my ($edit) = $tn{$_}->name =~ /edit(\d+)$/; my $ver = $tn{$_}->monitor_version; $edit => $ver } grep{ $tn{$_}->name =~ /edit\d+$/ and $tn{$_}->rec_status eq 'MON'} $edit->version_bus->tracks; my $msg = "merges ".$edit->host_track."_$v.wav w/edits ". join " ",map{$_."v$edits{$_}"} sort{$a<=>$b} keys %edits; # merges mic_1.wav w/mic-v1-edits 1_2 2_1 say $msg; # cache at version_mix level my $output_wav = cache_track($edit->version_mix); # promote to host track my $new_version = $edit->host->last + 1; add_system_version_comment($edit->host, $new_version, $msg); add_system_version_comment($edit->version_mix, $edit->version_mix->last, $msg); my $old = cwd(); chdir this_wav_dir(); my $new_host_wav = $edit->host_track . "_" . $new_version . ".wav"; symlink $output_wav, $new_host_wav; $edit->host->set(version => undef); # default to latest $edit->host->{version_comment}{$new_version}{system} = $msg; chdir $old; disable_edits(); $this_track = $edit->host; } sub show_version_comments { my ($t, @v) = @_; return unless @v; Audio::Nama::pager(map{ $t->version_comment($_) } @v); } sub add_version_comment { my ($t,$v,$text) = @_; $t->targets->{$v} or say("$v: no such version"), return; $t->{version_comment}{$v}{user} = $text; $t->version_comment($v); } sub add_system_version_comment { my ($t,$v,$text) = @_; $t->targets->{$v} or say("$v: no such version"), return; $t->{version_comment}{$v}{system} = $text; $t->version_comment($v); } sub remove_version_comment { my ($t,$v) = @_; $t->targets->{$v} or say("$v: no such version"), return; delete $t->{version_comment}{$v}{user}; $t->version_comment($v) || "$v: [comment deleted]\n"; } sub remove_system_version_comment { my ($t,$v) = @_; delete $t->{version_comment}{$v}{system} if $t->{version_comment}{$v} } # offset recording # Note that although we use ->adjusted_* methods, all are # executed outside of edit mode, so we get unadjusted values. sub setup_length { my $length; map{ my $l = $_->adjusted_length; $length = $l if $l > $length } grep{ $_-> rec_status eq 'MON' } Audio::Nama::ChainSetup::engine_tracks(); $length } sub offset_run { say("This function not available in edit mode. Aborting."), return if edit_mode(); my $markname = shift; $offset_run_start_time = $Audio::Nama::Mark::by_name{$markname}->time; $offset_run_end_time = setup_length(); $offset_mark = $markname; offset_run_mode(1); $regenerate_setup++; } sub clear_offset_run_vars { $offset_run_start_time = 0; $offset_run_end_time = undef; $offset_mark = undef; } sub offset_run_mode { my $set = shift; given($set){ when(0){ undef $offset_run_flag; clear_offset_run_vars(); $regenerate_setup++; } when(1){ undef $this_edit; $offset_run_flag++ } } $offset_run_flag and ! defined $this_edit } sub select_edit_track { my $track_selector_method = shift; print("You need to select an edit first (list_edits, select_edit)\n"), return unless defined $this_edit; $this_track = $this_edit->$track_selector_method; command_process('show_track'); } } # end package 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Effect_chain_subs.pm0000644000175000017500000001203411623337667021133 0ustar jrothjroth# ------------- Effect-Chain and -Profile routines -------- package Audio::Nama; use Modern::Perl; no warnings 'uninitialized'; our ( $project_name, $this_track, %effect_chain, %effect_profile, $debug, $debug2, %tn, %cops, %copp, $magical_cop_id, ); sub private_effect_chain_name { my $name = "_$project_name/".$this_track->name.'_'; my $i; map{ my ($j) = /_(\d+)$/; $i = $j if $j > $i; } @{ $this_track->effect_chain_stack }, grep{/$name/} keys %effect_chain; $name . ++$i } sub profile_effect_chain_name { my ($profile, $track_name) = @_; "_$profile\:$track_name"; } # too many functions in push and pop!! sub push_effect_chain { $debug2 and say "&push_effect_chain"; my ($track, %vals) = @_; # use supplied ops list, or default to user-applied (fancy) ops my @ops = $vals{ops} ? @{$vals{ops}} : $track->fancy_ops; say("no effects to store"), return unless @ops; # use supplied name, or default to private name that will now show # in listing my $save_name = $vals{save} || private_effect_chain_name(); $debug and say "save name: $save_name"; # create a new effect-chain definition new_effect_chain( $track, $save_name, @ops ); # current track effects # store effect-chain name on track effect-chain stack push @{ $track->effect_chain_stack }, $save_name; # remove stored effects map{ remove_effect($_)} @ops; # return name $save_name; } sub pop_effect_chain { # restore previous $debug2 and say "&pop_effect_chain"; my $track = shift; my $previous = pop @{$track->effect_chain_stack}; say("no previous effect chain"), return unless $previous; map{ remove_effect($_)} $track->fancy_ops; add_effect_chain($track, $previous); delete $effect_chain{$previous}; } sub overwrite_effect_chain { $debug2 and say "&overwrite_effect_chain"; my ($track, $name) = @_; print("$name: unknown effect chain.\n"), return if ! $effect_chain{$name}; push_effect_chain($track) if $track->fancy_ops; add_effect_chain($track,$name); } sub new_effect_profile { $debug2 and say "&new_effect_profile"; my ($bunch, $profile) = @_; my @tracks = bunch_tracks($bunch); say qq(effect profile "$profile" created for tracks: @tracks); map { new_effect_chain($tn{$_}, profile_effect_chain_name($profile, $_)); } @tracks; $effect_profile{$profile}{tracks} = [ @tracks ]; save_effect_chains(); save_effect_profiles(); } sub delete_effect_profile { $debug2 and say "&delete_effect_profile"; my $name = shift; say qq(deleting effect profile: $name); my @tracks = $effect_profile{$name}; delete $effect_profile{$name}; map{ delete $effect_chain{profile_effect_chain_name($name,$_)} } @tracks; } sub apply_effect_profile { # overwriting current effects $debug2 and say "&apply_effect_profile"; my ($function, $profile) = @_; my @tracks = @{ $effect_profile{$profile}{tracks} }; my @missing = grep{ ! $tn{$_} } @tracks; @missing and say(join(',',@missing), ": tracks do not exist. Aborting."), return; @missing = grep { ! $effect_chain{profile_effect_chain_name($profile,$_)} } @tracks; @missing and say(join(',',@missing), ": effect chains do not exist. Aborting."), return; map{ $function->( $tn{$_}, profile_effect_chain_name($profile,$_)) } @tracks; } sub list_effect_profiles { my @results; while( my $name = each %effect_profile){ push @results, "effect profile: $name\n"; push @results, list_effect_chains("_$name:"); } @results; } sub restore_effects { pop_effect_chain($_[0])} sub new_effect_chain { my ($track, $name, @ops) = @_; # say "name: $name, ops: @ops"; @ops or @ops = $track->fancy_ops; say $track->name, qq(: creating effect chain "$name") unless $name =~ /^_/; $effect_chain{$name} = { ops => \@ops, type => { map{$_ => $cops{$_}{type} } @ops}, params => { map{$_ => $copp{$_} } @ops}, }; save_effect_chains(); } sub add_effect_chain { my ($track, $name) = @_; #say "track: $track name: ",$track->name, " effect chain: $name"; say("$name: effect chain does not exist"), return if ! $effect_chain{$name}; say $track->name, qq(: adding effect chain "$name") unless $name =~ /^_/; my $before = $track->vol; map { $magical_cop_id = $_ unless $cops{$_}; # try to reuse cop_id if ($before){ Audio::Nama::Text::t_insert_effect( $before, $effect_chain{$name}{type}{$_}, $effect_chain{$name}{params}{$_}); } else { Audio::Nama::Text::t_add_effect( $track, $effect_chain{$name}{type}{$_}, $effect_chain{$name}{params}{$_}); } $magical_cop_id = undef; } @{$effect_chain{$name}{ops}}; } sub list_effect_chains { my @frags = @_; # fragments to match against effect_chain names # we don't list chain_ids starting with underscore # except when searching for particular chains my @ids = grep{ @frags or ! /^_/ } keys %Audio::Nama::effect_chain; if (@frags){ @ids = grep{ my $id = $_; grep{ $id =~ /$_/} @frags} @ids; } my @results; map{ my $name = $_; push @results, join ' ', "$name:", map{$effect_chain{$name}{type}{$_}, @{$effect_chain{$name}{params}{$_}} } @{$effect_chain{$name}{ops}}; push @results, "\n"; } @ids; @results; } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Util.pm0000644000175000017500000001050311623337670016447 0ustar jrothjroth# ----------- Util.pm ----------- # this package is for small subroutines with # well-defined interfaces package Audio::Nama; our ( %tn ); # rw_set() package Audio::Nama::Util; use Modern::Perl; use Carp; no warnings 'uninitialized'; require Exporter; our @ISA = qw(Exporter); our %EXPORT_TAGS = ( 'all' => [ qw( rw_set freq channels input_node output_node signal_format process_is_running d1 d2 dn round colonize time_tag heuristic_time dest_type ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = (); ## rw_set() for managing bus-level REC/MON/OFF settings commands { my %bus_logic = ( mix_track => { # setting mix track to REC # set bus to MON (user should set bus to REC) REC => sub { my ($bus, $track) = @_; $track->set_rec; $bus->set(rw => 'MON'); }, # setting mix track to MON # set bus to OFF MON => sub { my ($bus, $track) = @_; $track->set_mon; $bus->set(rw => 'OFF'); }, OFF => sub { # setting mix track to OFF # set bus to OFF my ($bus, $track) = @_; $track->set_off; $bus->set(rw => 'OFF'); } }, member_track => { # setting member track to REC # # - set REC siblings to MON if bus is MON # - set all siblings to OFF if bus is OFF # - set bus to REC # - set mix track to REC/rec_defeat REC => sub { my ($bus, $track) = @_; if ($bus->rw eq 'MON'){ # set REC tracks to MON map{$_->set(rw => 'MON') } grep{$_->rw eq 'REC'} map{$tn{$_}} $bus->tracks; } if ($bus->rw eq 'OFF'){ # set all tracks to OFF map{$_->set(rw => 'OFF') } map{$tn{$_}} $bus->tracks; } $track->set_rec; $bus->set(rw => 'REC'); $tn{$bus->send_id}->busify; }, # setting member track to MON # # - set all siblings to OFF if bus is OFF # - set bus to MON # - set mix track to REC/rec_defeat MON => sub { my ($bus, $track) = @_; if ($bus->rw eq 'OFF'){ # set all tracks to OFF map{$_->set(rw => 'OFF') } map{$Audio::Nama::tn{$_}} $bus->tracks; $bus->set(rw => 'MON'); } $track->set_mon; #$tn{$bus->send_id}->busify; why needed???? }, # setting member track to OFF OFF => sub { my ($bus, $track) = @_; $track->set_off; }, }, ); sub rw_set { my ($bus,$track,$rw) = @_; my $type = $track->is_mix_track ? 'mix_track' : 'member_track'; $bus_logic{$type}{uc $rw}->($bus,$track); } } sub freq { [split ',', $_[0] ]->[2] } # e.g. s16_le,2,44100 sub channels { [split ',', $_[0] ]->[1] } sub input_node { $_[0].'_in' } sub output_node {$_[0].'_out'} sub signal_format { my ($template, $channel_count) = @_; $template =~ s/N/$channel_count/; my $format = $template; } sub process_is_running { my $name = shift; my @pids = split " ", qx(pgrep $name); my @ps_ax = grep{ my $pid; /$name/ and ! /defunct/ and ($pid) = /(\d+)/ and grep{ $pid == $_ } @pids } split "\n", qx(ps ax) ; } sub d1 { my $n = shift; sprintf("%.1f", $n) } sub d2 { my $n = shift; sprintf("%.2f", $n) } sub dn { my ($n, $places) = @_; sprintf("%." . $places . "f", $n); } sub round { my $n = shift; return 0 if $n == 0; $n = int $n if $n > 10; $n = d2($n) if $n < 10; $n; } sub colonize { # convert seconds to hours:minutes:seconds my $sec = shift || 0; my $hours = int ($sec / 3600); $sec = $sec % 3600; my $min = int ($sec / 60); $sec = $sec % 60; $sec = "0$sec" if $sec < 10; $min = "0$min" if $min < 10 and $hours; ($hours ? "$hours:" : "") . qq($min:$sec); } sub time_tag { my @time = localtime time; $time[4]++; $time[5]+=1900; @time = @time[5,4,3,2,1,0]; sprintf "%4d.%02d.%02d-%02d:%02d:%02d", @time } sub heuristic_time { my $sec = shift; d1($sec) . ( $sec > 120 ? " (" . colonize( $sec ) . ") " : " " ) } sub dest_type { my $dest = shift; my $type; given( $dest ){ when( undef ) {} # do nothing # non JACK related when('bus') { $type = 'bus' } when('null') { $type = 'null' } when(/^loop,/) { $type = 'loop' } when(! /\D/) { $type = 'soundcard' } # digits only # JACK related when(/^man/) { $type = 'jack_manual' } when('jack') { $type = 'jack_manual' } when(/(^\w+\.)?ports/) { $type = 'jack_ports_list' } default { $type = 'jack_client' } } $type } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Wav.pm0000644000175000017500000000333211623337667016277 0ustar jrothjrothpackage Audio::Nama::Wav; our $VERSION = 1.0; our @ISA; use Audio::Nama::Object qw(name version dir); use warnings; use Audio::Nama::Assign qw(:all); use Memoize qw(memoize unmemoize); no warnings qw(uninitialized); use Carp; sub get_versions { #local $debug = 1; my $self = shift; my ($sep, $ext) = qw( _ wav ); my ($dir, $basename) = ($self->dir, $self->basename); # print "dir: ", $self->dir(), $/; #print "basename: ", $self->basename(), $/; $debug and print "getver: dir $dir basename $basename sep $sep ext $ext\n\n"; my %versions = (); for my $candidate ( candidates($dir) ) { # $debug and print "candidate: $candidate\n\n"; my( $match, $dummy, $num) = ( $candidate =~ m/^ ( $basename ($sep (\d+))? \.$ext ) $/x ); # regex statement if ( $match ) { $versions{ $num || 'bare' } = $match } } $debug and print "get_version: " , Audio::Nama::yaml_out(\%versions); %versions; } sub candidates { my $dir = shift; $dir = File::Spec::Link->resolve_all( $dir ); opendir my $wavdir, $dir or die "cannot open $dir: $!"; my @candidates = readdir $wavdir; closedir $wavdir; @candidates = grep{ ! (-s join_path($dir, $_) == 44 ) } @candidates; #$debug and print join $/, @candidates; @candidates; } sub targets { my $self = shift; # $Audio::Nama::debug2 and print "&targets\n"; my %versions = $self->get_versions; if ($versions{bare}) { $versions{1} = $versions{bare}; delete $versions{bare}; } $debug and print "\%versions\n================\n", yaml_out(\%versions); \%versions; } sub versions { # $Audio::Nama::debug2 and print "&versions\n"; my $self = shift; [ sort { $a <=> $b } keys %{ $self->targets} ] } sub last { my $self = shift; pop @{ $self->versions} }Audio-Nama-1.078/lib/Audio/Nama/Mode_subs.pm0000644000175000017500000000675711623337667017500 0ustar jrothjroth# ----------- Modes: mastering, preview, doodle --------- package Audio::Nama; use Modern::Perl; our ( $debug, $debug2, $preview, $main, %tn, $mastering_mode, @mastering_track_names, $ui, $this_track, $compressor, $spatialiser, $low_pass, $mid_pass, $high_pass, $limiter, $eq, ); { my $old_group_rw; # for restore on exiting doodle/preview mode sub set_preview_mode { # set preview mode, releasing doodle mode if necessary $debug2 and print "&preview\n"; # do nothing if already in 'preview' mode if ( $preview eq 'preview' ){ return } # make an announcement if we were in rec-enabled mode $main->set(rw => $old_group_rw) if $old_group_rw; $preview = "preview"; print "Setting preview mode.\n"; print "Using both REC and MON inputs.\n"; print "WAV recording is DISABLED.\n\n"; print "Type 'arm' to enable recording.\n\n"; # reconfigure_engine() will generate setup and start transport } sub set_doodle_mode { $debug2 and print "&doodle\n"; return if engine_running() and Audio::Nama::ChainSetup::really_recording(); $preview = "doodle"; # save rw setting of user tracks (not including null group) # and set those tracks to REC $old_group_rw = $main->rw; $main->set(rw => 'REC'); $tn{Mixdown}->set(rw => 'OFF'); # reconfigure_engine will generate setup and start transport print "Setting doodle mode.\n"; print "Using live inputs only, with no duplicate inputs\n"; print "Exit using 'preview' or 'arm' commands.\n"; } sub exit_preview_mode { # exit preview and doodle modes $debug2 and print "&exit_preview_mode\n"; return unless $preview; stop_transport() if engine_running(); $debug and print "Exiting preview/doodle mode\n"; $preview = 0; $main->set(rw => $old_group_rw) if $old_group_rw; } } sub master_on { return if $mastering_mode; # set $mastering_mode $mastering_mode++; # create mastering tracks if needed if ( ! $tn{Eq} ){ local $this_track; add_mastering_tracks(); add_mastering_effects(); } else { unhide_mastering_tracks(); map{ $ui->track_gui($tn{$_}->n) } @mastering_track_names; } } sub master_off { $mastering_mode = 0; hide_mastering_tracks(); map{ $ui->remove_track_gui($tn{$_}->n) } @mastering_track_names; $this_track = $tn{Master} if grep{ $this_track->name eq $_} @mastering_track_names; ; } sub add_mastering_tracks { map{ my $track = Audio::Nama::MasteringTrack->new( name => $_, rw => 'MON', group => 'Mastering', ); $ui->track_gui( $track->n ); } grep{ $_ ne 'Boost' } @mastering_track_names; my $track = Audio::Nama::SlaveTrack->new( name => 'Boost', rw => 'MON', group => 'Mastering', target => 'Master', ); $ui->track_gui( $track->n ); } sub add_mastering_effects { $this_track = $tn{Eq}; command_process("add_effect $eq"); $this_track = $tn{Low}; command_process("add_effect $low_pass"); command_process("add_effect $compressor"); command_process("add_effect $spatialiser"); $this_track = $tn{Mid}; command_process("add_effect $mid_pass"); command_process("add_effect $compressor"); command_process("add_effect $spatialiser"); $this_track = $tn{High}; command_process("add_effect $high_pass"); command_process("add_effect $compressor"); command_process("add_effect $spatialiser"); $this_track = $tn{Boost}; command_process("add_effect $limiter"); # insert after vol } sub unhide_mastering_tracks { command_process("for Mastering; set_track hide 0"); } sub hide_mastering_tracks { command_process("for Mastering; set_track hide 1"); } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Assign.pm0000644000175000017500000002262211623337667016771 0ustar jrothjrothpackage Audio::Nama::Assign; our $VERSION = 1.0; use 5.008; use strict; use warnings; no warnings q(uninitialized); use Carp; use YAML::Tiny; use File::Slurp; use File::HomeDir; use Storable qw(nstore retrieve); #use Devel::Cycle; require Exporter; our @ISA = qw(Exporter); our %EXPORT_TAGS = ( 'all' => [ qw( serialize assign assign_vars store_vars yaml_out yaml_in create_dir join_path wav_off strip_all strip_blank_lines strip_comments remove_spaces expand_tilde resolve_path quote_yaml_scalars ) ] ); our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); our @EXPORT = (); package Audio::Nama; our ($debug, $debug2, $debug3); package Audio::Nama::Assign; use Carp; sub assign { $debug2 and print "&assign\n"; my %h = @_; # parameters appear in %h my $class; carp "didn't expect scalar here" if ref $h{data} eq 'SCALAR'; carp "didn't expect code here" if ref $h{data} eq 'CODE'; # print "data: $h{data}, ", ref $h{data}, $/; if ( ref $h{data} !~ /^(HASH|ARRAY|CODE|GLOB|HANDLE|FORMAT)$/){ # we guess object $class = ref $h{data}; $debug and print "I found an object of class $class...\n"; } $class = $h{class}; $class .= "::" unless $class =~ /::$/; # SKIP_PREPROC my @vars = @{ $h{vars} }; my $ref = $h{data}; my $type = ref $ref; $debug and print <{$identifier}; if ($sigil eq '$') { # scalar assignment # extract value if ($val) { # if we have something, # dereference it if needed ref $val eq q(SCALAR) and $val = $$val; # quoting for non-numerical $val = qq("$val") unless $val =~ /^[\d\.,+\-e]+$/ } else { $val = q(undef) }; # or set as undefined $eval .= $val; # append to assignment } else { # array, hash assignment $eval .= qq($sigil\{); $eval .= q($ref->{ ); $eval .= qq("$identifier"); $eval .= q( } ); $eval .= q( } ); } $debug and print $eval, $/; eval($eval); $debug and $@ and carp "failed to eval $eval: $@\n"; } # end if sigil{key} } @keys; 1; } sub assign_vars { $debug2 and print "&assign_vars\n"; my %h = @_; my $source = $h{source}; my @vars = @{ $h{vars} }; my $class = $h{class}; my $format = $h{format}; # assigns vars in @var_list to values from $source # $source can be a : # - filename or # - string containing YAML data # - reference to a hash array containing assignments # # returns a $ref containing the retrieved data structure $debug and print "source: ", (ref $source) || $source, "\n"; $debug and print "variable list: @vars\n"; my $ref; ### figure out what to do with input if ($source !~ /\n/ and -f $source){ if ( $source =~ /\.yml$/i or $format eq 'yaml'){ $debug and print "found a yaml file: $source\n"; $ref = yaml_in($source); } elsif ( $source =~ /\.pl$/i or $format eq 'perl'){ $debug and print "found a perl file: $source\n"; my $code = read_file($source); $ref = eval $code or carp "$source: eval failed: $@\n"; } else { $debug and print "assuming Storable file: $source\n"; $ref = retrieve($source) # Storable } } elsif ( $source =~ /\n/ ){ $debug and print "found yaml text\n"; $ref = yaml_in($source); # pass a hash_ref to the assigner } elsif ( ref $source ) { $debug and print "found a reference\n"; $ref = $source; } else { carp "$source: missing data source\n"; } assign(data => $ref, vars => \@vars, class => $class); 1; } sub serialize { $debug2 and print "&serialize\n"; my %h = @_; my @vars = @{ $h{vars} }; my $class = $h{class}; my $file = $h{file}; my $format = $h{format}; $class .= "::" unless $class =~ /::$/; # SKIP_PREPROC $debug and print "file: $file, class: $class\nvariables...@vars\n"; my %state; map{ my ($sigil, $identifier) = /(.)([\w:]+)/; # for YAML::Reader/Writer # # all scalars must contain values, not references #my $value = q(\\) my $value = ($sigil ne q($) ? q(\\) : q() ) . $sigil . ($identifier =~ /:/ ? '' : $class) . $identifier; # more YAML adjustments # # restore will break if a null field is not converted to '~' my $eval_string = q($state{') . $identifier . q('}) . q( = ) . $value; $debug and print "attempting to eval $eval_string\n"; eval($eval_string) or $debug and print "eval returned zero or failed ($@\n)"; } @vars; # my $result1 = store \%state, $file; # old method if ( $h{file} ) { if ($h{format} eq 'storable') { my $result1 = nstore \%state, $file; # old method } elsif ($h{format} eq 'perl'){ $file .= '.pl' unless $file =~ /\.pl$/; #my $pl = dump \%state; #write_file($file, $pl); } elsif ($h{format} eq 'yaml'){ $file .= '.yml' unless $file =~ /\.yml$/; #find_cycle(\%state); my $yaml = yaml_out(\%state); write_file($file, $yaml); $debug and print $yaml; } } else { yaml_out(\%state) } } sub yaml_out { $debug2 and carp "&yaml_out"; my ($data_ref) = shift; my $type = ref $data_ref; $debug and print "data ref type: $type\n "; carp "can't yaml-out a Scalar!!\n" if ref $data_ref eq 'SCALAR'; croak "attempting to code wrong data type: $type" if $type !~ /HASH|ARRAY/; my $output; #$debug and print join $/, keys %$data_ref, $/; $debug and print "about to write YAML as string\n"; my $y = YAML::Tiny->new; $y->[0] = $data_ref; my $yaml = $y->write_string() . "...\n"; } sub yaml_in { # $debug2 and print "&yaml_in\n"; my $input = shift; my $yaml = $input =~ /\n/ # check whether file or text ? $input # yaml text : read_file($input); # file name if ($yaml =~ /\t/){ croak "YAML file: $input contains illegal TAB character."; } $yaml =~ s/^\n+// ; # remove leading newline at start of file $yaml =~ s/\n*$/\n/; # make sure file ends with newline my $y = YAML::Tiny->read_string($yaml); print "YAML::Tiny read error: $YAML::Tiny::errstr\n" if $YAML::Tiny::errstr; $y->[0]; } ## support functions sub create_dir { my @dirs = @_; map{ my $dir = $_; $debug and print "creating [ $dir ]\n"; -e $dir #and (carp "create_dir: '$dir' already exists, skipping...\n") or system qq( mkdir -p $dir) } @dirs; } sub join_path { my @parts = @_; my $path = join '/', @parts; $path =~ s(/{2,})(/)g; #$debug and print "path: $path\n"; $path; } sub wav_off { my $wav = shift; $wav =~ s/\.wav\s*$//i; $wav; } sub strip_all{ strip_trailing_spaces(strip_blank_lines( strip_comments(@_))) } sub strip_trailing_spaces { map {s/\s+$//} @_; @_; } sub strip_blank_lines { map{ s/\n(\s*\n)+/\n/sg } @_; map{ s/^\n+//s } @_; @_; } sub strip_comments { # map{ s/#.*$//mg; } @_; map{ s/\s+$//mg; } @_; @_ } sub remove_spaces { my $entry = shift; # remove leading and trailing spaces $entry =~ s/^\s*//; $entry =~ s/\s*$//; # convert other spaces to underscores $entry =~ s/\s+/_/g; $entry; } sub resolve_path { my $path = shift; $path = expand_tilde($path); $path = File::Spec::Link->resolve_all($path); } sub expand_tilde { my $path = shift; my $home = File::HomeDir->my_home; # ~bob -> /home/bob $path =~ s( ^ # beginning of line ~ # tilde (\w+) # username ) (File::HomeDir->users_home($1))ex; # ~/something -> /home/bob/something $path =~ s( ^ # beginning of line ~ # tilde / # slash ) ($home/)x; $path } sub quote_yaml_scalars { my $yaml = shift; my @modified; map { chomp; if( /^(?(\s*\w+: )|(\s+- ))(?.+)$/ ){ my($beg,$end) = ($+{beg}, $+{end}); # quote if contains colon and not quoted if ($end =~ /:\s/ and $end !~ /^('|")/ ){ $end =~ s(')(\\')g; # escape existing single quotes $end = qq('$end') } # single-quote string push @modified, "$beg$end\n"; } else { push @modified, "$_\n" } } split "\n", $yaml; join "", @modified; } 1;Audio-Nama-1.078/lib/Audio/Nama/Memoize_subs.pm0000644000175000017500000000166711623337667020214 0ustar jrothjroth# ------ Memoize subroutines ------ package Audio::Nama; use Modern::Perl; our ( $memoize ); BEGIN { # OPTMIZATION my @wav_functions = qw( get_versions candidates targets versions last ); my @track_functions = qw( dir basename full_path group_last last current_wav current_version monitor_version maybe_monitor rec_status region_start_time region_end_time playat_time fancy_ops input_path ); sub track_memoize { # before generate_setup return unless $memoize; map{package Audio::Nama::Track; memoize($_) } @track_functions; } sub track_unmemoize { # after generate_setup return unless $memoize; map{package Audio::Nama::Track; unmemoize ($_)} @track_functions; } sub rememoize { return unless $memoize; map{package Audio::Nama::Wav; unmemoize ($_); memoize($_) } @wav_functions; } sub init_memoize { return unless $memoize; map{package Audio::Nama::Wav; memoize($_) } @wav_functions; } } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Realtime_subs.pm0000644000175000017500000001071511623337670020335 0ustar jrothjroth# ------------- Realtime control routines ----------- ## loading and running the Ecasound engine package Audio::Nama; use Modern::Perl; use Carp; no warnings 'uninitialized'; use Audio::Nama::Util qw(process_is_running); our ( $debug, $debug2, $ui, $length, $old_bg, %event_id, $loop_enable, $run_time, $chain_setup_file, ); sub valid_engine_setup { eval_iam("cs-selected") and eval_iam("cs-is-valid"); } sub engine_running { eval_iam("engine-status") eq "running" }; sub mixing_only { my $i; my $am_mixing; for (Audio::Nama::ChainSetup::really_recording()){ $i++; $am_mixing++ if /Mixdown/; } $i == 1 and $am_mixing } sub start_transport { my $quiet = shift; # set up looping event if needed # mute unless recording # start # wait 0.5s # unmute # start heartbeat # report engine status # sleep 1s $debug2 and print "&start_transport\n"; say("\nCannot start. Engine is not configured.\n"),return unless eval_iam("cs-connected"); say "\n\nStarting at ", current_position() unless $quiet; schedule_wraparound(); mute(); eval_iam('start'); limit_processing_time($run_time) if mixing_only() or edit_mode() or defined $run_time; # TODO and live processing #$event_id{post_start_unmute} = AE::timer(0.5, 0, sub{unmute()}); sleeper(0.5); unmute(); sleeper(0.5); $ui->set_engine_mode_color_display(); start_heartbeat(); engine_status() unless $quiet; } sub stop_transport { my $quiet = shift; $debug2 and print "&stop_transport\n"; mute(); my $pos = eval_iam('getpos'); eval_iam('stop'); disable_length_timer(); if ( ! $quiet ){ sleeper(0.5); engine_status(current_position(),2,0); } unmute(); stop_heartbeat(); $ui->project_label_configure(-background => $old_bg); eval_iam("setpos $pos"); } sub transport_running { eval_iam('engine-status') eq 'running' } sub disconnect_transport { return if transport_running(); teardown_engine(); } sub engine_is { my $pos = shift; "Engine is ". eval_iam("engine-status"). ( $pos ? " at $pos" : "" ) } sub engine_status { my ($pos, $before_newlines, $after_newlines) = @_; say "\n" x $before_newlines, engine_is($pos), "\n" x $after_newlines; } sub current_position { colonize(int eval_iam("getpos")) } sub start_heartbeat { $event_id{poll_engine} = AE::timer(0, 1, \&Audio::Nama::heartbeat); } sub stop_heartbeat { $event_id{poll_engine} = undef; $ui->reset_engine_mode_color_display(); rec_cleanup() } sub heartbeat { # print "heartbeat fired\n"; my $here = eval_iam("getpos"); my $status = eval_iam('engine-status'); if( $status =~ /finished|error/ ){ engine_status(current_position(),2,1); revise_prompt(); stop_heartbeat(); sleeper(0.2); eval_iam('setpos 0'); } #if $status =~ /finished|error|stopped/; #print join " ", $status, colonize($here), $/; my ($start, $end); $start = Audio::Nama::Mark::loop_start(); $end = Audio::Nama::Mark::loop_end(); schedule_wraparound() if $loop_enable and defined $start and defined $end and ! Audio::Nama::ChainSetup::really_recording(); update_clock_display(); } sub update_clock_display { $ui->clock_config(-text => current_position()); } sub schedule_wraparound { return unless $loop_enable; my $here = eval_iam("getpos"); my $start = Audio::Nama::Mark::loop_start(); my $end = Audio::Nama::Mark::loop_end(); my $diff = $end - $here; $debug and print "here: $here, start: $start, end: $end, diff: $diff\n"; if ( $diff < 0 ){ # go at once eval_iam("setpos ".$start); cancel_wraparound(); } elsif ( $diff < 3 ) { #schedule the move wraparound($diff, $start); } } sub cancel_wraparound { $event_id{wraparound} = undef; } sub limit_processing_time { my $length = shift // $length; $event_id{processing_time} = AE::timer($length, 0, sub { Audio::Nama::stop_transport(); print prompt() }); } sub disable_length_timer { $event_id{processing_time} = undef; undef $run_time; } sub wraparound { package Audio::Nama; my ($diff, $start) = @_; #print "diff: $diff, start: $start\n"; $event_id{wraparound} = undef; $event_id{wraparound} = AE::timer($diff,0, sub{set_position($start)}); } sub ecasound_select_chain { my $n = shift; my $cmd = "c-select $n"; if( # specified chain exists in the chain setup Audio::Nama::ChainSetup::is_ecasound_chain($n) # engine is configured and eval_iam( 'cs-connected' ) =~ /$chain_setup_file/ ){ eval_iam($cmd); return 1 } else { $debug and carp "c-select $n: attempted to select non-existing Ecasound chain\n"; return 0 } } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/ChainSetup.pm0000644000175000017500000003537011623337667017614 0ustar jrothjroth# ---------- ChainSetup----------- # # variables in the main namespace we need to access package Audio::Nama; use Modern::Perl; use Carp; # these variables are globals that # are touched in creating chain setups our ( $debug, $debug2, $debug3, $preview, %tn, $main, $mastering_mode, $mix_to_disk_format, $ecasound_globals_default, $ecasound_globals_realtime, ); package Audio::Nama::ChainSetup; use Modern::Perl; no warnings 'uninitialized'; use Audio::Nama::Util qw(signal_format input_node output_node); use Audio::Nama::Assign qw(yaml_out); our ( $g, # routing graph object @io, # IO objects corresponding to chain setup %is_ecasound_chain, # chains in final chain seutp # for sorting final result %inputs, %outputs, %post_input, %pre_output, # for final result @input_chains, # list of input chain segments @output_chains, # list of output chain segments @post_input, # post-input chain operators @pre_output, # pre-output chain operators $chain_setup, # final result as string ); sub initialize { @io = (); # IO object list $g = Graph->new(); %inputs = %outputs = %post_input = %pre_output = (); %is_ecasound_chain = (); @input_chains = @output_chains = @post_input = @pre_output = (); undef $chain_setup; Audio::Nama::disable_length_timer(); reset_aux_chain_counter(); {no autodie; unlink Audio::Nama::setup_file()} $g; } sub ecasound_chain_setup { $chain_setup } sub is_ecasound_chain { $is_ecasound_chain{$_[0]} } sub engine_tracks { # tracks that belong to current chain setup map{$Audio::Nama::ti{$_}} grep{$Audio::Nama::ti{$_}} keys %is_ecasound_chain; } sub is_engine_track { # takes Track object, name or index # returns object if corresponding track belongs to current chain setup my $t = shift; my $n; given($t){ when( (ref $_) =~ /Track/){ $n = $_->n } when( ! /\D/ ) { $n = $_ } when( /\D/ and $tn{$_} ){ $n = $Audio::Nama::tn{$_}->n} } $Audio::Nama::ti{$n} if $is_ecasound_chain{$n} } sub engine_wav_out_tracks { grep{$_->rec_status eq 'REC' and ! $_->rec_defeat } engine_tracks(); } # return file output entries, including Mixdown sub really_recording { map{ /-o:(.+?\.wav)$/} grep{ /-o:/ and /\.wav$/} split "\n", $chain_setup } sub show_io { my $output = yaml_out( \%inputs ). yaml_out( \%outputs ); Audio::Nama::pager( $output ); } sub generate_setup_try { # TODO: move operations below to buses $debug2 and print "&generate_setup_try\n"; # in an ideal CS world, all of the following routing # routines (add_paths_for_*) would be accomplished by # the track or bus itself, rather than the Hand of God, as # appears below. # # On the other hand (or Hand!), one can't complain if # the Hand of God happens to be doing exactly the # right things. :-) my $automix = shift; # route Master to null_out if present add_paths_for_main_tracks(); $debug and say "The graph is:\n$g"; add_paths_for_recording(); $debug and say "The graph is:\n$g"; add_paths_for_aux_sends(); $debug and say "The graph is:\n$g"; map{ $_->apply($g) } grep{ (ref $_) =~ /Send|Sub/ } Audio::Nama::Bus::all(); $debug and say "The graph is:\n$g"; add_paths_from_Master(); # do they affect automix? $debug and say "The graph is:\n$g"; # re-route Master to null for automix if( $automix){ $g->delete_edges(map{@$_} $g->edges_from('Master')); $g->add_edge(qw[Master null_out]); $debug and say "The graph is:\n$g"; } add_paths_for_mixdown_handling(); $debug and say "The graph is:\n$g"; prune_graph(); $debug and say "The graph is:\n$g"; Audio::Nama::Graph::expand_graph($g); $debug and say "The expanded graph is:\n$g"; # insert handling Audio::Nama::Graph::add_inserts($g); $debug and say "The expanded graph with inserts is\n$g"; # create IO lists %inputs and %outputs if ( process_routing_graph() ){ write_chains(); 1 } else { say("No tracks to record or play."); 0 } } sub add_paths_for_main_tracks { $debug2 and say "&add_paths_for_main_tracks"; map{ # connect signal sources to tracks my @path = $_->input_path; #say "Main bus track input path: @path"; $g->add_path(@path) if @path; # connect tracks to Master $g->add_edge($_->name, 'Master'); } grep{ 1 unless $preview eq 'doodle' and $_->rec_status eq 'MON' } # exclude MON tracks in doodle mode grep{ $_->rec_status ne 'OFF' } # exclude OFF tracks map{$tn{$_}} # convert to Track objects $main->tracks; # list of Track names } sub add_paths_for_recording { $debug2 and say "&add_paths_for_recording"; return if $preview; # don't record during preview modes # get list of REC-status tracks to record my @tracks = grep{ (ref $_) !~ /Slave/ # don't record slave tracks and not $_->group =~ /null|Mixdown|Temp/ # nor these groups and not $_->rec_defeat # nor rec-defeat tracks and $_->rec_status eq 'REC' } Audio::Nama::Track::all(); map{ # Track input from a WAV, JACK client, or soundcard # # We record 'raw' signal, as per docs and design if( $_->source_type !~ /track|bus|loop/ ){ # create temporary track for rec_file chain # we do this because the path doesn't # include the original track. # # but why not supply the track as # an edge attribute, then the source # and output info can be provided # that way. # Later, we will rewrite it that way $debug and say "rec file link for $_->name"; my $name = $_->name . '_rec_file'; my $anon = Audio::Nama::SlaveTrack->new( target => $_->name, rw => 'OFF', group => 'Temp', name => $name); # connect IO $g->add_path(input_node($_->source_type), $name, 'wav_out'); # set chain_id to R3 (if original track is 3) $g->set_vertex_attributes($name, { chain_id => 'R'.$_->n, mono_to_stereo => '', # override }); } elsif ($_->source_type =~ /bus|track/) { # for tracks with identified (track|bus) input # cache_tracks/merge_edits has its own logic # therefore these connections (triggered from # generate_setup()) will not affect AFAIK # any other recording scenario # special case, record 'cooked' signal # generally a sub bus # - has 'rec_defeat' set (therefore doesn't reach here) # - receives a stereo input # - mix track width is set to stereo (default) my @edge = ($_->name, 'wav_out'); # cooked signal $g->add_path(@edge); # set chain_id to R3 (if original track is 3) $g->set_edge_attributes(@edge, { chain_id => 'R'.$_->n, }); # if this path is left unconnected, # i.e. track gets no input # it will be removed by prune_graph() # to record raw: # source_type: loop # source_id: loop,track_name_in # but for WAV to contain content, # we need to guarantee that track_name as # an input } } @tracks; } sub add_paths_for_aux_sends { $debug2 and say "&add_paths_for_aux_sends"; map { add_path_for_one_aux_send( $_ ) } grep { (ref $_) !~ /Slave/ and $_->group !~ /Mixdown|Master/ and $_->send_type and $_->rec_status ne 'OFF' } Audio::Nama::Track::all(); } sub add_path_for_one_aux_send { my $track = shift; my @e = ($track->name, output_node($track->send_type)); $g->add_edge(@e); $g->set_edge_attributes(@e, { track => $track->name, # force stereo output width width => 2, chain_id => 'S'.$track->n,}); } sub add_paths_from_Master { $debug2 and say "&add_paths_from_Master"; if ($mastering_mode){ $g->add_path(qw[Master Eq Low Boost]); $g->add_path(qw[Eq Mid Boost]); $g->add_path(qw[Eq High Boost]); } $g->add_path($mastering_mode ? 'Boost' : 'Master', output_node($tn{Master}->send_type)) if $tn{Master}->rw ne 'OFF' } sub add_paths_for_mixdown_handling { $debug2 and say "&add_paths_for_mixdown_handling"; if ($tn{Mixdown}->rec_status eq 'REC'){ my @p = (($mastering_mode ? 'Boost' : 'Master'), ,'Mixdown', 'wav_out'); $g->add_path(@p); $g->set_vertex_attributes('Mixdown', { format => signal_format($mix_to_disk_format,$tn{Mixdown}->width), chain_id => "Mixdown" }, ); # no effects will be applied because effects are on chain 2 # Mixdown handling - playback } elsif ($tn{Mixdown}->rec_status eq 'MON'){ my @e = qw(wav_in Mixdown soundcard_out); $g->add_path(@e); $g->set_vertex_attributes('Mixdown', { send_type => $tn{Master}->send_type, send_id => $tn{Master}->send_id, chain => "Mixdown" }); # no effects will be applied because effects are on chain 2 } } sub prune_graph { $debug2 and say "&prune_graph"; # prune graph: remove tracks lacking inputs or outputs Audio::Nama::Graph::remove_out_of_bounds_tracks($g) if Audio::Nama::edit_mode(); Audio::Nama::Graph::recursively_remove_inputless_tracks($g); Audio::Nama::Graph::recursively_remove_outputless_tracks($g); } # new object based dispatch from routing graph sub process_routing_graph { $debug2 and say "&process_routing_graph"; @io = map{ dispatch($_) } $g->edges; $debug and map $_->dumpp, @io; map{ $inputs{$_->ecs_string} //= []; push @{$inputs{$_->ecs_string}}, $_->chain_id; $post_input{$_->chain_id} = $_->ecs_extra if $_->ecs_extra; } grep { $_->direction eq 'input' } @io; map{ $outputs{$_->ecs_string} //= []; push @{$outputs{$_->ecs_string}}, $_->chain_id; $pre_output{$_->chain_id} = $_->ecs_extra if $_->ecs_extra; } grep { $_->direction eq 'output' } @io; no warnings 'numeric'; my @in_keys = values %inputs; my @out_keys = values %outputs; use warnings 'numeric'; %is_ecasound_chain = map{ $_, 1} map{ @$_ } values %inputs; # sort entries into an aesthetic order my %rinputs = reverse %inputs; my %routputs = reverse %outputs; @input_chains = sort map {'-a:'.join(',',sort by_chain @$_)." $rinputs{$_}"} @in_keys; @output_chains = sort map {'-a:'.join(',',sort by_chain @$_)." $routputs{$_}"} @out_keys; @post_input = sort by_index map{ "-a:$_ $post_input{$_}"} keys %post_input; @pre_output = sort by_index map{ "-a:$_ $pre_output{$_}"} keys %pre_output; @input_chains + @output_chains # to sense empty chain setup } { my ($m,$n,$o,$p,$q,$r); sub by_chain { ($m,$n,$o) = $a =~ /(\D*)(\d+)(\D*)/ ; ($p,$q,$r) = $b =~ /(\D*)(\d+)(\D*)/ ; if ($n != $q){ $n <=> $q } elsif ( $m ne $p){ $m cmp $p } else { $o cmp $r } } } sub by_index { my ($i) = $a =~ /(\d+)/; my ($j) = $b =~ /(\d+)/; $i <=> $j } sub non_track_dispatch { # loop -> loop # # assign chain_id to edge based on chain_id of left-side loop's # corresponding track: # # hihat_out -- J7a -> Master_in # # soundcard_in -> wav_out (rec_file) # # currently handled using an anonymous track # # we expect edge attributes # to have been provided for handling this. # loop -> soundcard_out # # track7-soundcard_out as aux_send will have chain id S7 # that will be transferred by expand_graph() to # the new edge, loop-soundcard-out # we will issue two IO objects, one for the chain input # fragment, one for the chain output my $edge = shift; $debug and say "non-track dispatch: ",join ' -> ',@$edge; my $eattr = $g->get_edge_attributes(@$edge) // {}; $debug and say "found edge attributes: ",yaml_out($eattr) if $eattr; my $vattr = $g->get_vertex_attributes($edge->[0]) // {}; $debug and say "found vertex attributes: ",yaml_out($vattr) if $vattr; if ( ! $eattr->{chain_id} and ! $vattr->{chain_id} ){ my $n = $eattr->{n} || $vattr->{n}; $eattr->{chain_id} = jumper_count($n); } my @direction = qw(input output); map{ my $direction = shift @direction; my $class = Audio::Nama::IO::get_class($_, $direction); my $attrib = {%$vattr, %$eattr}; $attrib->{endpoint} //= $_ if Audio::Nama::Graph::is_a_loop($_); $debug and say "non-track: $_, class: $class, chain_id: $attrib->{chain_id},", "device_id: $attrib->{device_id}"; $class->new($attrib ? %$attrib : () ) } @$edge; # we'd like to $class->new(override($edge->[0], $edge)) } @$edge; } { ### counter for jumper chains # # sequence: J1 J1a J1b J1c, J2, J3, J4, J4d, J4e my %used; my $counter; my $prefix = 'J'; reset_aux_chain_counter(); sub reset_aux_chain_counter { %used = (); $counter = 'a'; } sub jumper_count { my $track_index = shift; my $try1 = $prefix . $track_index; $used{$try1}++, return $try1 unless $used{$try1}; $try1 . $counter++; } } sub dispatch { # creates an IO object from a graph edge my $edge = shift; return non_track_dispatch($edge) if not grep{ $tn{$_} } @$edge ; $debug and say 'dispatch: ',join ' -> ', @$edge; my($name, $endpoint, $direction) = decode_edge($edge); $debug and say "name: $name, endpoint: $endpoint, direction: $direction"; my $track = $tn{$name}; my $class = Audio::Nama::IO::get_class( $endpoint, $direction ); # we need the $direction because there can be # edges to and from loop,Master_in my @args = (track => $name, endpoint => $endpoint, # for loops chain_id => $tn{$name}->n, # default override($name, $edge)); # priority: edge > node #say "dispatch class: $class"; $class->new(@args); } sub decode_edge { # assume track-endpoint or endpoint-track # return track, endpoint my ($a, $b) = @{$_[0]}; #say "a: $a, b: $b"; my ($name, $endpoint) = $tn{$a} ? @{$_[0]} : reverse @{$_[0]} ; my $direction = $tn{$a} ? 'output' : 'input'; ($name, $endpoint, $direction) } sub override { # data from edges has priority over data from vertexes # we specify $name, because it could be left or right # vertex $debug2 and say "&override"; my ($name, $edge) = @_; (override_from_vertex($name), override_from_edge($edge)) } sub override_from_vertex { my $name = shift; warn("undefined graph\n"), return () unless (ref $g) =~ /Graph/; my $attr = $g->get_vertex_attributes($name); $attr ? %$attr : (); } sub override_from_edge { my $edge = shift; warn("undefined graph\n"), return () unless (ref $g) =~ /Graph/; my $attr = $g->get_edge_attributes(@$edge); $attr ? %$attr : (); } sub write_chains { $debug2 and print "&write_chains\n"; ## write general options my $globals = $ecasound_globals_default; # use realtime globals if they exist and we are # recording to a non-mixdown file $globals = $ecasound_globals_realtime if $ecasound_globals_realtime and grep{ ! /Mixdown/} really_recording(); # we assume there exists latency-sensitive monitor output # when recording my $ecs_file = join "\n\n", "# ecasound chainsetup file", "# general", $globals, "# audio inputs", join("\n", @input_chains), ""; $ecs_file .= join "\n\n", "# post-input processing", join("\n", @post_input), "" if @post_input; $ecs_file .= join "\n\n", "# pre-output processing", join("\n", @pre_output), "" if @pre_output; $ecs_file .= join "\n\n", "# audio outputs", join("\n", @output_chains), ""; $debug and print "ECS:\n",$ecs_file; open my $fh, ">", Audio::Nama::setup_file(); print $fh $ecs_file; close $fh; $chain_setup = $ecs_file; } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Option_subs.pm0000644000175000017500000000465211623337667020054 0ustar jrothjroth# --------- Command line options ---------- package Audio::Nama; use Modern::Perl; our (%opts); sub process_options { my %options = qw( save-alsa a project-root=s d use-pwd p create-project c config=s f gui g text t no-state M net-eci n libecasoundc l help h regenerate-effects-cache r no-static-effects-data S no-static-effects-cache C no-reconfigure-engine R fake-jack J fake-alsa A fake-ecasound E debugging-output D execute-command=s X no-terminal T no-fade-on-transport-start F ); map{$opts{$_} = ''} values %options; # long options Getopt::Long::Configure ("bundling"); my $getopts = 'GetOptions( '; map{ $getopts .= qq("$options{$_}|$_" => \\\$opts{$options{$_}}, \n)} keys %options; $getopts .= ' )' ; #say $getopts; eval $getopts or die "Stopped.\n"; if ($opts{h}){ say <set_track_class() method re-blesses # the object to a different subclass when necessary # changing the 'class' field as well as the object # class affiliation # # the ->hashref() method (in Object.p) # used to serialize will # sync the class field to the current object # class, hopefully saving a painful error use Modern::Perl; use Carp qw(carp cluck croak); use File::Copy qw(copy); use File::Slurp; use Memoize qw(memoize unmemoize); no warnings qw(uninitialized redefine); our $VERSION = 1.0; our ($debug); local $debug = 0; use Audio::Nama::Assign qw(join_path); use Audio::Nama::Util qw(freq input_node dest_type); use vars qw($n %by_name @by_index %track_names %by_index); our @ISA = 'Audio::Nama::Wav'; use Audio::Nama::Object qw( class was_class n name group rw version width ops vol pan fader latency offset old_vol_level old_pan_level playat region_start region_end modifiers looping hide source_id source_type send_id send_type target project rec_defeat effect_chain_stack cache_map comment version_comment current_edit ); # Note that ->vol return the effect_id # ->old_volume_level is the level saved before muting # ->old_pan_level is the level saved before pan full right/left # commands initialize(); ### class subroutines sub initialize { $n = 0; # incrementing numeric key %by_index = (); # return ref to Track by numeric key %by_name = (); # return ref to Track by name %track_names = (); } sub idx { # return first free track index my $n = 0; while (++$n){ return $n if not $by_index{$n} } } sub all { sort{$a->n <=> $b->n } values %by_name } { my %system_track = map{ $_, 1} qw( Master Mixdown Eq Low Mid High Boost ); sub user { grep{ ! $system_track{$_} } map{$_->name} all(); } sub is_user_track { ! $system_track{$_[0]->name} } sub is_system_track { $system_track{$_[0]->name} } } sub new { # returns a reference to an object # # tracks are indexed by: # (1) name and # (2) by an assigned index that is used as chain_id # the index may be supplied as a parameter # # my $class = shift; my %vals = @_; my @undeclared = grep{ ! $_is_field{$_} } keys %vals; croak "undeclared field: @undeclared" if @undeclared; # silently return if track already exists return if $by_name{$vals{name}}; my $n = $vals{n} || idx(); my $object = bless { ## defaults ## class => $class, name => "Audio_$n", group => 'Main', # rw => 'REC', # Audio::Nama::add_track() sets REC if necessary n => $n, ops => [], width => 1, vol => undef, pan => undef, modifiers => q(), # start, reverse, audioloop, playat looping => undef, # do we repeat our sound sample source_type => q(soundcard), source_id => 1, send_type => undef, send_id => undef, effect_chain_stack => [], cache_map => {}, current_edit => {}, version_comment => {}, @_ }, $class; #print "object class: $class, object type: ", ref $object, $/; $track_names{$vals{name}}++; #print "names used: ", Audio::Nama::yaml_out( \%track_names ); $by_index{$n} = $object; $by_name{ $object->name } = $object; #Audio::Nama::add_latency_compensation($n); Audio::Nama::add_pan_control($n); Audio::Nama::add_volume_control($n); #my $group = $Audio::Nama::bn{ $object->group }; # create group if necessary #defined $group or $group = Audio::Nama::Group->new( name => $object->group ); #my @existing = $group->tracks ; #$group->set( tracks => [ @existing, $object->name ]); $Audio::Nama::this_track = $object; $object; } ### object methods # TODO these conditional clauses should be separated # into classes sub dir { my $self = shift; $self->project ? join_path(Audio::Nama::project_root(), $self->project, '.wav') : Audio::Nama::this_wav_dir(); } # look at "ancestors" of track to get basename # overrides default Object::Tiny accessor (returning $self->{target}) sub target { my $self = shift; my $parent = $Audio::Nama::tn{$self->{target}}; defined $parent && $parent->target || $self->{target}; } sub basename { my $self = shift; $self->target || $self->name } sub full_path { my $track = shift; join_path($track->dir, $track->current_wav) } sub group_last { my $track = shift; my $group = $Audio::Nama::bn{$track->group}; #print join " ", 'searching tracks:', $group->tracks, $/; $group->last; } sub last { $_[0]->versions->[-1] || 0 } sub current_wav { my $track = shift; my $last = $track->current_version; #print "last found is $last\n"; if ($track->rec_status eq 'REC'){ $track->name . '_' . $last . '.wav' } elsif ( $track->rec_status eq 'MON'){ my $filename = $track->targets->{ $track->monitor_version } ; $filename } else { $debug and print "track ", $track->name, ": no current version\n" ; undef; } } sub current_version { my $track = shift; my $last = $Audio::Nama::use_group_numbering ? Audio::Nama::Bus::overall_last() : $track->last; my $status = $track->rec_status; #$debug and print "last: $last status: $status\n"; if ($status eq 'REC' and ! $track->rec_defeat){ return ++$last} elsif ( $status eq 'MON'){ return $track->monitor_version } else { return 0 } } sub monitor_version { my $track = shift; my $group = $Audio::Nama::bn{$track->group}; return $track->version if $track->version and grep {$track->version == $_ } @{$track->versions} ; return $group->version if $group->version and grep {$group->version == $_ } @{$track->versions}; return undef if $group->version; $track->last; } sub maybe_monitor { # ordinary sub, not object method my $monitor_version = shift; return 'MON' if $monitor_version and ! ($Audio::Nama::preview eq 'doodle'); return 'OFF'; } sub rec_status { # $Audio::Nama::debug2 and print "&rec_status\n"; my $track = shift; my $bug = shift; local $debug; $debug //= $bug; #my $source_id = $track->source_id; my $monitor_version = $track->monitor_version; my $group = $Audio::Nama::bn{$track->group}; #$debug and say join " ", "bus:",$group->name, $group->rw; $debug and print "track: ", $track->name, ", source: ", $track->source_id, ", monitor version: $monitor_version\n"; # first, check for conditions resulting in status 'OFF' if ( $group->rw eq 'OFF' or $track->rw eq 'OFF' or $Audio::Nama::preview eq 'doodle' and $track->rw eq 'REC' and $Audio::Nama::duplicate_inputs{$track->name} ){ return 'OFF' } # having reached here, we know $group->rw and $track->rw are REC or MON # so the result will be REC or MON if conditions are met # second, set REC status if possible # we allow a mix track to be REC, even if the # bus it belongs to is set to MON # for null tracks elsif ( $track->rw eq 'REC' and ($group->rw eq 'REC' or $Audio::Nama::bn{$track->name} and $track->rec_defeat) ){ given( $track->source_type){ when('jack_client'){ Audio::Nama::jack_client($track->source_id,'output') ? return 'REC' : return maybe_monitor($monitor_version) } when('jack_manual') { return 'REC' } when('jack_ports_list') { return 'REC' } when('null') { return 'REC' } when('soundcard') { return 'REC' } when('bus') { return 'REC' } # maybe $track->rw ?? default { return 'OFF' } #default { croak $track->name. ": missing source type" } # fall back to MON #default { maybe_monitor($monitor_version) } } } # third, set MON status if possible else { maybe_monitor($monitor_version) } } sub rec_status_display { my $track = shift; my $status = $track->rec_status; ($track->rw eq 'REC' and $track->rec_defeat) ? "($status)" : $status; } # these settings will only affect WAV playback sub region_start_time { my $track = shift; #return if $track->rec_status ne 'MON'; carp $track->name, ": expected MON status" if $track->rec_status ne 'MON'; Audio::Nama::Mark::unadjusted_mark_time( $track->region_start ) } sub region_end_time { my $track = shift; #return if $track->rec_status ne 'MON'; carp $track->name, ": expected MON status" if $track->rec_status ne 'MON'; if ( $track->region_end eq 'END' ){ return $track->wav_length; } else { Audio::Nama::Mark::unadjusted_mark_time( $track->region_end ) } } sub playat_time { my $track = shift; carp $track->name, ": expected MON status" if $track->rec_status ne 'MON'; #return if $track->rec_status ne 'MON'; Audio::Nama::Mark::unadjusted_mark_time( $track->playat ) } # the following methods adjust # region start and playat values during edit mode sub adjusted_region_start_time { my $track = shift; return $track->region_start_time unless $Audio::Nama::offset_run_flag; Audio::Nama::set_edit_vars($track); Audio::Nama::new_region_start(); } sub adjusted_playat_time { my $track = shift; return $track->playat_time unless $Audio::Nama::offset_run_flag; Audio::Nama::set_edit_vars($track); Audio::Nama::new_playat(); } sub adjusted_region_end_time { my $track = shift; return $track->region_end_time unless $Audio::Nama::offset_run_flag; Audio::Nama::set_edit_vars($track); Audio::Nama::new_region_end(); } sub region_is_out_of_bounds { return unless $Audio::Nama::offset_run_flag; my $track = shift; Audio::Nama::set_edit_vars($track); Audio::Nama::case() =~ /out_of_bounds/ } sub fancy_ops { # returns list my $track = shift; grep{ $_ ne $track->vol and $_ ne $track->pan and (! $track->fader or $_ ne $track->fader) } @{ $track->ops } } sub snapshot { my $track = shift; my $fields = shift; my %snap; my $i = 0; for(@$fields){ $snap{$_} = $track->$_; #say "key: $_, val: ",$track->$_; } \%snap; } # for graph-style routing sub input_path { # signal path, not file path my $track = shift; # create edge representing live sound source input if($track->rec_status eq 'REC'){ # we skip the source if the track is a 'mix track' # i.e. it gets input from other tracks, not # the specified source, if any. return () if $track->is_mix_track; # comment: individual tracks of a sub bus # connect their outputs to the mix track # (the $bus->apply method takes care of this) # # subtrack ---> mix_track # # later: # # subtrack --> mix_track_in --> mix_track ( input_node($track->source_type) , $track->name) } elsif($track->rec_status eq 'MON' and $Audio::Nama::preview ne 'doodle'){ # create edge representing WAV file input ('wav_in', $track->name) } } ### remove and destroy sub remove_effect_from_track { # doesn't touch %cops or %copp data structures my $track = shift; my @ids = @_; $track->set(ops => [ grep { my $existing = $_; ! grep { $existing eq $_ } @ids } @{$track->ops} ]); } sub has_insert { $_[0]->prefader_insert or $_[0]->postfader_insert } sub prefader_insert { Audio::Nama::Insert::get_id($_[0],'pre') } sub postfader_insert { Audio::Nama::Insert::get_id($_[0],'post') } # remove track object and all effects sub remove { my $track = shift; my $n = $track->n; $Audio::Nama::ui->remove_track_gui($n); $Audio::Nama::this_track = $Audio::Nama::ti{Audio::Nama::Track::idx() - 1}; # remove corresponding fades map{ $_->remove } grep { $_->track eq $track->name } values %Audio::Nama::Fade::by_index; # remove effects map{ Audio::Nama::remove_effect($_) } @{ $track->ops }; delete $by_index{$n}; delete $by_name{$track->name}; } ### object methods for text-based commands # Reasonable behavior whether 'source' and 'send' commands # are issued in JACK or ALSA mode. sub soundcard_channel { $_[0] // 1 } sub set_io { my ($track, $direction, $id) = @_; # $direction: send | source # unless we are dealing with a simple query, # by the end of this routine we are going to assign # the following fields using the values in the # $type and $id variables: # # source_type # source_id # # -OR- # # send_type # send_id my $type_field = $direction."_type"; my $id_field = $direction."_id"; # respond to a query (no argument) if ( ! $id ){ return $track->$type_field ? $track->$id_field : undef } # set values, returning new setting my $type = dest_type( $id ); given ($type){ # no data changes needed for some settings when('soundcard'){} when ('bus') {} #when('loop') {} # unused at present # rec_defeat tracks with 'null' input when ('null'){ $track->set(rec_defeat => 1); say $track->name, ": recording disabled by default for 'null' input."; say "Use 'rec_enable' if necessary"; } # don't allow user to set JACK I/O unless JACK server is running when ( /jack/ ){ say("JACK server not running! " ,"Cannot set JACK client or port as track source."), return unless $Audio::Nama::jack_running; continue; # don't break out of given/when chain } when ('jack_manual'){ my $port_name = $track->jack_manual_port($direction); say $track->name, ": JACK $direction port is $port_name. Make connections manually."; $id = 'manual'; $id = $port_name; $type = 'jack_manual'; } when ('jack_client'){ my $client_direction = $direction eq 'source' ? 'output' : 'input'; my $name = $track->name; my $width = scalar @{ Audio::Nama::jack_client($id, $client_direction) }; $width or say qq($name: $direction port for JACK client "$id" not found.); $width or return; $width ne $track->width and say $track->name, ": track set to ", Audio::Nama::width($track->width), qq(, but JACK source "$id" is ), Audio::Nama::width($width), '.'; } when( 'jack_ports_list' ){ $id =~ /(\w+)\.ports/; my $ports_file_name = ($1 || $track->name) . '.ports'; $id = $ports_file_name; # warn if ports do not exist say($track->name, qq(: ports file "$id" not found in ),Audio::Nama::project_root(),". Skipping."), return unless -e join_path( Audio::Nama::project_root(), $id ); # check if ports file parses } } $track->set($type_field => $type); $track->set($id_field => $id); } sub source { # command for setting, showing track source my ($track, $id) = @_; $track->set_io( 'source', $id); } sub send { # command for setting, showing track source my ($track, $id) = @_; $track->set_io( 'send', $id); } sub set_source { # called from parser my $track = shift; my $source = shift; my $old_source = $track->input_object; $track->set_io('source',$source); my $new_source = $track->input_object; my $object = $new_source; if ( $old_source eq $new_source ){ print $track->name, ": input unchanged, $object\n"; } else { print $track->name, ": input set to $object\n"; # re-enable recording of null-source tracks say($track->name, ": record enabled"), $track->set(rec_defeat => 0) if $old_source eq 'null'; } } sub set_version { my ($track, $n) = @_; my $name = $track->name; if ($n == 0){ print "$name: following latest version\n"; $track->set(version => $n) } elsif ( grep{ $n == $_ } @{$track->versions} ){ print "$name: anchoring version $n\n"; $track->set(version => $n) } else { print "$name: version $n does not exist, skipping.\n" } } sub set_send { # wrapper my ($track, $output) = @_; my $old_send = $track->send; my $new_send = $track->send($output); my $object = $track->output_object; if ( $old_send eq $new_send ){ print $track->name, ": send unchanged, ", ( $object ? $object : 'off'), "\n"; } else { print $track->name, ": aux output ", ($object ? "to $object" : 'is off.'), "\n"; } } { my %object_to_text = ( soundcard => 'soundcard channel', jack_client => 'JACK client', jack_manual => 'JACK manual port', jack_port => 'JACK manual port', loop => 'loop device', jack_ports_list => "JACK ports list", bus => "bus", ); sub object_as_text { my ($track, $direction) = @_; # $direction: source | send my $type_field = $direction."_type"; my $id_field = $direction."_id"; my $text = $object_to_text{$track->$type_field}; $text .= ' '; $text .= $track->$id_field } } sub input_object { # for text display my $track = shift; $track->object_as_text('source'); } sub output_object { # text for user display my $track = shift; $track->object_as_text('send'); } sub source_status { my $track = shift; my $id = $track->source_id; return unless $id; $track->rec_status eq 'REC' ? $id : "[$id]" } sub set_rec { my $track = shift; if (my $t = $track->target){ my $msg = $track->name; $msg .= qq( is an alias to track "$t"); $msg .= q( in project ") . $track->project . q(") if $track->project; $msg .= qq(.\n); $msg .= "Can't set a track alias to REC.\n"; print $msg; return; } $track->set_rw('REC'); } sub set_mon { my $track = shift; $track->set_rw('MON'); } sub set_off { my $track = shift; $track->set_rw('OFF'); } sub is_mix_track { ref $_[0] =~ /MixTrack/ } =comment mix self bus brothers REC MON MON OFF OFF OFF member REC REC REC->MON MON OFF->MON REC/MON->OFF OFF -- -- =cut sub set_rw { my ($track, $setting) = @_; #my $already = $track->rw eq $setting ? " already" : ""; $track->set(rw => $setting); my $status = $track->rec_status(); say $track->name, " set to $setting", ($status ne $setting ? ", but current status is $status" : ""); } # Operations performed by track objects sub normalize { my $track = shift; if ($track->rec_status ne 'MON'){ print $track->name, ": You must set track to MON before normalizing, skipping.\n"; return; } # track version will exist if MON status my $cmd = 'ecanormalize '; $cmd .= $track->full_path; print "executing: $cmd\n"; system $cmd; } sub fixdc { my $track = shift; if ($track->rec_status ne 'MON'){ print $track->name, ": You must set track to MON before fixing dc level, skipping.\n"; return; } my $cmd = 'ecafixdc '; $cmd .= $track->full_path; print "executing: $cmd\n"; system $cmd; } sub wav_length { my $track = shift; Audio::Nama::wav_length($track->full_path) } sub wav_format{ my $track = shift; Audio::Nama::wav_format($track->full_path) } sub mute { package Audio::Nama; my $track = shift; my $nofade = shift; # do nothing if already muted return if defined $track->old_vol_level(); if ( $Audio::Nama::copp{$track->vol}[0] != $track->mute_level and $Audio::Nama::copp{$track->vol}[0] != $track->fade_out_level){ $track->set(old_vol_level => $Audio::Nama::copp{$track->vol}[0]); fadeout( $track->vol ) unless $nofade; } $track->set_vol($track->mute_level); } sub unmute { package Audio::Nama; my $track = shift; my $nofade = shift; # do nothing if we are not muted return if ! defined $track->old_vol_level; if ( $nofade ){ $track->set_vol($track->old_vol_level); } else { $track->set_vol($track->fade_out_level); fadein($track->vol, $track->old_vol_level); } $track->set(old_vol_level => undef); } sub mute_level { my $track = shift; $Audio::Nama::mute_level{$track->vol_type} } sub fade_out_level { my $track = shift; $Audio::Nama::fade_out_level{$track->vol_type} } sub set_vol { my $track = shift; my $val = shift; Audio::Nama::effect_update_copp_set($track->vol, 0, $val); } sub vol_type { my $track = shift; $Audio::Nama::cops{$track->vol}->{type} } sub import_audio { my $track = shift; my ($path, $frequency) = @_; $path = Audio::Nama::expand_tilde($path); #say "path: $path"; my $version = $track->last + 1; if ( ! -r $path ){ print "$path: non-existent or unreadable file. No action.\n"; return; } my ($depth,$width,$freq) = split ',', Audio::Nama::wav_format($path); say "format: ", Audio::Nama::wav_format($path); $frequency ||= $freq; if ( ! $frequency ){ say "Cannot detect sample rate of $path. Skipping."; say "Use 'import_audio ' if possible."; return } my $desired_frequency = freq( $Audio::Nama::raw_to_disk_format ); my $destination = join_path(Audio::Nama::this_wav_dir(),$track->name."_$version.wav"); #say "destination: $destination"; if ( $frequency == $desired_frequency and $path =~ /.wav$/i){ say "copying $path to $destination"; copy($path, $destination) or die "copy failed: $!"; } else { my $format = Audio::Nama::signal_format($Audio::Nama::raw_to_disk_format, $width); say "importing $path as $destination, converting to $format"; my $cmd = qq(ecasound -f:$format -i:resample-hq,$frequency,"$path" -o:$destination); #say $cmd; system($cmd) == 0 or say("Ecasound exited with error: ", $?>>8), return; } Audio::Nama::rememoize() if $Audio::Nama::opts{R}; # usually handled by reconfigure_engine() } sub port_name { $_[0]->target || $_[0]->name } sub jack_manual_port { my ($track, $direction) = @_; $track->port_name . ($direction =~ /source|input/ ? '_in' : '_out'); } sub bus_tree { # for solo function to work in sub buses my $track = shift; my $mix = $track->group; return if $mix eq 'Main'; ($mix, $Audio::Nama::tn{$mix}->bus_tree); } sub version_has_edits { my ($track) = @_; grep { $_->host_track eq $track->name and $_->host_version == $track->monitor_version } values %Audio::Nama::Edit::by_name; } #### UNUSED sub edits_enabled { my $track = shift; my $bus; $bus = $Audio::Nama::Bus::by_name{$track->name} and $bus->rw ne 'OFF' and $track->rec_status eq 'REC' and $track->rec_defeat and $track->is_mix_track } ##### sub set_track_class { my ($track, $class) = @_; bless $track, $class; $track->set(class => $class); } sub busify { # does not set an existing bus to REC or MON! my $track = shift; my $name = $track->name; # create the bus if needed # create or convert named track to mix track Audio::Nama::add_sub_bus($name) unless $track->is_system_track; } sub unbusify { my $track = shift; return unless $track->is_system_track; $track->set( rw => 'MON', rec_defeat => 0); $track->set_track_class($track->was_class // 'Audio::Nama::Track'); } sub adjusted_length { my $track = shift; my $length; if ($track->region_start){ $length = $track->adjusted_region_end_time - $track->adjusted_region_start_time } else { $length = $track->wav_length; } $length += $track->adjusted_playat_time; } sub version_comment { my ($track, $v) = @_; my $text = $track->{version_comment}{$v}{user}; $text .= " " if $text; my $system = $track->{version_comment}{$v}{system}; $text .= "* $system" if $system; "$v: $text\n" if $text; } # Modified from Object.p to save class sub hashref { my $self = shift; my $class = ref $self; bless $self, 'HASH'; # easy magic #print yaml_out $self; return; my %guts = %{ $self }; $guts{class} = $class; # make sure we save the correct class name #print join " ", %guts; return; #my @keys = keys %guts; #map{ $output->{$_} or $output->{$_} = '~' } @keys; bless $self, $class; # restore return \%guts; } } # subclasses { package Audio::Nama::SimpleTrack; # used for Master track use Modern::Perl; use Carp; no warnings qw(uninitialized redefine); our @ISA = 'Audio::Nama::Track'; sub rec_status { $_[0]->rw eq 'OFF' ? 'OFF' : 'MON' } sub rec_status_display { $_[0]->rec_status } } sub busify {} sub unbusify {} { package Audio::Nama::MasteringTrack; # used for mastering chains use Modern::Perl; no warnings qw(uninitialized redefine); our @ISA = 'Audio::Nama::SimpleTrack'; sub rec_status{ my $track = shift; $Audio::Nama::mastering_mode ? 'MON' : 'OFF'; } sub source_status {} sub group_last {0} sub version {0} } { package Audio::Nama::SlaveTrack; # for instrument monitor bus use Modern::Perl; no warnings qw(uninitialized redefine); our @ISA = 'Audio::Nama::Track'; sub width { $Audio::Nama::tn{$_[0]->target}->width } sub rec_status { $Audio::Nama::tn{$_[0]->target}->rec_status } sub full_path { $Audio::Nama::tn{$_[0]->target}->full_path} sub monitor_version { $Audio::Nama::tn{$_[0]->target}->monitor_version} sub source_type { $Audio::Nama::tn{$_[0]->target}->source_type} sub source_id { $Audio::Nama::tn{$_[0]->target}->source_id} sub source_status { $Audio::Nama::tn{$_[0]->target}->source_status } sub send_type { $Audio::Nama::tn{$_[0]->target}->send_type} sub send_id { $Audio::Nama::tn{$_[0]->target}->send_id} sub dir { $Audio::Nama::tn{$_[0]->target}->dir } } { package Audio::Nama::CacheRecTrack; # for graph generation our @ISA = qw(Audio::Nama::SlaveTrack); sub current_version { my $track = shift; my $target = $Audio::Nama::tn{$track->target}; $target->last + 1 # if ($target->rec_status eq 'MON' # or $target->rec_status eq 'REC' and $Audio::Nama::bn{$track->target}){ # } } sub current_wav { my $track = shift; $Audio::Nama::tn{$track->target}->name . '_' . $track->current_version . '.wav' } sub full_path { my $track = shift; Audio::Nama::join_path( $track->dir, $track->current_wav) } } { package Audio::Nama::MixDownTrack; our @ISA = qw(Audio::Nama::Track); sub current_version { my $track = shift; my $last = $track->last; my $status = $track->rec_status; #$debug and print "last: $last status: $status\n"; if ($status eq 'REC'){ return ++$last} elsif ( $status eq 'MON'){ return $track->monitor_version } else { return 0 } } sub rec_status { my $track = shift; return 'REC' if $track->rw eq 'REC'; Audio::Nama::Track::rec_status($track); } } { package Audio::Nama::EditTrack; use Carp qw(carp cluck); our @ISA = 'Audio::Nama::Track'; our $AUTOLOAD; sub AUTOLOAD { my $self = shift; local $debug = 1; $debug and print $self->name, ": args @_\n"; # get tail of method call my ($call) = $AUTOLOAD =~ /([^:]+)$/; $Audio::Nama::Edit::by_name{$self->name}->$call(@_); } sub DESTROY {} sub current_version { my $track = shift; my $last = $track->last; my $status = $track->rec_status; #$debug and print "last: $last status: $status\n"; if ($status eq 'REC' and ! $track->rec_defeat){ return ++$last} elsif ( $status eq 'MON'){ return $track->monitor_version } else { return 0 } } sub playat_time { $debug and cluck $_[0]->name . "->playat_time\n"; $_[0]->play_start_time } } { package Audio::Nama::VersionTrack; our @ISA ='Audio::Nama::Track'; sub set_version {} sub versions { [$_[0]->version] } } { package Audio::Nama::MixTrack; our @ISA ='Audio::Nama::Track'; # as a mix track, I have no sources of my own # when status is REC sub input_path { my $track = shift; return $track->rec_status eq 'MON' ? $track->SUPER::input_path() : () } } # ----------- Track_subs ------------- { package Audio::Nama; use Modern::Perl; our ( $debug, $debug2, $this_track, $ui, %tn, %ti, %bn, %effect_j, $ch_m, $ch_r, $track_name, $volume_control_operator, $preview, @mastering_track_names, ); # usual track sub add_track { $debug2 and print "&add_track\n"; #return if transport_running(); my ($name, @params) = @_; my %vals = (name => $name, @params); my $class = $vals{class} // 'Audio::Nama::Track'; $debug and print "name: $name, ch_r: $ch_r, ch_m: $ch_m\n"; say("$name: track name already in use. Skipping."), return if $Audio::Nama::Track::by_name{$name}; say("$name: reserved track name. Skipping"), return if grep $name eq $_, @mastering_track_names; my $track = $class->new(%vals); return if ! $track; $this_track = $track; $debug and print "ref new track: ", ref $track; $track->source($ch_r) if $ch_r; # $track->send($ch_m) if $ch_m; my $group = $bn{$track->group}; command_process('for mon; mon') if $preview and $group->rw eq 'MON'; $group->set(rw => 'REC') unless $track->target; # not if is alias # normal tracks default to 'REC' # track aliases default to 'MON' $track->set(rw => $track->target ? 'MON' : 'REC') ; $track_name = $ch_m = $ch_r = undef; set_current_bus(); $ui->track_gui($track->n); $debug and print "Added new track!\n", $track->dump; $track; } # create read-only track pointing at WAV files of specified # name in current project sub add_track_alias { my ($name, $track) = @_; my $target; if ( $tn{$track} ){ $target = $track } elsif ( $ti{$track} ){ $target = $ti{$track}->name } add_track( $name, target => $target ); } # create read-only track pointing at WAV files of specified # track name in a different project sub add_track_alias_project { my ($name, $track, $project) = @_; my $dir = join_path(project_root(), $project, '.wav'); if ( -d $dir ){ if ( glob "$dir/$track*.wav"){ print "Found target WAV files.\n"; my @params = (target => $track, project => $project); add_track( $name, @params ); } else { print "No WAV files found. Skipping.\n"; return; } } else { print("$project: project does not exist. Skipping.\n"); return; } } sub add_volume_control { my $n = shift; return unless need_vol_pan($ti{$n}->name, "vol"); my $vol_id = cop_add({ chain => $n, type => $volume_control_operator, cop_id => $ti{$n}->vol, # often undefined }); $ti{$n}->set(vol => $vol_id); # save the id for next time $vol_id; } sub add_pan_control { my $n = shift; return unless need_vol_pan($ti{$n}->name, "pan"); my $pan_id = cop_add({ chain => $n, type => 'epp', cop_id => $ti{$n}->pan, # often undefined }); $ti{$n}->set(pan => $pan_id); # save the id for next time $pan_id; } # not used at present. we are probably going to offset the playat value if # necessary sub add_latency_compensation { print('LADSPA L/C/R Delay effect not found. Unable to provide latency compensation. '), return unless $effect_j{lcrDelay}; my $n = shift; my $id = cop_add({ chain => $n, type => 'el:lcrDelay', cop_id => $ti{$n}->latency, # may be undef values => [ 0,0,0,50,0,0,0,0,0,50,1 ], # We will be adjusting the # the third parameter, center delay (index 2) }); $ti{$n}->set(latency => $id); # save the id for next time $id; } } # end package 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Jack_subs.pm0000644000175000017500000001210311623337667017442 0ustar jrothjroth# ------- Jack port connect routines ------- package Audio::Nama; use Modern::Perl; use File::Slurp; no warnings 'uninitialized'; our ( $debug, $jack_running, %jack, $jack_lsp, $use_jack_plumbing, %event_id, %opts, ); # general functions sub poll_jack { $event_id{poll_jack} = AE::timer(0,5,\&jack_update) } sub jack_update { # cache current JACK status return if engine_running(); if( $jack_running = process_is_running('jackd') ){ my $jack_lsp = qx(jack_lsp -Ap 2> /dev/null); %jack = %{jack_ports($jack_lsp)} } else { %jack = () } } sub jack_client { # returns array of ports if client and direction exist my ($name, $direction) = @_; $jack{$name}{$direction} // [] } sub jack_ports { my $j = shift || $jack_lsp; #say "jack_lsp: $j"; # convert to single lines $j =~ s/\n\s+/ /sg; # system:capture_1 alsa_pcm:capture_1 properties: output,physical,terminal, #fluidsynth:left properties: output, #fluidsynth:right properties: output, my %jack = (); map{ my ($direction) = /properties: (input|output)/; s/properties:.+//; my @port_aliases = / \s* # zero or more spaces ([^:]+:[^:]+?) # non-colon string, colon, non-greedy non-colon string (?=[-+.\w]+:|\s+$) # zero-width port name or spaces to end-of-string /gx; map { s/ $//; # remove trailing space push @{ $jack{ $_ }{ $direction } }, $_; my ($client, $port) = /(.+?):(.+)/; push @{ $jack{ $client }{ $direction } }, $_; } @port_aliases; } grep{ ! /^jack:/i } # skip spurious jackd diagnostic messages split "\n",$j; #print yaml_out \%jack; \%jack } # connect jack ports via jack.plumbing or jack_connect sub jack_plumbing_conf { join_path( $ENV{HOME} , '.jack.plumbing' ) } { my $fh; my $plumbing_tag = q(BEGIN NAMA CONNECTIONS LIST); my $plumbing_header = qq(;### $plumbing_tag ;## The following lines are automatically generated. ;## DO NOT place any connection data below this line!! ; ); sub initialize_jack_plumbing_conf { # remove nama lines return unless -f -r jack_plumbing_conf(); my $user_plumbing = read_file(jack_plumbing_conf()); # keep user data, deleting below tag $user_plumbing =~ s/;[# ]*$plumbing_tag.*//gs; write_file(jack_plumbing_conf(), $user_plumbing); } my $jack_plumbing_code = sub { my ($port1, $port2) = @_; my $debug++; my $config_line = qq{(connect $port1 $port2)}; say $fh $config_line; # $fh in lexical scope $debug and say $config_line; }; my $jack_connect_code = sub { my ($port1, $port2) = @_; my $debug++; my $cmd = qq(jack_connect $port1 $port2); $debug and say $cmd; system $cmd; }; sub connect_jack_ports_list { my @source_tracks = grep{ $_->source_type eq 'jack_ports_list' and $_->rec_status eq 'REC' } Audio::Nama::ChainSetup::engine_tracks(); my @send_tracks = grep{ $_->send_type eq 'jack_ports_list' } Audio::Nama::ChainSetup::engine_tracks(); # we need JACK return if ! $jack_running; # We need tracks to configure return if ! @source_tracks and ! @send_tracks; sleeper(0.3); # extra time for ecasound engine to register JACK ports if( $use_jack_plumbing ) { # write config file initialize_jack_plumbing_conf(); open $fh, ">>", jack_plumbing_conf(); print $fh $plumbing_header; make_connections($jack_plumbing_code, \@source_tracks, 'in' ); make_connections($jack_plumbing_code, \@send_tracks, 'out'); close $fh; # run jack.plumbing start_jack_plumbing(); sleeper(3); # time for jack.plumbing to launch and poll kill_jack_plumbing(); initialize_jack_plumbing_conf(); } else { make_connections($jack_connect_code, \@source_tracks, 'in' ); make_connections($jack_connect_code, \@send_tracks, 'out'); } } } sub quote { $_[0] =~ /^"/ ? $_[0] : qq("$_[0]")} sub make_connections { my ($code, $tracks, $direction) = @_; my $ports_list = $direction eq 'in' ? 'source_id' : 'send_id'; map{ my $track = $_; my $name = $track->name; my $ecasound_port = "ecasound:$name\_$direction\_"; my $file = join_path(project_root(), $track->$ports_list); say($track->name, ": JACK ports file $file not found. No sources connected."), return if ! -e -r $file; my $line_number = 0; my @lines = read_file($file); for my $external_port (@lines){ # $external_port is the source port name chomp $external_port; $debug and say "port file $file, line $line_number, port $external_port"; # setup shell command if(! $jack{$external_port}){ say $track->name, qq(: port "$external_port" not found. Skipping.); next } # ecasound port index my $index = $track->width == 1 ? 1 : $line_number % $track->width + 1; my @ports = map{quote($_)} $external_port, $ecasound_port.$index; $code->( $direction eq 'in' ? @ports : reverse @ports ); $line_number++; }; } @$tracks } sub kill_jack_plumbing { qx(killall jack.plumbing >/dev/null 2>&1) unless $opts{A} or $opts{J}; } sub start_jack_plumbing { if ( $use_jack_plumbing # not disabled in namarc and ! ($opts{J} or $opts{A}) # we are not testing ){ system('jack.plumbing >/dev/null 2>&1 &') } } 1; __END__ Audio-Nama-1.078/lib/Audio/Nama/Graph.pm0000644000175000017500000001657211623337667016615 0ustar jrothjrothpackage Audio::Nama::Graph; use Modern::Perl; use Carp; use Graph; use vars qw(%reserved $debug $debug2); # this dispatch table also identifies labels reserved # for signal sources and sinks. *reserved = \%Audio::Nama::IO::io_class; *debug = \$Audio::Nama::debug; *debug2 = \$Audio::Nama::debug2; { my %seen; sub expand_graph { my $g = shift; %seen = (); for ($g->edges){ my($a,$b) = @{$_}; $debug and say "$a-$b: processing..."; $debug and say "$a-$b: already seen" if $seen{"$a-$b"}; next if $seen{"$a-$b"}; # case 1: both nodes are tracks: default insertion logic if ( is_a_track($a) and is_a_track($b) ){ $debug and say "processing track-track edge: $a-$b"; add_loop($g,$a,$b) } # case 2: fan out from track: use near side loop elsif ( is_a_track($a) and $g->successors($a) > 1 ) { $debug and say "fan_out from track $a"; add_near_side_loop($g,$a,$b,out_loop($a));} # case 3: fan in to track: use far side loop elsif ( is_a_track($b) and $g->predecessors($b) > 1 ) { $debug and say "fan in to track $b"; add_far_side_loop($g,$a,$b,in_loop($b));} else { $debug and say "$a-$b: no action taken" } } } sub add_inserts { my $g = shift; map{ my $i = $Audio::Nama::tn{$_}->prefader_insert; $Audio::Nama::Insert::by_index{$i}->add_paths($g, $_) if $i; $i = $Audio::Nama::tn{$_}->postfader_insert; $Audio::Nama::Insert::by_index{$i}->add_paths($g, $_) if $i; } grep{ $Audio::Nama::tn{$_} } $g->vertices; } sub add_loop { my ($g,$a,$b) = @_; $debug and say "adding loop"; my $fan_out = $g->successors($a); $debug and say "$a: fan_out $fan_out"; my $fan_in = $g->predecessors($b); $debug and say "$b: fan_in $fan_in"; if ($fan_out > 1){ add_near_side_loop($g,$a,$b, out_loop($a)) } elsif ($fan_in > 1){ add_far_side_loop($g,$a,$b, in_loop($b)) } elsif ($fan_in == 1 and $fan_out == 1){ # we expect a single user track to feed to Master_in # as multiple user tracks do $b eq 'Master' ? add_far_side_loop($g,$a,$b,in_loop($b)) # otherwise default to near_side ( *_out ) loops : add_near_side_loop($g,$a,$b,out_loop($a)); } else {croak "unexpected fan"}; } sub add_near_side_loop { # a - b # a - c # a - d # # converts to # # a_out - b # a_out - c # a_out - d # a - a_out # we deal with all edges departing from $a, the left node. # I call it a-x below, but it is actually a-$_ where $_ # is an alias to each of the successor node. # # 1. start with a - x # # 2. delete a - x # # 3. add a - a_out # # 4. add a_out - x # # 5. Add a_out attributes for track name and # other info need to generate correct chain_ids # # 6. Copy any attributes of edge a - x to a_out - x. # # No multiedge handling needed because with our # current topology, we never have a track # with, for example, multiple edges to a soundcard. # # Send buses create new tracks to provide connections. # # I will be moving edges (along with their attributes) # but I cannot assign chain_id them because I have # no way of knowing which is the edge that will use # the track number and will therefore get the track effects my ($g, $a, $b, $loop) = @_; $debug and say "$a-$b: insert near side loop"; # we will insert loop _after_ processing successor # edges so $a-$loop will not be picked up # in successors list. # We will assign chain_ids to loop-to-loop edges # looking like J7a, J7b,... # # To make this possible, we store the following # information in the left vertex of # the edge: # # n: track index, j: alphabetical counter $g->set_vertex_attributes($loop,{ n => $Audio::Nama::tn{$a}->n, j => 'a', track => $Audio::Nama::tn{$a}->name}); map{ my $attr = $g->get_edge_attributes($a,$_); $debug and say "deleting edge: $a-$_"; $g->delete_edge($a,$_); $g->add_edge($loop, $_); $g->set_edge_attributes($loop,$_, $attr) if $attr; $seen{"$a-$_"}++; } $g->successors($a); $g->add_edge($a,$loop); } sub add_far_side_loop { my ($g, $a, $b, $loop) = @_; $debug and say "$a-$b: insert far side loop"; $g->set_vertex_attributes($loop,{ n => $Audio::Nama::tn{$a}->n, j => 'a', track => $Audio::Nama::tn{$a}->name}); map{ my $attr = $g->get_edge_attributes($_,$b); $debug and say "deleting edge: $_-$b"; $g->delete_edge($_,$b); $g->add_edge($_,$loop); $g->set_edge_attributes($_,$loop, $attr) if $attr; $seen{"$_-$b"}++; } $g->predecessors($b); $g->add_edge($loop,$b); } } sub in_loop{ "$_[0]_in" } sub out_loop{ "$_[0]_out" } sub is_a_track{ $Audio::Nama::tn{$_[0]} } # most reliable sub is_terminal { $reserved{$_[0]} } sub is_a_loop{ my $name = shift; return if $reserved{$name}; if (my($root, $suffix) = $name =~ /^(.+?)_(in|out|insert_p.+)$/){ return ($root, $suffix); } } sub is_a_jumper { ! is_terminal($_[0]) and ! is_a_track($_[0]) and ! is_a_loop($_[0]) } sub inputless_tracks { my $g = shift; (grep{ is_a_track($_) and $g->is_source_vertex($_) } $g->vertices) } sub remove_out_of_bounds_tracks { my $g = shift; my @names = $g->successors('wav_in'); # MON status tracks map{ remove_tracks($g, $_) } grep{ Audio::Nama::set_edit_vars($Audio::Nama::tn{$_}); Audio::Nama::edit_case() =~ /out_of_bounds/ } @names; } sub recursively_remove_inputless_tracks { my $g = shift; # make multiple passes if necessary while(my @i = inputless_tracks($g)){ remove_tracks($g, @i); } } sub outputless_tracks { my $g = shift; (grep{ is_a_track($_) and $g->is_sink_vertex($_) } $g->vertices) } sub recursively_remove_outputless_tracks { my $g = shift; while(my @i = outputless_tracks($g)){ remove_tracks($g, @i); } } sub remove_tracks { my ($g, @names) = @_; map{ $g->delete_edges(map{@$_} $g->edges_from($_)); $g->delete_edges(map{@$_} $g->edges_to($_)); $g->delete_vertex($_); } @names; } 1; __END__ The graphic routing system is complicated enough that some comment is warranted. The first step of routing is to create a graph that expresses the signal flow. soundcard_in -> sax -> Master -> soundcard_out If we are to record the input, we need: sax -> wav_out If we add an instrument monitor on a separate channel for the sax player, we need: sax -> soundcard_out Ecasound requires that we insert loop devices wherever the signals must fan out or fan in. soundcard_in -> sax -> sax_out -> Master -> soundcard_out sax_out -> wav_out sax_out -> soundcard_out Here 'sax_out' is a loop device. All routing functions follow these rules. We then process each edge to generate a line for the Ecasound chain setup file. Master -> soundcard_out is easy to process, because the track Master knows what it's outputs should be. The edge sax_out -> soundcard_out, an auxiliary send, needs to know its associated track, the chain_id (identifier for the Ecasound chain corresponding to this edge) and in the final step the soundcard channel number. We can provide this information as edge attributes. We also allow vertexes, for example a track or loop device, to carry data is well, for example to tell the dispatcher to override the chain_id of a temporary track. An Ecasound chain setup is a graph comprised of multiple signal processing chains, each of which consists of exactly one input and one output. The dispatch process transforms the graph edges into a group of IO objects, each with enough information to create the input or output fragment of a chain. Finally, these objects are processed into the Ecasound chain setup file. Audio-Nama-1.078/lib/Audio/Nama/Wavinfo_subs.pm0000644000175000017500000000302011623337670020173 0ustar jrothjroth# ------- WAV file info routines --------- package Audio::Nama; use Modern::Perl; our (%wav_info); ### WAV file length/format/modify_time are cached in %wav_info sub ecasound_get_info { # get information about an audio object my ($path, $command) = @_; $path = qq("$path"); teardown_engine(); eval_iam('cs-add gl'); eval_iam('c-add g'); eval_iam('ai-add ' . $path); eval_iam('ao-add null'); eval_iam('cs-connect'); eval_iam('ai-select '. $path); my $result = eval_iam($command); teardown_engine(); $result; } sub cache_wav_info { my @files = File::Find::Rule ->file() ->name( '*.wav' ) ->in( this_wav_dir() ); map{ get_wav_info($_) } @files; } sub get_wav_info { my $path = shift; #say "path: $path"; $wav_info{$path}{length} = get_length($path); $wav_info{$path}{format} = get_format($path); $wav_info{$path}{modify_time} = get_modify_time($path); } sub get_length { my $path = shift; my $length = ecasound_get_info($path, 'ai-get-length'); sprintf("%.4f", $length); } sub get_format { my $path = shift; ecasound_get_info($path, 'ai-get-format'); } sub get_modify_time { my $path = shift; my @stat = stat $path; $stat[9] } sub wav_length { my $path = shift; update_wav_cache($path); $wav_info{$path}{length} } sub wav_format { my $path = shift; update_wav_cache($path); $wav_info{$path}{format} } sub update_wav_cache { my $path = shift; return unless get_modify_time($path) != $wav_info{$path}{modify_time}; say qq(WAV file $path has changed! Updating cache.); get_wav_info($path) } 1; __END__ Audio-Nama-1.078/lib/Audio/Nama/Insert.pm0000644000175000017500000001621011623337667017005 0ustar jrothjroth{ package Audio::Nama::Insert; use Modern::Perl; use Carp; no warnings qw(uninitialized redefine); our $VERSION = 0.1; our ($debug); local $debug = 0; use vars qw(%by_index); use Audio::Nama::Object qw( insert_type n class send_type send_id return_type return_id wet_track dry_track tracks track wetness wet_vol dry_vol ); use Audio::Nama::Util qw(input_node output_node dest_type); # tracks: deprecated initialize(); sub initialize { %by_index = () } sub idx { # return first free index my $n = 0; while (++$n){ return $n if not $by_index{$n} } } sub wet_name { my $self = shift; # use the field if available for backward compatibility (pre 1.054) $self->{wet_name} || join('-', $self->track, $self->n, 'wet'); } sub dry_name { my $self = shift; # use the field if available for backward compatibility (pre 1.054) $self->{dry_name} || join('-', $self->track, $self->n, 'dry'); } sub new { my $class = shift; my %vals = @_; my @undeclared = grep{ ! $_is_field{$_} } keys %vals; croak "undeclared field: @undeclared" if @undeclared; $vals{n} ||= idx(); my $self = bless { class => $class, # for restore wetness => 100, %vals, }, $class; my $name = $vals{track}; my $wet = Audio::Nama::SlaveTrack->new( name => $self->wet_name, target => $name, group => 'Insert', rw => 'REC', hide => 1, ); my $dry = Audio::Nama::SlaveTrack->new( name => $self->dry_name, target => $name, group => 'Insert', hide => 1, rw => 'REC'); map{ Audio::Nama::remove_effect($_)} $wet->vol, $wet->pan, $dry->vol, $dry->pan; $self->{dry_vol} = Audio::Nama::Text::t_add_effect($dry, 'ea',[0]); $self->{wet_vol} = Audio::Nama::Text::t_add_effect($wet, 'ea',[100]); $by_index{$self->n} = $self; } # method name for track field holding insert sub type { (ref $_[0]) =~ /Pre/ ? 'prefader_insert' : 'postfader_insert' } sub remove { my $self = shift; $Audio::Nama::tn{ $self->wet_name }->remove; $Audio::Nama::tn{ $self->dry_name }->remove; delete $by_index{$self->n}; } # subroutine # sub add_insert { my ($type, $send_id, $return_id) = @_; # $type : prefader_insert | postfader_insert say "\n",$Audio::Nama::this_track->name , ": adding $type\n"; local $Audio::Nama::this_track = $Audio::Nama::this_track; # temporarily change my $t = $Audio::Nama::this_track; my $name = $t->name; # the input fields will be ignored, since the track will get input # via the loop device track_insert my $class = $type =~ /pre/ ? 'Audio::Nama::PreFaderInsert' : 'Audio::Nama::PostFaderInsert'; # remove an existing insert of specified type, if present $t->$type and $by_index{$t->$type}->remove; my $i = $class->new( track => $t->name, send_type => Audio::Nama::dest_type($send_id), send_id => $send_id, return_type => Audio::Nama::dest_type($return_id), return_id => $return_id, ); if (! $i->{return_id}){ $i->{return_type} = $i->{send_type}; $i->{return_id} = $i->{send_id} if $i->{return_type} eq 'jack_client'; $i->{return_id} = $i->{send_id} + 2 if $i->{return_type} eq 'soundcard'; } } sub get_id { # get Insert index for track # optionally specify whether we are looking for # prefader or postfader insert # my ($track, $prepost) = @_; my @inserts = grep{ $track->name eq $_->track} values %by_index; my ($prefader) = (map{$_->n} grep{$_->class =~ /pre/i} @inserts); my ($postfader) = (map{$_->n} grep{$_->class =~ /post/i} @inserts); my %id = ( pre => $prefader, post => $postfader); $prepost = $id{pre} ? 'pre' : 'post' if (! $prepost and ! $id{pre} != ! $id{post} ); $id{$prepost};; } } { package Audio::Nama::PostFaderInsert; use Modern::Perl; use Carp; our @ISA = qw(Audio::Nama::Insert); our $debug; use Audio::Nama::Util qw(input_node output_node dest_type); sub add_paths { # Since this routine will be called after expand_graph, # we can be sure that every track vertex will connect to # to a single edge, either loop or an output my ($self, $g, $name) = @_; no warnings qw(uninitialized); #my $debug = 1; $debug and say "add_insert for track: $name"; my $t = $Audio::Nama::tn{$name}; $debug and say "insert structure:", $self->dump; my ($successor) = $g->successors($name); # successor will be either a loop, device or JACK port # i.e. can accept multiple signals $g->delete_edge($name, $successor); my $loop = "$name\_insert_post"; my $wet = $Audio::Nama::tn{$self->wet_name}; my $dry = $Audio::Nama::tn{$self->dry_name}; $debug and say "found wet: ", $wet->name, " dry: ",$dry->name; # wet send path (no track): track -> loop -> output my @edge = ($loop, output_node($self->{send_type})); $debug and say "edge: @edge"; $g->add_path( $name, @edge); $g->set_vertex_attributes($loop, {n => $t->n}); $g->set_edge_attributes(@edge, { send_id => $self->{send_id}, width => 2, }); # wet return path: input -> wet_track (slave) -> successor # we override the input with the insert's return source $g->set_vertex_attributes($wet->name, { width => 2, # default for cooked mono_to_stereo => '', # override source_type => $self->{return_type}, source_id => $self->{return_id}, }); $g->add_path(input_node($self->{return_type}), $wet->name, $successor); # connect dry track to graph $g->add_path($loop, $dry->name, $successor); } } { package Audio::Nama::PreFaderInsert; use Modern::Perl; use Carp; our @ISA = qw(Audio::Nama::Insert); our $debug; use Audio::Nama::Util qw(input_node output_node dest_type); sub add_paths { # --- predecessor --+-- wet-send wet-return ---+-- insert_pre -- track # | | # +-------------- dry ----------+ my ($self, $g, $name) = @_; no warnings qw(uninitialized); #my $debug = 1; $debug and say "add_insert for track: $name"; my $t = $Audio::Nama::tn{$name}; $debug and say "insert structure:", $self->dump; my ($predecessor) = $g->predecessors($name); $g->delete_edge($predecessor, $name); my $loop = "$name\_insert_pre"; my $wet = $Audio::Nama::tn{$self->wet_name}; my $dry = $Audio::Nama::tn{$self->dry_name}; $debug and say "found wet: ", $wet->name, " dry: ",$dry->name; #pre: wet send path (no track): predecessor -> output my @edge = ($predecessor, output_node($self->{send_type})); $debug and say "edge: @edge"; $g->add_path(@edge); $g->set_edge_attributes(@edge, { send_id => $self->{send_id}, send_type => $self->{send_type}, mono_to_stereo => '', # override width => $t->width, track => $name, n => $t->n, }); #pre: wet return path: input -> wet_track (slave) -> loop # we override the input with the insert's return source $g->set_vertex_attributes($wet->name, { width => $t->width, mono_to_stereo => '', # override source_type => $self->{return_type}, source_id => $self->{return_id}, }); $g->set_vertex_attributes($dry->name, { mono_to_stereo => '', # override }); $g->add_path(input_node($self->{return_type}), $wet->name, $loop); # connect dry track to graph # # post: dry path: loop -> dry -> successor # pre: dry path: predecessor -> dry -> loop $g->add_path($predecessor, $dry->name, $loop, $name); } } 1;Audio-Nama-1.078/lib/Audio/Nama/Object.pm0000644000175000017500000000554411623337667016757 0ustar jrothjrothpackage Audio::Nama::Object; use Modern::Perl; use Carp; use Audio::Nama::Assign qw(yaml_out); no strict; # Enable during dev and testing BEGIN { require 5.004; $Audio::Nama::Object::VERSION = '1.04'; } sub import { return unless shift eq 'Audio::Nama::Object'; my $pkg = caller; my $child = !! @{"${pkg}::ISA"}; eval join '', "package $pkg;\n", ' use vars qw(%_is_field); ', ' map{ $_is_field{$_}++ } @_;', ($child ? () : "\@${pkg}::ISA = 'Audio::Nama::Object';\n"), map { defined and ! ref and /^[^\W\d]\w*$/s or die "Invalid accessor name '$_'"; "sub $_ { return \$_[0]->{$_} }\n" } @_; die "Failed to generate $pkg" if $@; return 1; } sub new { my $class = shift; bless { @_ }, $class; } sub is_legal_key { # The behavior I want here is: # # Example class hierachy: Audio::Nama::Object, Audio::Nama::Wav, Audio::Nama::Track, Audio::Nama::SimpleTrack # By inheriting from Track, SimpleTrack gets all the # attributes of Track and Wav, without having to include # them in the Track class definition my ($class, $key) = @_; $class = ref $class if ref $class; # support objects return 1 if ${"$class\::_is_field"}{$key}; my ($parent_class) = @{"$class\::ISA"}; return unless $parent_class and $parent_class !~ /Object::Tiny/; # this should be: # return unless $parent_class and $parent_class !~ /Object/; is_legal_key($parent_class,$key); } sub set { my $self = shift; my $class = ref $self; #print "class: $class, args: @_\n"; croak "odd number of arguments ",join "\n--\n" ,@_ if @_ % 2; my %new_vals = @_; map{ $self->{$_} = $new_vals{$_} ; my $key = $_; is_legal_key(ref $self, $key) or croak "illegal key: $_ for object of type ", ref $self; } keys %new_vals; } sub dumpp { my $self = shift; my $class = ref $self; bless $self, 'HASH'; # easy magic my $output = yaml_out $self; print "Object class: $class\n"; print $output, "\n"; bless $self, $class; # restore } sub dump { my $self = shift; my $class = ref $self; bless $self, 'HASH'; # easy magic my $output = yaml_out $self; bless $self, $class; # restore return $output; } sub hashref { my $self = shift; my $class = ref $self; bless $self, 'HASH'; # easy magic #print yaml_out $self; return; my %guts = %{ $self }; #print join " ", %guts; return; #my @keys = keys %guts; #map{ $output->{$_} or $output->{$_} = '~' } @keys; bless $self, $class; # restore return \%guts; } 1; __END__ =pod =head1 NAME Audio::Nama::Object - Class builder =head1 SYNOPSIS # Define a class package Foo; use Audio::Nama::Object qw{ bux baz }; 1; # Use the class my $object = Foo->new( bux => 1 ); $object->set( bux => 2); print "bux is " . $object->bux . "\n"; # Define a subclass (automatically inherits parent attributes) package Bar; our @ISA = 'Foo'; my $lonely_bar = Bar->new(); $lonely_bar->set(bux => 3); Audio-Nama-1.078/lib/Audio/Nama/Midi_subs.pm0000644000175000017500000000254711623337667017467 0ustar jrothjroth# ------------- MIDI routines ----------- package Audio::Nama; use Modern::Perl; use Carp; { my($error,$answer)=('',''); my ($pid, $sel); sub start_midish { my $executable = qx(which midish); chomp $executable; $executable or say("Midish not found!"), return; $pid = open3(\*MIDISH_WRITE, \*MIDISH_READ,\*MIDISH_ERROR,"$executable -v") or warn "Midish failed to start!"; $sel = new IO::Select(); $sel->add(\*MIDISH_READ); $sel->add(\*MIDISH_ERROR); midish_command( qq(print "Welcome to Nama/Midish!"\n) ); } sub midish_command { my $query = shift; print "\n"; #$midish_enable or say( qq($query: cannot execute Midish command #unless you set "midish_enable: 1" in .namarc)), return; #$query eq 'exit' and say("Will exit Midish on closing Nama."), return; #send query to midish print MIDISH_WRITE "$query\n"; foreach my $h ($sel->can_read) { my $buf = ''; if ($h eq \*MIDISH_ERROR) { sysread(MIDISH_ERROR,$buf,4096); if($buf){print "MIDISH ERR-> $buf\n"} } else { sysread(MIDISH_READ,$buf,4096); if($buf){map{say "MIDISH-> $_"} grep{ !/\+ready/ } split "\n", $buf} } } print "\n"; } sub close_midish { midish_command('exit'); sleeper(0.1); kill 15,$pid; sleeper(0.1); kill 9,$pid; sleeper(0.1); waitpid($pid, 1); # It is important to waitpid on your child process, # otherwise zombies could be created. } } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Region_subs.pm0000644000175000017500000000210011623337670020003 0ustar jrothjroth# ------------ Region routines ---------- package Audio::Nama; use Modern::Perl; use Carp; our ($this_track); sub set_region { my ($beg, $end) = @_; $this_track->set(region_start => $beg); $this_track->set(region_end => $end); Audio::Nama::Text::show_region(); } sub new_region { my ($beg, $end, $name) = @_; $name ||= new_region_name(); add_track_alias($name, $this_track->name); set_region($beg,$end); } sub new_region_name { my $name = $this_track->name . '_region_'; my $i; map{ my ($j) = /_(\d+)$/; $i = $j if $j > $i; } grep{/$name/} keys %Audio::Nama::Track::by_name; $name . ++$i } sub remove_region { if (! $this_track->region_start){ say $this_track->name, ": no region is defined. Skipping."; return; } elsif ($this_track->target ){ say $this_track->name, ": looks like a region... removing."; $this_track->remove; } else { undefine_region() } } sub undefine_region { $this_track->set(region_start => undef ); $this_track->set(region_end => undef ); print $this_track->name, ": Region definition removed. Full track will play.\n"; } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/CacheTrack.pm0000644000175000017500000001505011623337667017532 0ustar jrothjroth# -------- TrackCache ------ package Audio::Nama; use Modern::Perl; our ( $debug, %bn, $length, $ui, $this_track, $cache_to_disk_format, %event_id, ); # some common variables for cache_track and merge_track # related routines { # begin shared lexicals for cache_track and merge_edits my ($track, $additional_time, $processing_time, $orig_version, $complete_caching_ref, $output_wav); sub cache_track { # launch subparts if conditions are met ($track, $additional_time) = @_; say $track->name, ": preparing to cache."; # abort if sub-bus mix track and bus is OFF if( my $bus = $bn{$track->name} and $track->rec_status eq 'REC' ){ $bus->rw eq 'OFF' and say( $bus->name, ": status is OFF. Aborting."), return; # check conditions for normal track } else { $track->rec_status eq 'MON' or say( $track->name, ": track caching requires MON status. Aborting."), return; } say($track->name, ": no effects to cache! Skipping."), return unless $track->fancy_ops or $track->has_insert or $bn{$track->name}; prepare_to_cache() or say("Empty routing graph. Aborting."), return; cache_engine_run(); $output_wav } sub prepare_to_cache { # uses shared lexicals my $g = Audio::Nama::ChainSetup::initialize(); $orig_version = $track->monitor_version; # create a temporary track to represent the output file my $cooked_name = $track->name . '_cooked'; my $cooked = Audio::Nama::CacheRecTrack->new( name => $cooked_name, group => 'Temp', target => $track->name, ); $output_wav = $cooked->current_wav; # connect the temporary track's output path $g->add_path($track->name, $cooked->name, 'wav_out'); # set the correct output parameters in the graph $g->set_vertex_attributes( $cooked->name, { format => signal_format($cache_to_disk_format,$cooked->width), } ); # Case 1: Caching a standard track if($track->rec_status eq 'MON') { # set the input path $g->add_path('wav_in',$track->name); $debug and say "The graph0 is:\n$g"; # update cache map to enable 'uncache' command $complete_caching_ref = \&update_cache_map; } # Case 2: Caching a sub-bus mix track elsif($track->rec_status eq 'REC'){ # apply all sub-buses (unneeded ones will be pruned) map{ $_->apply($g) } grep{ (ref $_) =~ /Sub/ } Audio::Nama::Bus::all() } $debug and say "The graph1 is:\n$g"; Audio::Nama::ChainSetup::prune_graph(); $debug and say "The graph2 is:\n$g"; Audio::Nama::Graph::expand_graph($g); $debug and say "The graph3 is:\n$g"; Audio::Nama::Graph::add_inserts($g); $debug and say "The graph4 is:\n$g"; my $success = Audio::Nama::ChainSetup::process_routing_graph(); Audio::Nama::ChainSetup::write_chains(); remove_temporary_tracks(); $success } sub cache_engine_run { # uses shared lexicals connect_transport('quiet') or say("Couldn't connect engine! Aborting."), return; $processing_time = $length + $additional_time; say $/,$track->name,": processing time: ". d2($processing_time). " seconds"; print "Starting cache operation. Please wait."; revise_prompt(" "); # we try to set processing time this way eval_iam("cs-set-length $processing_time"); eval_iam("start"); # ensure that engine stops at completion time $event_id{poll_engine} = AE::timer(1, 0.5, \&poll_cache_progress); # complete_caching() contains the remainder of the caching code. # It is triggered by stop_polling_cache_progress() } sub complete_caching { # uses shared lexicals my $name = $track->name; my @files = grep{/$name/} new_files_were_recorded(); if (@files ){ # update cache map &$complete_caching_ref if defined $complete_caching_ref; post_cache_processing(); } else { say "track cache operation failed!"; } } sub update_cache_map { $debug and say "updating track cache_map"; #say "cache map",yaml_out($track->cache_map); my $cache_map = $track->cache_map; $cache_map->{$track->last} = { original => $orig_version, effect_chain => push_effect_chain($track), # bypass }; pop @{$track->effect_chain_stack}; # we keep it elsewhere if (my @inserts = grep{$_}( $track->prefader_insert, $track->postfader_insert) ){ say "removing insert... "; say "if you want it again you will need to replace it yourself"; say "this is what it was"; map{ say $_->dump; $_->remove } map{ $Audio::Nama::Insert::by_index{$_} } @inserts; } #say "cache map",yaml_out($track->cache_map); say qq(Saving effects for cached track "), $track->name, '".'; say qq('uncache' will restore effects and set version $orig_version\n); } sub post_cache_processing { # only set to MON tracks that would otherwise remain # in a REC status # # track:REC bus:MON -> keep current state # track:REC bus:REC -> set track to MON $track->set(rw => 'MON') if $track->rec_status eq 'REC'; $ui->global_version_buttons(); # recreate $ui->refresh(); reconfigure_engine(); $this_track = $track; # why do we need this? revise_prompt("default"); } sub poll_cache_progress { print "."; my $status = eval_iam('engine-status'); my $here = eval_iam("getpos"); update_clock_display(); $debug and say "engine time: ", d2($here); $debug and say "engine status: ", $status; return unless $status =~ /finished|error|stopped/ or $here > $processing_time; say "Done."; $debug and say engine_status(current_position(),2,1); #revise_prompt(); stop_polling_cache_progress(); } sub stop_polling_cache_progress { $event_id{poll_engine} = undef; $ui->reset_engine_mode_color_display(); complete_caching(); } } # end shared lexicals for cache_track and merge_edits sub uncache_track { my $track = shift; # skip unless MON; my $cache_map = $track->cache_map; my $version = $track->monitor_version; if(is_cached($track)){ # blast away any existing effects, TODO: warn or abort say $track->name, ": removing effects (except vol/pan)" if $track->fancy_ops; map{ remove_effect($_)} $track->fancy_ops; # original WAV -> WAV case: reset version if ( $cache_map->{$version}{original} ){ $track->set(version => $cache_map->{$version}{original}); print $track->name, ": setting uncached version ", $track->version, $/; # assume a sub-bus mix track, i.e. REC -> WAV: set to REC } else { $track->set(rw => 'REC') ; say $track->name, ": setting sub-bus mix track to REC"; } add_effect_chain($track, $cache_map->{$version}{effect_chain}) if $cache_map->{$version}{effect_chain}; } else { print $track->name, ": version $version is not cached\n"} } sub is_cached { my $track = shift; my $cache_map = $track->cache_map; $cache_map->{$track->monitor_version} } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Project_subs.pm0000644000175000017500000002072711623337667020213 0ustar jrothjroth# --------- Project related subroutines --------- package Audio::Nama; use Modern::Perl; use Carp; use File::Slurp; our ( $debug, $debug2, $ui, $cop_id, %cops, %copp, @input_chains, @output_chains, $preview, $mastering_mode, $saved_version, %bunch, $this_bus, %inputs, %outputs, %wav_info, $offset_run_flag, $this_edit, $project_name, $state_store_file, %opts, %tn, %track_widget, %effects_widget, $markers_armed, @already_muted, $old_snapshot, $initial_user_mode, $project, $project_root, ); our ( # for create_system_buses %is_system_bus, @system_buses, $main, $null, ); our ($term, %bn); # for project templates { # OPTIMIZATION # we allow for the (admitted rare) possibility that # $project_root may change my %proot; sub project_root { $proot{$project_root} ||= resolve_path($project_root) } } sub config_file { $opts{f} ? $opts{f} : ".namarc" } { # OPTIMIZATION my %wdir; sub this_wav_dir { $opts{p} and return $project_root; # cwd $project_name and $wdir{$project_name} ||= resolve_path( join_path( project_root(), $project_name, q(.wav) ) ); } } sub project_dir { $opts{p} and return $project_root; # cwd $project_name and join_path( project_root(), $project_name) } sub list_projects { my $projects = join "\n", sort map{ my ($vol, $dir, $lastdir) = File::Spec->splitpath($_); $lastdir } File::Find::Rule ->directory() ->maxdepth(1) ->extras( { follow => 1} ) ->in( project_root()); pager($projects); } sub initialize_project_data { $debug2 and print "&initialize_project_data\n"; return if transport_running(); $ui->destroy_widgets(); $ui->project_label_configure( -text => uc $project_name, -background => 'lightyellow', ); # effect variables - no object code (yet) $cop_id = "A"; # autoincrement counter %cops = (); # effect and controller objects (hashes) %copp = (); # chain operator parameters # indexed by {$id}->[$param_no] # zero-based {AB}->[0] (parameter 1) @input_chains = (); @output_chains = (); %track_widget = (); %effects_widget = (); $markers_armed = 0; map{ $_->initialize() } qw( Audio::Nama::Mark Audio::Nama::Fade Audio::Nama::Edit Audio::Nama::Bus Audio::Nama::Track Audio::Nama::Insert ); # volume settings @already_muted = (); # $is_armed = 0; $old_snapshot = {}; $preview = $initial_user_mode; $mastering_mode = 0; $saved_version = 0; %bunch = (); create_system_buses(); $this_bus = 'Main'; %inputs = %outputs = (); %wav_info = (); clear_offset_run_vars(); $offset_run_flag = 0; $this_edit = undef; } sub load_project { $debug2 and print "&load_project\n"; my %h = @_; $debug and print yaml_out \%h; print("no project name.. doing nothing.\n"),return unless $h{name} or $project; $project_name = $h{name} if $h{name}; if ( ! -d join_path( project_root(), $project_name) ){ if ( $h{create} ){ map{create_dir($_)} &project_dir, &this_wav_dir ; } else { print qq( Project "$project_name" does not exist. Loading project "untitled". ); load_project( qw{name untitled create 1} ); return; } } # we used to check each project dir for customized .namarc # read_config( global_config() ); teardown_engine(); # initialize_ecasound_engine; initialize_project_data(); remove_riff_header_stubs(); cache_wav_info(); rememoize(); restore_state( $h{settings} ? $h{settings} : $state_store_file) unless $opts{M} ; if (! $tn{Master}){ Audio::Nama::SimpleTrack->new( group => 'Master', name => 'Master', send_type => 'soundcard', send_id => 1, width => 2, rw => 'MON', source_type => undef, source_id => undef); my $mixdown = Audio::Nama::MixDownTrack->new( group => 'Mixdown', name => 'Mixdown', width => 2, rw => 'OFF', source_type => undef, source_id => undef); #remove_effect($mixdown->vol); #remove_effect($mixdown->pan); } $opts{M} = 0; # enable dig_ruins() unless scalar @Audio::Nama::Track::all > 2; # possible null if Text mode $ui->global_version_buttons(); $ui->refresh_group; $debug and print "project_root: ", project_root(), $/; $debug and print "this_wav_dir: ", this_wav_dir(), $/; $debug and print "project_dir: ", project_dir() , $/; 1; } sub dig_ruins { # only if there are no tracks $debug2 and print "&dig_ruins"; return if Audio::Nama::Track::user(); $debug and print "looking for WAV files\n"; # look for wave files my $d = this_wav_dir(); opendir my $wav, $d or carp "couldn't open $d: $!"; # remove version numbers my @wavs = grep{s/(_\d+)?\.wav//i} readdir $wav; closedir $wav; my %wavs; map{ $wavs{$_}++ } @wavs; @wavs = keys %wavs; $debug and print "tracks found: @wavs\n"; $ui->create_master_and_mix_tracks(); map{add_track($_)}@wavs; } sub remove_riff_header_stubs { # 44 byte stubs left by a recording chainsetup that is # connected by not started $debug2 and print "&remove_riff_header_stubs\n"; $debug and print "this wav dir: ", this_wav_dir(), $/; return unless this_wav_dir(); my @wavs = File::Find::Rule ->name( qr/\.wav$/i ) ->file() ->size(44) ->extras( { follow => 1} ) ->in( this_wav_dir() ); $debug and print join $/, @wavs; map { unlink $_ } @wavs; } sub create_system_buses { $debug2 and say "&create_system_buses"; my $buses = q( Master # master fader track Mixdown # mixdown track Mastering # mastering network Insert # auxiliary tracks for inserts Cooked # for track caching Temp # temp tracks while generating setup Main # default mixer bus, new tracks assigned to Main ); ($buses) = strip_comments($buses); # need initial parentheses @system_buses = split " ", $buses; map{ $is_system_bus{$_}++ } @system_buses; delete $is_system_bus{Main}; # because we want to display it map{ Audio::Nama::Bus->new(name => $_ ) } @system_buses; # a bus should identify it's mix track $bn{Main}->set( send_type => 'track', send_id => 'Master'); $main = $bn{Main}; $null = $bn{null}; } ## project templates sub new_project_template { my ($template_name, $template_description) = @_; my @tracks = Audio::Nama::Track::all(); # skip if project is empty say("No user tracks found, aborting.\n", "Cannot create template from an empty project."), return if scalar @tracks < 3; # save current project status to temp state file my $previous_state = '_previous_state.yml'; save_state($previous_state); # edit current project into a template # No tracks are recorded, so we'll remove # - version (still called 'active') # - track caching # - region start/end points # - effect_chain_stack # Also # - unmute all tracks # - throw away any pan caching map{ my $track = $_; $track->unmute; map{ $track->set($_ => undef) } qw( version old_pan_level region_start region_end ); map{ $track->set($_ => []) } qw( effect_chain_stack ); map{ $track->set($_ => {}) } qw( cache_map ); } @tracks; # Throw away command history $term->SetHistory(); # Buses needn't set version info either map{$_->set(version => undef)} values %bn; # create template directory if necessary mkdir join_path(project_root(), "templates"); # save to template name save_state( join_path(project_root(), "templates", "$template_name.yml")); # add description, but where? # recall temp name load_project( # restore_state() doesn't do the whole job name => $project_name, settings => $previous_state, ); # remove temp state file unlink join_path( project_dir(), "$previous_state.yml") ; } sub use_project_template { my $name = shift; my @tracks = Audio::Nama::Track::all(); # skip if project isn't empty say("User tracks found, aborting. Use templates in an empty project."), return if scalar @tracks > 2; # load template load_project( name => $project_name, settings => join_path(project_root(),"templates",$name), ); save_state(); } sub list_project_templates { my $read = read_file(join_path(project_root(), "templates")); push my @templates, "\nTemplates:\n", map{ m|([^/]+).yml$|; $1, "\n"} $read; pager(@templates); } sub remove_project_template { map{my $name = $_; say "$name: removing template"; $name .= ".yml" unless $name =~ /\.yml$/; unlink join_path( project_root(), "templates", $name); } @_; } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Initialize_subs.pm0000644000175000017500000001555511623337667020711 0ustar jrothjroth# ----------- Initialize -------- package Audio::Nama; use Modern::Perl; use Carp; our ( $ui, %opts, %jack, $jack_running, $midish_enable, $project_name, $debug, $debug2, $banner, $project_root, $ladspa_sample_rate, %devices, $fake_jack_lsp, $use_jack_plumbing, @ecasound_pids, $e, $user_customization_file, $sock, $ecasound_tcp_port, $hires, $waveform_viewer, ); sub initialize_interfaces { $debug2 and print "&prepare\n"; say $banner; if ($opts{D}){ $debug = 1; $debug2 = 1; } if ( ! $opts{t} and Audio::Nama::Graphical::initialize_tk() ){ $ui = Audio::Nama::Graphical->new(); } else { say "Unable to load perl Tk module. Starting in console mode." if $opts{g}; $ui = Audio::Nama::Text->new(); can_load( modules =>{ Event => undef}) or die "Perl Module 'Event' not found. Please install it and try again. Stopping."; ; import Event qw(loop unloop unloop_all); } can_load( modules => {AnyEvent => undef}) or die "Perl Module 'AnyEvent' not found. Please install it and try again. Stopping."; choose_sleep_routine(); $project_name = shift @ARGV; $debug and print "project name: $project_name\n"; $debug and print("\%opts\n======\n", yaml_out(\%opts)); ; read_config(global_config()); # from .namarc if we have one setup_user_customization(); start_ecasound(); $debug and print "reading config file\n"; if ($opts{d}){ print "project_root $opts{d} specified on command line\n"; $project_root = $opts{d}; } if ($opts{p}){ $project_root = getcwd(); print "placing all files in current working directory ($project_root)\n"; } # capture the sample frequency from .namarc ($ladspa_sample_rate) = $devices{jack}{signal_format} =~ /(\d+)(,i)?$/; # skip initializations if user (test) supplies project # directory first_run() unless $opts{d}; prepare_static_effects_data() unless $opts{S}; get_ecasound_iam_keywords(); load_keywords(); # for autocompletion chdir $project_root # for filename autocompletion or warn "$project_root: chdir failed: $!\n"; $ui->init_gui; $ui->transport_gui; $ui->time_gui; # fake JACK for testing environment if( $opts{J}){ %jack = %{ jack_ports($fake_jack_lsp) }; $jack_running = 1; } # periodically check if JACK is running, and get client/port list poll_jack() unless $opts{J} or $opts{A}; sleeper(0.2); # allow time for first polling # we will start jack.plumbing only when we need it if( $use_jack_plumbing and $jack_running and process_is_running('jack.plumbing') ){ say "\nJack.plumbing daemon detected!"; print "\nAttempting to stop it (will restart as needed)... "; kill_jack_plumbing(); sleeper(0.2); if( process_is_running('jack.plumbing') ) { say qq(\n\nUnable to stop jack.plumbing daemon. Please do one of the following, then restart Nama: - kill the jack.plumbing daemon ("killall jack.plumbing") - set "use_jack_plumbing: 0" in .namarc Exiting.); exit; } else { say "Stopped." } } start_midish() if $midish_enable; # set up autosave schedule_autosave() unless debugging_options(); initialize_terminal() unless $opts{T}; # set default project to "untitled" if (! $project_name ){ $project_name = "untitled"; $opts{c}++; } print "\nproject_name: $project_name\n"; load_project( name => $project_name, create => $opts{c}) ; restore_effect_chains(); restore_effect_profiles(); 1; } sub debugging_options { grep{$_} $debug, @opts{qw(R D J A E T)}; } sub start_ecasound { my @existing_pids = split " ", qx(pgrep ecasound); select_ecasound_interface(); sleeper(0.2); @ecasound_pids = grep{ my $pid = $_; ! grep{ $pid == $_ } @existing_pids } split " ", qx(pgrep ecasound); } sub select_ecasound_interface { return if $opts{E} or $opts{A}; if ( can_load( modules => { 'Audio::Ecasound' => undef } ) and ! $opts{n} ){ say "\nUsing Ecasound via Audio::Ecasound (libecasoundc)."; { no warnings qw(redefine); *eval_iam = \&eval_iam_libecasoundc; } $e = Audio::Ecasound->new(); } else { no warnings qw(redefine); launch_ecasound_server($ecasound_tcp_port); init_ecasound_socket($ecasound_tcp_port); *eval_iam = \&eval_iam_neteci; } } sub choose_sleep_routine { if ( can_load(modules => {'Time::HiRes'=> undef} ) ) { *sleeper = *finesleep; $hires++; } else { *sleeper = *select_sleep } } sub finesleep { my $sec = shift; Time::HiRes::usleep($sec * 1e6); } sub select_sleep { my $seconds = shift; select( undef, undef, undef, $seconds ); } sub toggle_transport { if (engine_running()){ stop_transport() } else { start_transport() } } { my $default_port = 2868; # Ecasound's default sub launch_ecasound_server { # we'll try to communicate with an existing ecasound # process provided: # # started with --server option # --server-tcp-port option matches --or-- # nama is using Ecasound's default port 2868 my $port = shift // $default_port; my $command = "ecasound -K -C --server --server-tcp-port=$port"; my $redirect = ">/dev/null &"; my $ps = qx(ps ax); say("Using existing Ecasound server"), return if $ps =~ /ecasound/ and $ps =~ /--server/ and ($ps =~ /tcp-port=$port/ or $port == $default_port); say "Starting Ecasound server"; system("$command $redirect") == 0 or carp "system $command failed: $?\n"; sleep 1; } sub init_ecasound_socket { my $port = shift // $default_port; say "Creating socket on port $port."; $sock = new IO::Socket::INET ( PeerAddr => 'localhost', PeerPort => $port, Proto => 'tcp', ); die "Could not create socket: $!\n" unless $sock; } sub ecasound_pid { my ($ps) = grep{ /ecasound/ and /server/ } qx(ps ax); my ($pid) = split " ", $ps; $pid if $sock; # conditional on using socket i.e. Net-ECI } sub eval_iam { } # stub sub eval_iam_neteci { my $cmd = shift; $cmd =~ s/\s*$//s; # remove trailing white space $sock->send("$cmd\r\n"); my $buf; $sock->recv($buf, 65536); my ($return_value, $length, $type, $reply) = $buf =~ /(\d+)# digits \ # space (\d+)# digits \ # space ([^\r\n]+) # a line of text, probably one character \r\n # newline (.+) # rest of string /sx; # s-flag: . matches newline if( ! $return_value == 256 ){ my $debug++; $debug and say "ECI command: $cmd"; $debug and say "Ecasound reply (256 bytes): ", substr($buf,0,256); $debug and say qq( length: $length type: $type full return value: $return_value); die "illegal return value, stopped" ; } $reply =~ s/\s+$//; given($type){ when ('e'){ carp $reply } default{ return $reply } } } } sub eval_iam_libecasoundc{ #$debug2 and print "&eval_iam\n"; my $command = shift; $debug and print "iam command: $command\n"; my (@result) = $e->eci($command); $debug and print "result: @result\n" unless $command =~ /register/; my $errmsg = $e->errmsg(); if( $errmsg ){ $e->errmsg(''); # ecasound already prints error on STDOUT # carp "ecasound reports an error:\n$errmsg\n"; } "@result"; } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Persistence.pm0000644000175000017500000003227711623337670020032 0ustar jrothjroth# ---------- Persistent State Support ------------- package Audio::Nama; use Modern::Perl; use File::Slurp; use Audio::Nama::Assign qw(quote_yaml_scalars); no warnings 'uninitialized'; our ( $saved_version, $cop_id, %cops, %copp, %copp_exp, $unit, %oid_status, @tracks_data, @bus_data, @groups_data, @marks_data, @fade_data, @edit_data, @inserts_data, @loop_endpoints, $loop_enable, $length, %bunch, @command_history, $mastering_mode, $this_track_name, $this_op, # autosave $autosave_interval, %event_id, ); our ( $state_store_file, $effect_chain_file, $effect_profile_file, %effect_chain, %effect_profile, %tn, %ti, %bn, $term, $this_track, $this_bus, @persistent_vars, $ui, $VERSION, %opts, $debug, $debug2, $debug3 ); sub save_state { my $file = shift || $state_store_file; $debug2 and print "&save_state\n"; $saved_version = $VERSION; # some stuff get saved independently of our state file $debug and print "saving palette\n"; $ui->save_palette; # do nothing more if only Master and Mixdown if (scalar @Audio::Nama::Track::all == 2 ){ print "No user tracks, skipping...\n"; return; } print "\nSaving state as ", save_system_state($file), "\n"; save_effect_chains(); save_effect_profiles(); # store alsa settings if ( $opts{a} ) { my $file = $file; $file =~ s/\.yml$//; print "storing ALSA settings\n"; print qx(alsactl -f $file.alsa store); } } sub initialize_serialization_arrays { @tracks_data = (); # zero based, iterate over these to restore @bus_data = (); # @marks_data = (); @fade_data = (); @inserts_data = (); @edit_data = (); @command_history = (); } sub save_system_state { my $file = shift; # save stuff to state file $file = join_path(project_dir(), $file) unless $file =~ m(/); $file =~ /\.yml$/ or $file .= '.yml'; sync_effect_parameters(); # in case a controller has made a change # remove null keys in %cops and %copp delete $cops{''}; delete $copp{''}; initialize_serialization_arrays(); # prepare tracks for storage $this_track_name = $this_track->name; $debug and print "copying tracks data\n"; map { push @tracks_data, $_->hashref } Audio::Nama::Track::all(); # print "found ", scalar @tracks_data, "tracks\n"; # delete unused fields map { my $t = $_; map{ delete $t->{$_} } qw(ch_r ch_m source_select send_select jack_source jack_send); } @tracks_data; $debug and print "copying bus data\n"; map{ push @bus_data, $_->hashref } Audio::Nama::Bus::all(); # prepare inserts data for storage $debug and print "copying inserts data\n"; while (my $k = each %Audio::Nama::Insert::by_index ){ push @inserts_data, $Audio::Nama::Insert::by_index{$k}->hashref; } # prepare marks data for storage (new Mark objects) $debug and print "copying marks data\n"; push @marks_data, map{ $_->hashref } Audio::Nama::Mark::all(); push @fade_data, map{ $_->hashref } values %Audio::Nama::Fade::by_index; push @edit_data, map{ $_->hashref } values %Audio::Nama::Edit::by_index; # save history -- 50 entries, maximum my @history = $Audio::Nama::term->GetHistory; my %seen; map { push @command_history, $_ unless $seen{$_}; $seen{$_}++ } @history; my $max = scalar @command_history; $max = 50 if $max > 50; @command_history = @command_history[-$max..-1]; $debug and print "serializing\n"; serialize( file => $file, format => 'yaml', vars => \@persistent_vars, class => 'Audio::Nama', ); $file } sub restore_state { $debug2 and print "&restore_state\n"; my $file = shift; $file = $file || $state_store_file; $file = join_path(project_dir(), $file) unless $file =~ m(/); $file .= ".yml" unless $file =~ /yml$/; ! -f $file and (print "file not found: $file\n"), return; $debug and print "using file: $file\n"; my $yaml = read_file($file); # remove empty key hash lines # fixes YAML::Tiny bug $yaml = join $/, grep{ ! /^\s*:/ } split $/, $yaml; # rewrite obsolete null hash/array substitution $yaml =~ s/~NULL_HASH/{}/g; $yaml =~ s/~NULL_ARRAY/[]/g; # rewrite %cops 'owns' field to [] $yaml =~ s/owns: ~/owns: []/g; $yaml = quote_yaml_scalars( $yaml ); # start marshalling with clean slate initialize_serialization_arrays(); # restore persistent variables assign_var($yaml, @persistent_vars ); restore_effect_chains(); restore_effect_profiles(); ## print yaml_out \@groups_data; # %cops: correct 'owns' null (from YAML) to empty array [] # backward compatibility fixes for older projects if (! $saved_version ){ # Tracker group is now called 'Main' map{ $_->{name} = 'Main'} grep{ $_->{name} eq 'Tracker' } @groups_data; for my $t (@tracks_data){ $t->{group} =~ s/Tracker/Main/; if( $t->{source_select} eq 'soundcard'){ $t->{source_type} = 'soundcard' ; $t->{source_id} = $t->{ch_r} } elsif( $t->{source_select} eq 'jack'){ $t->{source_type} = 'jack_client' ; $t->{source_id} = $t->{jack_source} } if( $t->{send_select} eq 'soundcard'){ $t->{send_type} = 'soundcard' ; $t->{send_id} = $t->{ch_m} } elsif( $t->{send_select} eq 'jack'){ $t->{send_type} = 'jack_client' ; $t->{send_id} = $t->{jack_send} } } } if( $saved_version < 0.9986){ map { # store insert without intermediate array my $t = $_; # use new storage format for inserts my $i = $t->{inserts}; if($i =~ /ARRAY/){ $t->{inserts} = scalar @$i ? $i->[0] : {} } # initialize inserts effect_chain_stack and cache_map $t->{inserts} //= {}; $t->{effect_chain_stack} //= []; $t->{cache_map} //= {}; # set class for Mastering tracks $t->{class} = 'Audio::Nama::MasteringTrack' if $t->{group} eq 'Mastering'; $t->{class} = 'Audio::Nama::SimpleTrack' if $t->{name} eq 'Master'; # rename 'ch_count' field to 'width' $t->{width} = $t->{ch_count}; delete $t->{ch_count}; # set Mixdown track width to 2 $t->{width} = 2 if $t->{name} eq 'Mixdown'; # remove obsolete fields map{ delete $t->{$_} } qw( delay length start_position ch_m ch_r source_select jack_source send_select jack_send); } @tracks_data; } # jack_manual is now called jack_port if ( $saved_version <= 1){ map { $_->{source_type} =~ s/jack_manual/jack_port/ } @tracks_data; } if ( $saved_version <= 1.053){ # convert insert data to object my $n = 0; @inserts_data = (); for my $t (@tracks_data){ my $i = $t->{inserts}; next unless keys %$i; $t->{postfader_insert} = ++$n; $i->{class} = 'Audio::Nama::PostFaderInsert'; $i->{n} = $n; $i->{wet_name} = $t->{name} . "_wet"; $i->{dry_name} = $t->{name} . "_dry"; delete $t->{inserts}; delete $i->{tracks}; push @inserts_data, $i; } } if ( $saved_version <= 1.054){ for my $t (@tracks_data){ # source_type 'track' is now 'bus' $t->{source_type} =~ s/track/bus/; # convert 'null' bus to 'Null' (which is eliminated below) $t->{group} =~ s/null/Null/; } } if ( $saved_version <= 1.055){ # get rid of Null bus routing map{$_->{group} = 'Main'; $_->{source_type} = 'null'; $_->{source_id} = 'null'; } grep{$_->{group} eq 'Null'} @tracks_data; } if ( $saved_version <= 1.064){ map{$_->{version} = $_->{active}; delete $_->{active}} grep{$_->{active}} @tracks_data; } $debug and print "inserts data", yaml_out \@inserts_data; # make sure Master has reasonable output settings map{ if ( ! $_->{send_type}){ $_->{send_type} = 'soundcard', $_->{send_id} = 1 } } grep{$_->{name} eq 'Master'} @tracks_data; if ( $saved_version <= 1.064){ map{ my $default_list = Audio::Nama::IO::default_jack_ports_list($_->{name}); if( -e join_path(project_root(),$default_list)){ $_->{source_type} = 'jack_ports_list'; $_->{source_id} = $default_list; } else { $_->{source_type} = 'jack_manual'; $_->{source_id} = ($_->{target}||$_->{name}).'_in'; } } grep{ $_->{source_type} eq 'jack_port' } @tracks_data; } if ( $saved_version <= 1.067){ map{ $_->{current_edit} or $_->{current_edit} = {} } @tracks_data; map{ delete $_->{active}; delete $_->{inserts}; delete $_->{prefader_insert}; delete $_->{postfader_insert}; # eliminate field is_mix_track if ($_->{is_mix_track} ){ $_->{source_type} = 'bus'; $_->{source_id} = undef; } delete $_->{is_mix_track}; } @tracks_data; } if ( $saved_version <= 1.068){ # initialize version_comment field map{ $_->{version_comment} or $_->{version_comment} = {} } @tracks_data; # convert existing comments to new format map{ while ( my($v,$comment) = each %{$_->{version_comment}} ) { $_->{version_comment}{$v} = { user => $comment } } } grep { $_->{version_comment} } @tracks_data; } # convert to new MixTrack class if ( $saved_version < 1.069){ map { $_->{was_class} = $_->{class}; $_->{class} = $_->{'Audio::Nama::MixTrack'}; } grep { $_->{source_type} eq 'bus' or $_->{source_id} eq 'bus' } @tracks_data; } # destroy and recreate all buses Audio::Nama::Bus::initialize(); create_system_buses(); # restore user buses map{ my $class = $_->{class}; $class->new( %$_ ) } @bus_data; my $main = $bn{Main}; # bus should know its mix track $main->set( send_type => 'track', send_id => 'Master') unless $main->send_type; # restore user tracks my $did_apply = 0; # temporary turn on mastering mode to enable # recreating mastering tracksk my $current_master_mode = $mastering_mode; $mastering_mode = 1; map{ my %h = %$_; my $class = $h{class} || "Audio::Nama::Track"; my $track = $class->new( %h ); } @tracks_data; $mastering_mode = $current_master_mode; # restore inserts Audio::Nama::Insert::initialize(); map{ bless $_, $_->{class}; $Audio::Nama::Insert::by_index{$_->{n}} = $_; } @inserts_data; $ui->create_master_and_mix_tracks(); $this_track = $tn{$this_track_name} if $this_track_name; set_current_bus(); map{ my $n = $_->{n}; # create gui $ui->track_gui($n) unless $n <= 2; # restore effects for my $id (@{$ti{$n}->ops}){ $did_apply++ unless $id eq $ti{$n}->vol or $id eq $ti{$n}->pan; add_effect({ chain => $cops{$id}->{chain}, type => $cops{$id}->{type}, cop_id => $id, parent_id => $cops{$id}->{belongs_to}, }); } } @tracks_data; #print "\n---\n", $main->dump; #print "\n---\n", map{$_->dump} Audio::Nama::Track::all();# exit; $did_apply and $ui->manifest; $debug and print join " ", (map{ ref $_, $/ } Audio::Nama::Track::all()), $/; # restore Alsa mixer settings if ( $opts{a} ) { my $file = $file; $file =~ s/\.yml$//; print "restoring ALSA settings\n"; print qx(alsactl -f $file.alsa restore); } # text mode marks map{ my %h = %$_; my $mark = Audio::Nama::Mark->new( %h ) ; } @marks_data; $ui->restore_time_marks(); $ui->paint_mute_buttons; # track fades map{ my %h = %$_; my $fade = Audio::Nama::Fade->new( %h ) ; } @fade_data; # edits map{ my %h = %$_; my $edit = Audio::Nama::Edit->new( %h ) ; } @edit_data; # restore command history $term->SetHistory(@command_history); } sub assign_var { my ($source, @vars) = @_; assign_vars( source => $source, vars => \@vars, # format => 'yaml', # breaks class => 'Audio::Nama'); } sub save_effect_chains { # if they exist my $file = shift || $effect_chain_file; if (keys %effect_chain){ serialize ( file => join_path(project_root(), $file), format => 'yaml', vars => [ qw( %effect_chain ) ], class => 'Audio::Nama'); } } sub save_effect_profiles { # if they exist my $file = shift || $effect_profile_file; if (keys %effect_profile){ serialize ( file => join_path(project_root(), $file), format => 'yaml', vars => [ qw( %effect_profile ) ], class => 'Audio::Nama'); } } sub restore_effect_chains { my $file = join_path(project_root(), $effect_chain_file); return unless -e $file; # don't overwrite them if already present assign_var($file, qw(%effect_chain)) unless keys %effect_chain } sub restore_effect_profiles { my $file = join_path(project_root(), $effect_profile_file); return unless -e $file; # don't overwrite them if already present assign_var($file, qw(%effect_profile)) unless keys %effect_profile; } # autosave sub schedule_autosave { # one-time timer my $seconds = (shift || $autosave_interval) * 60; $event_id{autosave} = undef; # cancel any existing timer return unless $seconds; $event_id{autosave} = AE::timer($seconds,0, \&autosave); } sub autosave { if (engine_running()){ schedule_autosave(1); # try again in 60s return; } my $file = 'State-autosave-' . time_tag(); save_system_state($file); my @saved = autosave_files(); my ($next_last, $last) = @saved[-2,-1]; schedule_autosave(); # standard interval return unless defined $next_last and defined $last; if(files_are_identical($next_last, $last)){ unlink $last; undef; } else { $last } } sub autosave_files { sort File::Find::Rule ->file() ->name('State-autosave-*') ->maxdepth(1) ->in( project_dir()); } sub files_are_identical { my ($filea,$fileb) = @_; my $a = read_file($filea); my $b = read_file($fileb); $a eq $b } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Engine_setup_subs.pm0000644000175000017500000002144211623337667021225 0ustar jrothjroth# ----------- Engine Setup and Teardown ----------- package Audio::Nama; use Modern::Perl; no warnings 'uninitialized'; our ( # generate_setup() $debug, $debug2, $regenerate_setup, $length, $ui, $seek_delay, $jack_seek_delay, # reconfigure_engine() $this_track, %opts, $disable_auto_reconfigure, $old_snapshot, $preview, $project_name, $offset_run_flag, # status_snapshot() $mastering_mode, $jack_running, # find_duplicate_inputs() $main, %already_used, %duplicate_inputs, %tn, # transport_status() %cooked_record_pending, $loop_enable, $press_space_to_start_transport, # adjust_latency() %copp, %ti, $sampling_frequency, ); sub generate_setup { # return 1 if successful # catch errors from generate_setup_try() and cleanup $debug2 and print "&generate_setup\n"; # save current track local $this_track; # prevent engine from starting an old setup eval_iam('cs-disconnect') if eval_iam('cs-connected'); Audio::Nama::ChainSetup::initialize(); $length = 0; # TODO replace global with sub # TODO: use try/catch # catch errors unless testing (no-terminal option) local $@ unless $opts{T}; track_memoize(); # freeze track state my $success = $opts{T} # don't catch errors during testing ? Audio::Nama::ChainSetup::generate_setup_try(@_) : eval { Audio::Nama::ChainSetup::generate_setup_try(@_) }; remove_temporary_tracks(); # cleanup track_unmemoize(); # unfreeze track state if ($@){ say("error caught while generating setup: $@"); Audio::Nama::ChainSetup::initialize() unless $debug; return } $success; } sub remove_temporary_tracks { $debug2 and say "&remove_temporary_tracks"; map { $_->remove } grep{ $_->group eq 'Temp'} Audio::Nama::Track::all(); } { my $old_offset_run_status; sub reconfigure_engine { $debug2 and print "&reconfigure_engine\n"; # skip if command line option is set return if $opts{R}; return if $disable_auto_reconfigure; # don't disturb recording/mixing return if Audio::Nama::ChainSetup::really_recording() and engine_running(); rememoize(); # check if someone has snuck in some files find_duplicate_inputs(); # we will warn the user later # only act if change in configuration # skip check if regenerate_setup flag is already set if( $regenerate_setup ){ $regenerate_setup = 0; # reset for next time } else { my $current = yaml_out(status_snapshot()); my $old = yaml_out($old_snapshot); if ( $current eq $old){ $debug and print("no change in setup\n"); return; } } $debug and print("setup change\n"); my $old_pos; my $was_running; my $restore_position; my $previous_snapshot = $old_snapshot; # restore previous playback position unless # - doodle mode # - change in global version (TODO) # - change in project # - new setup involves recording # - change in edit mode if ( $preview eq 'doodle' or $old_snapshot->{project} ne $project_name or $offset_run_flag != $old_offset_run_status # TODO: or change in global version ){} # do nothing else { $old_pos = eval_iam('getpos') if eval_iam('cs-selected'); $was_running = engine_running(); $restore_position++; # say "old_pos: $old_pos"; # say "was_running: $was_running"; # say "restore_position: $restore_position"; } $old_snapshot = status_snapshot(); $old_offset_run_status = $offset_run_flag; command_process('show_tracks_all'); stop_transport('quiet') if $was_running; if ( generate_setup() ){ #say "I generated a new setup"; connect_transport('quiet'); Audio::Nama::Text::show_status(); if( $restore_position and not Audio::Nama::ChainSetup::really_recording()){ eval_iam("setpos $old_pos") if $old_pos and $old_pos < $length; start_transport('quiet') if $was_running; } transport_status(); $ui->flash_ready; } } } # status_snapshot() # # hashref output for detecting if we need to reconfigure engine # compared as YAML strings # %status_snaphot indicates Nama's internal # state. It consists of # - the values of selected global variables # - selected field values of each track { # these track fields will be inspected my @relevant_track_fields = qw( name width group playat region_start region_end looping source_id source_type send_id send_type rec_defeat rec_status current_version ); sub status_snapshot { my %snapshot = ( project => $project_name, mastering_mode => $mastering_mode, preview => $preview, jack_running => $jack_running, tracks => [], ); map { push @{$snapshot{tracks}}, $_->snapshot(\@relevant_track_fields) } Audio::Nama::Track::all(); \%snapshot; } } sub find_duplicate_inputs { # in Main bus only %duplicate_inputs = (); %already_used = (); $debug2 and print "&find_duplicate_inputs\n"; map{ my $source = $_->source; $duplicate_inputs{$_->name}++ if $already_used{$source} ; $already_used{$source} //= $_->name; } grep { $_->rw eq 'REC' } map{ $tn{$_} } $main->tracks(); # track names; } sub load_ecs { my $setup = setup_file(); #say "setup file: $setup " . ( -e $setup ? "exists" : ""); return unless -e $setup; #say "passed conditional"; teardown_engine(); eval_iam("cs-load $setup"); eval_iam("cs-select $setup"); # needed by Audio::Ecasound, but not Net-ECI !! $debug and map{eval_iam($_)} qw(cs es fs st ctrl-status); 1; } sub teardown_engine { eval_iam("cs-disconnect") if eval_iam("cs-connected"); eval_iam("cs-remove") if eval_iam("cs-selected"); } sub arm { # now that we have reconfigure_engine(), use is limited to # - exiting preview # - automix $debug2 and print "&arm\n"; exit_preview_mode(); #adjust_latency(); $regenerate_setup++; generate_setup() and connect_transport(); } sub connect_transport { $debug2 and print "&connect_transport\n"; my $quiet = shift; remove_riff_header_stubs(); load_ecs() or say("No chain setup, engine not ready."), return; valid_engine_setup() or say("Invalid chain setup, engine not ready."),return; find_op_offsets(); eval_iam('cs-connect'); #or say("Failed to connect setup, engine not ready"),return; apply_ops(); apply_fades(); my $status = eval_iam("engine-status"); if ($status ne 'not started'){ print("Invalid chain setup, cannot connect engine.\n"); return; } eval_iam('engine-launch'); $status = eval_iam("engine-status"); if ($status ne 'stopped'){ print "Failed to launch engine. Engine status: $status\n"; return; } $length = eval_iam('cs-get-length'); $ui->length_display(-text => colonize($length)); # eval_iam("cs-set-length $length") unless @record; $ui->clock_config(-text => colonize(0)); sleeper(0.2); # time for ecasound engine to launch { # set delay for seeking under JACK my $track_count; map{ $track_count++ } Audio::Nama::ChainSetup::engine_tracks(); $seek_delay = $jack_seek_delay || 0.1 + 0.1 * $track_count / 20; } connect_jack_ports_list(); transport_status() unless $quiet; $ui->flash_ready(); #print eval_iam("fs"); 1; } sub transport_status { map{ say("Warning: $_: input ",$tn{$_}->source, " is already used by track ",$already_used{$tn{$_}->source},".") if $duplicate_inputs{$_}; } grep { $tn{$_}->rec_status eq 'REC' } $main->tracks; # assume transport is stopped # print looping status, setup length, current position my $start = Audio::Nama::Mark::loop_start(); my $end = Audio::Nama::Mark::loop_end(); #print "start: $start, end: $end, loop_enable: $loop_enable\n"; if (%cooked_record_pending){ say join(" ", keys %cooked_record_pending), ": ready for caching"; } if ($loop_enable and $start and $end){ #if (! $end){ $end = $start; $start = 0} say "looping from ", heuristic_time($start), "to ", heuristic_time($end); } say "\nNow at: ", current_position(); say "Engine is ". ( engine_running() ? "running." : "ready."); say "\nPress SPACE to start or stop engine.\n" if $press_space_to_start_transport; } sub adjust_latency { $debug2 and print "&adjust_latency\n"; map { $copp{$_->latency}[0] = 0 if $_->latency() } Audio::Nama::Track::all(); set_preview_mode(); exit_preview_mode(); my $cop_status = eval_iam('cop-status'); $debug and print $cop_status; my $chain_re = qr/Chain "(\d+)":\s+(.*?)(?=Chain|$)/s; my $latency_re = qr/\[\d+\]\s+latency\s+([\d\.]+)/; my %chains = $cop_status =~ /$chain_re/sg; $debug and print yaml_out(\%chains); my %latency; map { my @latencies = $chains{$_} =~ /$latency_re/g; $debug and print "chain $_: latencies @latencies\n"; my $chain = $_; map{ $latency{$chain} += $_ } @latencies; } grep { $_ > 2 } sort keys %chains; $debug and print yaml_out(\%latency); my $max; map { $max = $_ if $_ > $max } values %latency; $debug and print "max: $max\n"; map { my $adjustment = ($max - $latency{$_}) / $sampling_frequency * 1000; $debug and print "chain: $_, adjustment: $adjustment\n"; effect_update_copp_set($ti{$_}->latency, 2, $adjustment); } keys %latency; } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Mute_Solo_Fade.pm0000644000175000017500000000631011623337667020366 0ustar jrothjroth# ------------- Mute and Solo routines ----------- package Audio::Nama; use Modern::Perl; our ( %opts, %tn, %bn, $hires, $debug, $debug2, %fade_out_level, %cops, %copp, @already_muted, $fade_resolution, $fade_time, $soloing, ); sub mute { return if $opts{F}; return if $tn{Master}->rw eq 'OFF' or Audio::Nama::ChainSetup::really_recording(); $tn{Master}->mute; } sub unmute { return if $opts{F}; return if $tn{Master}->rw eq 'OFF' or Audio::Nama::ChainSetup::really_recording(); $tn{Master}->unmute; } sub fade { my ($id, $param, $from, $to, $seconds) = @_; # no fade without Timer::HiRes # no fade unless engine is running if ( ! engine_running() or ! $hires ){ effect_update_copp_set ( $id, $param, $to ); return; } my $steps = $seconds * $fade_resolution; my $wink = 1/$fade_resolution; my $size = ($to - $from)/$steps; $debug and print "id: $id, param: $param, from: $from, to: $to, seconds: $seconds\n"; for (1..$steps - 1){ modify_effect( $id, $param, '+', $size); sleeper( $wink ); } effect_update_copp_set( $id, $param, $to); } sub fadein { my ($id, $to) = @_; my $from = $fade_out_level{$cops{$id}->{type}}; fade( $id, 0, $from, $to, $fade_time); } sub fadeout { my $id = shift; my $from = $copp{$id}[0]; my $to = $fade_out_level{$cops{$id}->{type}}; fade( $id, 0, $from, $to, $fade_time ); } sub solo { my @args = @_; # get list of already muted tracks if I haven't done so already if ( ! @already_muted ){ @already_muted = grep{ defined $_->old_vol_level} map{ $tn{$_} } Audio::Nama::Track::user(); } $debug and say join " ", "already muted:", map{$_->name} @already_muted; # convert bunches to tracks my @names = map{ bunch_tracks($_) } @args; # use hashes to store our list my %to_mute; my %not_mute; # get dependent tracks my @d = map{ $tn{$_}->bus_tree() } @names; # store solo tracks and dependent tracks that we won't mute map{ $not_mute{$_}++ } @names, @d; # find all siblings tracks not in depends list # - get buses list corresponding to our non-muting tracks my %buses; $buses{Main}++; # we always want Main map{ $buses{$_}++ } # add to buses list map { $tn{$_}->group } # corresponding bus (group) names keys %not_mute; # tracks we want # - get sibling tracks we want to mute map{ $to_mute{$_}++ } # add to mute list grep{ ! $not_mute{$_} } # those we *don't* want map{ $bn{$_}->tracks } # tracks list keys %buses; # buses list # mute all tracks on our mute list (do we skip already muted tracks?) map{ $tn{$_}->mute('nofade') } keys %to_mute; # unmute all tracks on our wanted list map{ $tn{$_}->unmute('nofade') } keys %not_mute; $soloing = 1; } sub nosolo { # unmute all except in @already_muted list # unmute all tracks map { $tn{$_}->unmute('nofade') } Audio::Nama::Track::user(); # re-mute previously muted tracks if (@already_muted){ map { $_->mute('nofade') } @already_muted; } # remove listing of muted tracks @already_muted = (); $soloing = 0; } sub all { # unmute all tracks map { $tn{$_}->unmute('nofade') } Audio::Nama::Track::user(); # remove listing of muted tracks @already_muted = (); $soloing = 0; } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Bus.pm0000644000175000017500000001464311623337667016302 0ustar jrothjroth # ------------ Bus -------------------- # # The base class Audio::Nama::Bus is now used for grouping tracks # serving the role of Audio::Nama::Group, which is now a # parent class. package Audio::Nama::Bus; use Modern::Perl; use Carp; our @ISA = qw( Audio::Nama::Object Audio::Nama::Group ); our $VERSION = 1.0; our ($debug, %by_name); *debug = \$Audio::Nama::debug; use Audio::Nama::Object qw( name rw version send_type send_id class ); sub initialize { %by_name = () }; sub new { my $class = shift; my %vals = @_; my @undeclared = grep{ ! $_is_field{$_} } keys %vals; croak "undeclared field: @undeclared" if @undeclared; if (! $vals{name}){ say "missing bus name"; return } if ( $by_name{$vals{name}} ){ say "$vals{name}: bus name already exists. Skipping."; return; } my $bus = bless { class => $class, # for serialization, may be overridden rw => 'REC', # for group control @_ }, $class; $by_name{$bus->name} = $bus; } sub group { $_[0]->name } sub remove { say $_[0]->name, " is system bus. No can remove." } { my %allows = (REC => 'REC/MON', MON => 'MON', OFF => 'OFF'); sub allows { $allows{ $_[0]->rw } } } { my %forces = ( REC => 'REC (allows REC/MON)', MON => 'MON (forces REC to MON)', OFF => 'OFF (enforces OFF)' ); sub forces { $forces{ $_[0]->rw } } } ## class methods # sub buses, and Main sub all { grep{ ! $Audio::Nama::is_system_bus{$_->name} } values %by_name }; sub overall_last { my $max = 0; map{ my $last = $_->last; $max = $last if $last > $max } all(); $max; } sub settings_line { my ($mix,$bus) = @_; my $nothing = '-' x 77 . "\n"; #return if $maybe_mix->name eq 'Master' or $maybe_mix->group eq 'Mastering'; return unless defined $mix; my ($bustype) = $bus->class =~ /(\w+)$/; my $line = join " ", $bustype ,$bus->name,"is",$bus->forces; $line .= " Version setting".$bus->version if $bus->version; #$line .= "feeds", $line .= " Mix track is ". $mix->rw; $line = "------[$line]"; $line .= '-' x (77 - length $line); $line .= "\n"; $line } sub trackslist { my $bus = shift; my $mix = $Audio::Nama::tn{$bus->send_id}; my @list = ($mix,$bus); push @list, map{$Audio::Nama::tn{$_}} ($mix->name, $bus->tracks); \@list; } ### subclasses package Audio::Nama::SubBus; use Modern::Perl; use Carp; our @ISA = 'Audio::Nama::Bus'; # graphic routing: track -> mix_track sub apply { my $bus = shift; my $g = shift; return unless $Audio::Nama::tn{$bus->name}->rec_status eq 'REC'; map{ # connect signal sources to tracks my @path = $_->input_path; $g->add_path(@path) if @path; # connect tracks to mix track $g->add_edge($_->name, $bus->name); } grep{ $_->group eq $bus->group} Audio::Nama::Track::all() } sub remove { my $bus = shift; # all tracks returned to Main group map{$Audio::Nama::tn{$_}->set(group => 'Main') } $by_name{$bus->name}->tracks; my $mix_track = $Audio::Nama::tn{$bus->name}; if ( defined $mix_track ){ $mix_track->unbusify; # remove mix track unless it has some WAV files $mix_track->remove unless scalar @{ $mix_track->versions }; } # remove bus from index delete $by_name{$bus->name}; } package Audio::Nama::SendBusRaw; use Modern::Perl; use Carp; our @ISA = 'Audio::Nama::Bus'; sub apply { my $bus = shift; map{ $Audio::Nama::g->add_edge($_->input_path); my @edge = ($_->name, Audio::Nama::output_node($bus->send_type)); $Audio::Nama::g->add_edge(@edge); $Audio::Nama::g->set_edge_attributes( @edge, { send_id => $bus->send_id, width => 2 }); # force to stereo } grep{ $_->group eq $bus->group and $_->input_path} Audio::Nama::Track::all() } sub remove { my $bus = shift; # delete all (slave) tracks map{$Audio::Nama::tn{$_}->remove } $by_name{$bus->name}->tracks; # remove bus delete $by_name{$bus->name}; } package Audio::Nama::SendBusCooked; use Modern::Perl; use Carp; our @ISA = 'Audio::Nama::SendBusRaw'; # graphic routing: target -> slave -> bus_send_type sub apply { my $bus = shift; my $g = shift; map{ my @edge = ($_->name, Audio::Nama::output_node($bus->send_type)); $g->add_path( $_->target, @edge); $g->set_edge_attributes( @edge, { send_id => $bus->send_id, width => 2}) } grep{ $_->group eq $bus->group} Audio::Nama::Track::all() } # ---------- Bus routines -------- { package Audio::Nama; use Modern::Perl; use Carp; use Audio::Nama::Util qw(dest_type); our ( $this_track, $this_bus, %tn, %bn, $main, ); sub set_current_bus { my $track = shift || ($this_track ||= $tn{Master}); #say "track: $track"; #say "this_track: $this_track"; #say "master: $tn{Master}"; if( $track->name =~ /Master|Mixdown/){ $this_bus = 'Main' } elsif( $bn{$track->name} ){$this_bus = $track->name } else { $this_bus = $track->group } } sub add_sub_bus { my ($name, @args) = @_; Audio::Nama::SubBus->new( name => $name, send_type => 'track', send_id => $name, ) unless $Audio::Nama::Bus::by_name{$name}; # create mix track @args = ( width => 2, # default to stereo rec_defeat => 1, # set to rec_defeat (don't record signal) rw => 'REC', # set to REC (accept other track signals) @args ); $tn{$name} and say qq($name: setting as mix track for bus "$name"); my $track = $tn{$name} // add_track($name); # convert host track to mix track $track->set(was_class => ref $track); # save the current track (sub)class $track->set_track_class('Audio::Nama::MixTrack'); $track->set( @args ); } sub add_send_bus { my ($name, $dest_id, $bus_type) = @_; my $dest_type = dest_type( $dest_id ); # dest_type: soundcard | jack_client | loop | jack_port | jack_multi print "name: $name: dest_type: $dest_type dest_id: $dest_id\n"; if ($bn{$name} and (ref $bn{$name}) !~ /SendBus/){ say($name,": bus name already in use. Aborting."), return; } if ($bn{$name}){ say qq(monitor bus "$name" already exists. Updating with new tracks."); } else { my @args = ( name => $name, send_type => $dest_type, send_id => $dest_id, ); my $class = $bus_type eq 'cooked' ? 'Audio::Nama::SendBusCooked' : 'Audio::Nama::SendBusRaw'; my $bus = $class->new( @args ); $bus or carp("can't create bus!\n"), return; } map{ Audio::Nama::SlaveTrack->new( name => "$name\_$_", # BusName_TrackName rw => 'MON', target => $_, group => $name, ) } $main->tracks; } sub update_send_bus { my $name = shift; add_send_bus( $name, $bn{$name}->send_id), "dummy", } } # end package 1; __END__ __END__Audio-Nama-1.078/lib/Audio/Nama/Effect_subs.pm0000644000175000017500000010020311623337667017765 0ustar jrothjroth# ------ Effect Routines ------- package Audio::Nama; use Modern::Perl; use Carp; use Audio::Nama::Util qw(round); no warnings 'uninitialized'; use vars qw($cop_hints_yml); our ( %tn, %ti, $this_track, $this_op, %cops, %copp, $debug, $debug2, $ui, %effect_i, @effects, $regenerate_setup, $cop_id, $magical_cop_id, %offset, # automix() %bn, $main, ); our ( %opts, $effects_cache_file, @effects_static_vars, %effect_j, @ladspa_sorted, %e_bound, # $cop_hints_yaml, # error explicit package name required at line 867 $ladspa_sample_rate, %ladspa_help, %effects_ladspa_file, %ladspa_unique_id, %ladspa_label, %effects_ladspa, @effects_help, ); ## high-level functions sub add_effect { $debug2 and print "&add_effect\n"; my %p = %{shift()}; my ($n,$code,$parent_id,$id,$parameter,$values) = @p{qw( chain type parent_id cop_id parameter values)}; my $i = $effect_i{$code}; # don't create an existing vol or pan effect return if $id and ($id eq $ti{$n}->vol or $id eq $ti{$n}->pan); $id = cop_add(\%p); %p = ( %p, cop_id => $id); # replace chainop id $ui->add_effect_gui(\%p) unless $ti{$n}->hide; if( valid_engine_setup() ){ my $er = engine_running(); $ti{$n}->mute if $er; apply_op($id); $ti{$n}->unmute if $er; } $id; } sub modify_effect { my ($op_id, $parameter, $sign, $value) = @_; # $parameter: zero based my $cop = $cops{$op_id} or print("$op_id: non-existing effect id. Skipping\n"), return; my $code = $cop->{type}; my $i = effect_index($code); defined $i or croak "undefined effect code for $op_id: ",yaml_out($cop); my $parameter_count = scalar @{ $effects[$i]->{params} }; #print "op_id: $op_id, code: ",$cops{$op_id}->{type}," parameter count: $parameter_count\n"; print("$op_id: effect does not exist, skipping\n"), return unless $cops{$op_id}; print("$op_id: parameter (", $parameter + 1, ") out of range, skipping.\n"), return unless ($parameter >= 0 and $parameter < $parameter_count); my $new_value = $value; if ($sign) { $new_value = eval (join " ", $copp{$op_id}->[$parameter], $sign, $value); }; $this_op = $op_id; $debug and print "id $op_id p: $parameter, sign: $sign value: $value\n"; effect_update_copp_set( $op_id, $parameter, $new_value); } sub modify_multiple_effects { my ($op_ids, $parameters, $sign, $value) = @_; map{ my $op_id = $_; map{ my $parameter = $_; $parameter--; # convert to zero-base modify_effect($op_id, $parameter, $sign, $value); } @$parameters; $this_op = $op_id; # set current effect } @$op_ids; } sub remove_effect { $debug2 and print "&remove_effect\n"; my $id = shift; carp("$id: does not exist, skipping...\n"), return unless $cops{$id}; my $n = $cops{$id}->{chain}; my $parent = $cops{$id}->{belongs_to} ; $debug and print "id: $id, parent: $parent\n"; my $object = $parent ? q(controller) : q(chain operator); $debug and print qq(ready to remove $object "$id" from track "$n"\n); $ui->remove_effect_gui($id); # recursively remove children $debug and print "children found: ", join "|",@{$cops{$id}->{owns}},"\n"; map{remove_effect($_)}@{ $cops{$id}->{owns} } if defined $cops{$id}->{owns}; ; if ( ! $parent ) { # i am a chain operator, have no parent remove_op($id); } else { # i am a controller # remove the controller remove_op($id); # i remove ownership of deleted controller $debug and print "parent $parent owns list: ", join " ", @{ $cops{$parent}->{owns} }, "\n"; @{ $cops{$parent}->{owns} } = grep{ $_ ne $id} @{ $cops{$parent}->{owns} } ; $cops{$id}->{belongs_to} = undef; $debug and print "parent $parent new owns list: ", join " ", @{ $cops{$parent}->{owns} } ,$/; } $ti{$n}->remove_effect_from_track( $id ); delete $cops{$id}; # remove entry from chain operator list delete $copp{$id}; # remove entry from chain operator parameters list $this_op = undef; } sub position_effect { my($op, $pos) = @_; # we cannot handle controllers print("$op or $pos: controller not allowed, skipping.\n"), return if grep{ $cops{$_}->{belongs_to} } $op, $pos; # first, modify track data structure print("$op: effect does not exist, skipping.\n"), return unless $cops{$op}; my $track = $ti{$cops{$op}->{chain}}; my $op_index = nama_effect_index($op); my @new_op_list = @{$track->ops}; # remove op splice @new_op_list, $op_index, 1; my $new_op_index; if ( $pos eq 'ZZZ'){ # put it at the end push @new_op_list, $op; } else { my $track2 = $ti{$cops{$pos}->{chain}}; print("$pos: position belongs to a different track, skipping.\n"), return unless $track eq $track2; $new_op_index = nama_effect_index($pos); # insert op splice @new_op_list, $new_op_index, 0, $op; } # reconfigure the entire engine (inefficient, but easy to do) #say join " - ",@new_op_list; @{$track->ops} = @new_op_list; $regenerate_setup++; reconfigure_engine(); $this_track = $track; command_process('show_track'); } ## array indices for Nama and Ecasound effects and controllers sub nama_effect_index { # returns nama chain operator index # does not distinguish op/ctrl my $id = shift; my $n = $cops{$id}->{chain}; my $arr = $ti{$n}->ops; $debug and print "id: $id n: $n \n"; $debug and print join $/,@{ $ti{$n}->ops }, $/; for my $pos ( 0.. scalar @{ $ti{$n}->ops } - 1 ) { return $pos if $arr->[$pos] eq $id; }; } sub ecasound_effect_index { my $id = shift; my $n = $cops{$id}->{chain}; my $opcount; # one-based $debug and print "id: $id n: $n \n",join $/,@{ $ti{$n}->ops }, $/; for my $op (@{ $ti{$n}->ops }) { # increment only for ops, not controllers next if $cops{$op}->{belongs_to}; ++$opcount; last if $op eq $id } $offset{$n} + $opcount; } sub ctrl_index { my $id = shift; nama_effect_index($id) - nama_effect_index(root_parent($id)); } sub ecasound_operator_index { # does not include offset my $id = shift; my $chain = $cops{$id}{chain}; my $track = $ti{$chain}; my @ops = @{$track->ops}; my $controller_count = 0; my $position; for my $i (0..scalar @ops - 1) { $position = $i, last if $ops[$i] eq $id; $controller_count++ if $cops{$ops[$i]}{belongs_to}; } $position -= $controller_count; # skip controllers ++$position; # translates 0th to chain-position 1 } sub ecasound_controller_index { my $id = shift; my $chain = $cops{$id}{chain}; my $track = $ti{$chain}; my @ops = @{$track->ops}; my $operator_count = 0; my $position; for my $i (0..scalar @ops - 1) { $position = $i, last if $ops[$i] eq $id; $operator_count++ if ! $cops{$ops[$i]}{belongs_to}; } $position -= $operator_count; # skip operators ++$position; # translates 0th to chain-position 1 } sub effect_code { # get text effect code from user input, which could be # - LADSPA Unique ID (number) # - LADSPA Label (el:something) # - abbreviated LADSPA label (something) # - Ecasound operator (something) # - abbreviated Ecasound preset (something) # - Ecasound preset (pn:something) # there is no interference in these labels at present, # so we offer the convenience of using them without # el: and pn: prefixes. my $input = shift; my $code; if ($input !~ /\D/){ # i.e. $input is all digits $code = $ladspa_label{$input} or carp("$input: LADSPA plugin not found. Aborting.\n"), return; } elsif ( $effect_i{$input} ) { $code = $input } elsif ( $effect_j{$input} ) { $code = $effect_j{$input} } else { warn "$input: effect code not found\n";} $code; } sub effect_index { my $code = shift; my $i = $effect_i{effect_code($code)}; defined $i or warn "$code: effect index not found\n"; $i } ## Ecasound engine -- apply/remove chain operators sub apply_ops { # in addition to operators in .ecs file $debug2 and print "&apply_ops\n"; for my $n ( map{ $_->n } Audio::Nama::Track::all() ) { $debug and print "chain: $n, offset: ", $offset{$n}, "\n"; next unless Audio::Nama::ChainSetup::is_ecasound_chain($n); #next if $n == 2; # no volume control for mix track #next if ! defined $offset{$n}; # for MIX #next if ! $offset{$n} ; # controllers will follow ops, so safe to apply all in order for my $id ( @{ $ti{$n}->ops } ) { apply_op($id); } } ecasound_select_chain($this_track->n) if defined $this_track; } sub apply_op { $debug2 and print "&apply_op\n"; my $id = shift; my $selected = shift; $debug and print "id: $id\n"; my $code = $cops{$id}->{type}; my $dad = $cops{$id}->{belongs_to}; $debug and print "chain: $cops{$id}->{chain} type: $cops{$id}->{type}, code: $code\n"; # if code contains colon, then follow with comma (preset, LADSPA) # if code contains no colon, then follow with colon (ecasound, ctrl) $code = '-' . $code . ($code =~ /:/ ? q(,) : q(:) ); my @vals = @{ $copp{$id} }; $debug and print "values: @vals\n"; # we start to build iam command my $add = $dad ? "ctrl-add " : "cop-add "; $add .= $code . join ",", @vals; # if my parent has a parent then we need to append the -kx operator $add .= " -kx" if $cops{$dad}->{belongs_to}; $debug and print "command: ", $add, "\n"; eval_iam("c-select $cops{$id}->{chain}") if $selected != $cops{$id}->{chain}; if ( $dad ) { eval_iam("cop-select " . ecasound_effect_index($dad)); } eval_iam($add); $debug and print "children found: ", join ",", "|",@{$cops{$id}->{owns}},"|\n"; my $ref = ref $cops{$id}->{owns} ; $ref =~ /ARRAY/ or croak "expected array"; my @owns = @{ $cops{$id}->{owns} }; $debug and print "owns: @owns\n"; #map{apply_op($_)} @owns; } sub remove_op { # remove chain operator from Ecasound engine $debug2 and print "&remove_op\n"; # only if engine is configured return unless eval_iam('cs-connected') and eval_iam('cs-is-valid'); my $id = shift; my $n = $cops{$id}->{chain}; my $index; my $parent = $cops{$id}->{belongs_to}; # select chain return unless ecasound_select_chain($n); # deal separately with controllers and chain operators if ( ! $parent ){ # chain operator $debug and print "no parent, assuming chain operator\n"; $index = ecasound_effect_index( $id ); $debug and print "ops list for chain $n: @{$ti{$n}->ops}\n"; $debug and print "operator id to remove: $id\n"; $debug and print "ready to remove from chain $n, operator id $id, index $index\n"; $debug and eval_iam("cs"); eval_iam("cop-select ". ecasound_effect_index($id) ); $debug and print "selected operator: ", eval_iam("cop-selected"), $/; eval_iam("cop-remove"); $debug and eval_iam("cs"); } else { # controller $debug and print "has parent, assuming controller\n"; my $ctrl_index = ctrl_index($id); $debug and print eval_iam("cs"); eval_iam("cop-select ". ecasound_effect_index(root_parent($id))); $debug and print "selected operator: ", eval_iam("cop-selected"), $/; eval_iam("ctrl-select $ctrl_index"); eval_iam("ctrl-remove"); $debug and print eval_iam("cs"); } } # Track sax effects: A B C GG HH II D E F # GG HH and II are controllers applied to chain operator C # # to remove controller HH: # # for Ecasound, chain op index = 3, # ctrl index = 2 # = nama_effect_index HH - nama_effect_index C # # # for Nama, chain op array index 2, # ctrl arrray index = chain op array index + ctrl_index # = effect index - 1 + ctrl_index # # sub root_parent { my $id = shift; my $parent = $cops{$id}->{belongs_to}; carp("$id: has no parent, skipping...\n"),return unless $parent; my $root_parent = $cops{$parent}->{belongs_to}; $parent = $root_parent || $parent; $debug and print "$id: is a controller-controller, root parent: $parent\n"; $parent; } ## manage Nama effects -- entries in %cops array sub cop_add { $debug2 and print "&cop_add\n"; my $p = shift; my %p = %$p; $debug and say yaml_out($p); # return an existing id return $p{cop_id} if $p{cop_id}; # use an externally provided (magical) id or the # incrementing counter my $id = $magical_cop_id || $cop_id; # make entry in %cops with chain, code, display-type, children my ($n, $type, $parent_id, $parameter) = @p{qw(chain type parent_id parameter)}; my $i = $effect_i{$type}; $debug and print "Issuing a cop_id for track $n: $id\n"; $cops{$id} = {chain => $n, type => $type, display => $effects[$i]->{display}, owns => [] }; $p->{cop_id} = $id; # set defaults if (! $p{values}){ my @vals; $debug and print "no settings found, loading defaults if present\n"; my $i = $effect_i{ $cops{$id}->{type} }; # don't initialize first parameter if operator has a parent # i.e. if operator is a controller for my $p ($parent_id ? 1 : 0..$effects[$i]->{count} - 1) { my $default = $effects[$i]->{params}->[$p]->{default}; push @vals, $default; } $debug and print "copid: $id defaults: @vals \n"; $copp{$id} = \@vals; } if ($parent_id) { $debug and print "parent found: $parent_id\n"; # store relationship $debug and print "parent owns" , join " ",@{ $cops{$parent_id}->{owns}}, "\n"; push @{ $cops{$parent_id}->{owns}}, $id; $debug and print join " ", "my attributes:", (keys %{ $cops{$id} }), "\n"; $cops{$id}->{belongs_to} = $parent_id; $debug and print join " ", "my attributes again:", (keys %{ $cops{$id} }), "\n"; $debug and print "parameter: $parameter\n"; # set fx-param to the parameter number, which one # above the zero-based array offset that $parameter represents $copp{$id}->[0] = $parameter + 1; # find position of parent and insert child immediately afterwards my $end = scalar @{ $ti{$n}->ops } - 1 ; for my $i (0..$end){ splice ( @{$ti{$n}->ops}, $i+1, 0, $id ), last if $ti{$n}->ops->[$i] eq $parent_id } } else { push @{$ti{$n}->ops }, $id; } # set values if present # ugly! The passed values ref may be used for multiple # instances, so we copy it here [ @$values ] $copp{$id} = [ @{$p{values}} ] if $p{values}; # make sure the counter $cop_id will not occupy an # already used value while( $cops{$cop_id}){$cop_id++}; $id; } ## synchronize Ecasound chain operator parameters # with Nama effect parameter sub effect_update { # update the parameters of the Ecasound chain operator # referred to by a Nama operator_id #$debug2 and print "&effect_update\n"; return unless valid_engine_setup(); #my $es = eval_iam("engine-status"); #$debug and print "engine is $es\n"; #return if $es !~ /not started|stopped|running/; my ($id, $param, $val) = @_; $param++; # so the value at $p[0] is applied to parameter 1 carp("$id: effect not found. skipping...\n"), return unless $cops{$id}; my $chain = $cops{$id}{chain}; return unless Audio::Nama::ChainSetup::is_ecasound_chain($chain); $debug and print "chain $chain id $id param $param value $val\n"; # $param is zero-based. # %copp is zero-based. $debug and print join " ", @_, "\n"; my $old_chain = eval_iam('c-selected') if valid_engine_setup(); ecasound_select_chain($chain); # update Ecasound's copy of the parameter if( is_controller($id)){ my $i = ecasound_controller_index($id); $debug and print "controller $id: track: $chain, index: $i param: $param, value: $val\n"; eval_iam("ctrl-select $i"); eval_iam("ctrlp-select $param"); eval_iam("ctrlp-set $val"); } else { # is operator my $i = ecasound_operator_index($id); $debug and print "operator $id: track $chain, index: $i, offset: ", $offset{$chain}, " param $param, value $val\n"; eval_iam("cop-select ". ($offset{$chain} + $i)); eval_iam("copp-select $param"); eval_iam("copp-set $val"); } ecasound_select_chain($old_chain); } # set both Nama effect and Ecasound chain operator # parameters sub effect_update_copp_set { my ($id, $param, $val) = @_; effect_update( @_ ); $copp{$id}->[$param] = $val; } sub sync_effect_parameters { # when a controller changes an effect parameter # the effect state can differ from the state in # %copp, Nama's effect parameter store # # this routine syncs them in prep for save_state() return unless valid_engine_setup(); my $old_chain = eval_iam('c-selected'); map{ sync_one_effect($_) } ops_with_controller(); eval_iam("c-select $old_chain"); } sub sync_one_effect { my $id = shift; my $chain = $cops{$id}{chain}; eval_iam("c-select $chain"); eval_iam("cop-select " . ( $offset{$chain} + ecasound_operator_index($id))); $copp{$id} = get_cop_params( scalar @{$copp{$id}} ); } sub get_cop_params { my $count = shift; my @params; for (1..$count){ eval_iam("copp-select $_"); push @params, eval_iam("copp-get"); } \@params } sub ops_with_controller { grep{ ! is_controller($_) } grep{ scalar @{$cops{$_}{owns}} } map{ @{ $_->ops } } Audio::Nama::ChainSetup::engine_tracks(); } sub is_controller { my $id = shift; $cops{$id}{belongs_to} } sub find_op_offsets { $debug2 and print "&find_op_offsets\n"; my @op_offsets = grep{ /"\d+"/} split "\n",eval_iam("cs"); $debug and print join "\n\n",@op_offsets; for my $output (@op_offsets){ my $chain_id; ($chain_id) = $output =~ m/Chain "(\w*\d+)"/; # print "chain_id: $chain_id\n"; next if $chain_id =~ m/\D/; # skip id's containing non-digits # i.e. M1 my $quotes = $output =~ tr/"//; $debug and print "offset: $quotes in $output\n"; $offset{$chain_id} = $quotes/2 - 1; } } ## register data about LADSPA plugins, and Ecasound effects and # presets (names, ids, parameters, hints) sub prepare_static_effects_data{ $debug2 and print "&prepare_static_effects_data\n"; my $effects_cache = join_path(&project_root, $effects_cache_file); #print "newplugins: ", new_plugins(), $/; if ($opts{r} or new_plugins()){ eval { unlink $effects_cache}; print "Regenerating effects data cache\n"; } if (-f $effects_cache and ! $opts{C}){ $debug and print "found effects cache: $effects_cache\n"; assign_var($effects_cache, @effects_static_vars); } else { $debug and print "reading in effects data, please wait...\n"; read_in_effects_data(); # cop-register, preset-register, ctrl-register, ladspa-register get_ladspa_hints(); integrate_ladspa_hints(); integrate_cop_hints(); sort_ladspa_effects(); prepare_effects_help(); serialize ( file => $effects_cache, vars => \@effects_static_vars, class => 'Audio::Nama', format => 'storable'); } prepare_effect_index(); } sub ladspa_plugin_list { my @plugins; my %seen; for my $dir ( split ':', ladspa_path()){ next unless -d $dir; opendir my ($dirh), $dir; push @plugins, map{"$dir/$_"} # full path grep{ ! $seen{$_} and ++$seen{$_}} # skip seen plugins grep{ /\.so$/} readdir $dirh; # get .so files closedir $dirh; } @plugins } sub new_plugins { my $effects_cache = join_path(&project_root, $effects_cache_file); my @filenames = ladspa_plugin_list(); push @filenames, '/usr/local/share/ecasound/effect_presets', '/usr/share/ecasound/effect_presets', "$ENV{HOME}/.ecasound/effect_presets"; my $effects_cache_stamp = modified_stamp($effects_cache); my $latest; map{ my $mod = modified_stamp($_); $latest = $mod if $mod > $latest } @filenames; $latest > $effects_cache_stamp; } sub modified_stamp { # timestamp that file was modified my $filename = shift; #print "file: $filename\n"; my @s = stat $filename; $s[9]; } sub prepare_effect_index { $debug2 and print "&prepare_effect_index\n"; %effect_j = (); map{ my $code = $_; my ($short) = $code =~ /:([-\w]+)/; if ( $short ) { if ($effect_j{$short}) { warn "name collision: $_\n" } else { $effect_j{$short} = $code } }else{ $effect_j{$code} = $code }; } keys %effect_i; #print yaml_out \%effect_j; } sub extract_effects_data { $debug2 and print "&extract_effects_data\n"; my ($lower, $upper, $regex, $separator, @lines) = @_; carp ("incorrect number of lines ", join ' ',$upper-$lower,scalar @lines) if $lower + @lines - 1 != $upper; $debug and print"lower: $lower upper: $upper separator: $separator\n"; #$debug and print "lines: ". join "\n",@lines, "\n"; $debug and print "regex: $regex\n"; for (my $j = $lower; $j <= $upper; $j++) { my $line = shift @lines; $line =~ /$regex/ or carp("bad effect data line: $line\n"),next; my ($no, $name, $id, $rest) = ($1, $2, $3, $4); $debug and print "Number: $no Name: $name Code: $id Rest: $rest\n"; my @p_names = split $separator,$rest; map{s/'//g}@p_names; # remove leading and trailing q(') in ladspa strings $debug and print "Parameter names: @p_names\n"; $effects[$j]={}; $effects[$j]->{number} = $no; $effects[$j]->{code} = $id; $effects[$j]->{name} = $name; $effects[$j]->{count} = scalar @p_names; $effects[$j]->{params} = []; $effects[$j]->{display} = qq(field); map{ push @{$effects[$j]->{params}}, {name => $_} } @p_names if @p_names; ; } } sub sort_ladspa_effects { $debug2 and print "&sort_ladspa_effects\n"; # print yaml_out(\%e_bound); my $aa = $e_bound{ladspa}{a}; my $zz = $e_bound{ladspa}{z}; # print "start: $aa end $zz\n"; map{push @ladspa_sorted, 0} ( 1 .. $aa ); # fills array slice [0..$aa-1] splice @ladspa_sorted, $aa, 0, sort { $effects[$a]->{name} cmp $effects[$b]->{name} } ($aa .. $zz) ; $debug and print "sorted array length: ". scalar @ladspa_sorted, "\n"; } sub read_in_effects_data { $debug2 and print "&read_in_effects_data\n"; my $lr = eval_iam("ladspa-register"); #print $lr; my @ladspa = split "\n", $lr; # join the two lines of each entry my @lad = map { join " ", splice(@ladspa,0,2) } 1..@ladspa/2; my @preset = grep {! /^\w*$/ } split "\n", eval_iam("preset-register"); my @ctrl = grep {! /^\w*$/ } split "\n", eval_iam("ctrl-register"); my @cop = grep {! /^\w*$/ } split "\n", eval_iam("cop-register"); $debug and print "found ", scalar @cop, " Ecasound chain operators\n"; $debug and print "found ", scalar @preset, " Ecasound presets\n"; $debug and print "found ", scalar @ctrl, " Ecasound controllers\n"; $debug and print "found ", scalar @lad, " LADSPA effects\n"; # index boundaries we need to make effects list and menus $e_bound{cop}{a} = 1; $e_bound{cop}{z} = @cop; # scalar $e_bound{ladspa}{a} = $e_bound{cop}{z} + 1; $e_bound{ladspa}{b} = $e_bound{cop}{z} + int(@lad/4); $e_bound{ladspa}{c} = $e_bound{cop}{z} + 2*int(@lad/4); $e_bound{ladspa}{d} = $e_bound{cop}{z} + 3*int(@lad/4); $e_bound{ladspa}{z} = $e_bound{cop}{z} + @lad; $e_bound{preset}{a} = $e_bound{ladspa}{z} + 1; $e_bound{preset}{b} = $e_bound{ladspa}{z} + int(@preset/2); $e_bound{preset}{z} = $e_bound{ladspa}{z} + @preset; $e_bound{ctrl}{a} = $e_bound{preset}{z} + 1; $e_bound{ctrl}{z} = $e_bound{preset}{z} + @ctrl; my $cop_re = qr/ ^(\d+) # number \. # dot \s+ # spaces+ (\w.+?) # name, starting with word-char, non-greedy # (\w+) # name ,\s* # comma spaces* -(\w+) # cop_id :? # maybe colon (if parameters) (.*$) # rest /x; my $preset_re = qr/ ^(\d+) # number \. # dot \s+ # spaces+ (\w+) # name ,\s* # comma spaces* -(pn:\w+) # preset_id :? # maybe colon (if parameters) (.*$) # rest /x; my $ladspa_re = qr/ ^(\d+) # number \. # dot \s+ # spaces (.+?) # name, starting with word-char, non-greedy \s+ # spaces -(el:[-\w]+),? # ladspa_id maybe followed by comma (.*$) # rest /x; my $ctrl_re = qr/ ^(\d+) # number \. # dot \s+ # spaces (\w.+?) # name, starting with word-char, non-greedy ,\s* # comma, zero or more spaces -(k\w+):? # ktrl_id maybe followed by colon (.*$) # rest /x; extract_effects_data( $e_bound{cop}{a}, $e_bound{cop}{z}, $cop_re, q(','), @cop, ); extract_effects_data( $e_bound{ladspa}{a}, $e_bound{ladspa}{z}, $ladspa_re, q(','), @lad, ); extract_effects_data( $e_bound{preset}{a}, $e_bound{preset}{z}, $preset_re, q(,), @preset, ); extract_effects_data( $e_bound{ctrl}{a}, $e_bound{ctrl}{z}, $ctrl_re, q(,), @ctrl, ); for my $i (0..$#effects){ $effect_i{ $effects[$i]->{code} } = $i; $debug and print "i: $i code: $effects[$i]->{code} display: $effects[$i]->{display}\n"; } $debug and print "\@effects\n======\n", yaml_out(\@effects); ; } sub integrate_cop_hints { my @cop_hints = @{ yaml_in( $cop_hints_yml ) }; for my $hashref ( @cop_hints ){ #print "cop hints ref type is: ",ref $hashref, $/; my $code = $hashref->{code}; $effects[ $effect_i{ $code } ] = $hashref; } } sub ladspa_path { $ENV{LADSPA_PATH} || q(/usr/lib/ladspa); } sub get_ladspa_hints{ $debug2 and print "&get_ladspa_hints\n"; my @dirs = split ':', ladspa_path(); my $data = ''; my %seen = (); my @plugins = ladspa_plugin_list(); #pager join $/, @plugins; # use these regexes to snarf data my $pluginre = qr/ Plugin\ Name: \s+ "([^"]+)" \s+ Plugin\ Label: \s+ "([^"]+)" \s+ Plugin\ Unique\ ID: \s+ (\d+) \s+ [^\x00]+(?=Ports) # swallow maximum up to Ports Ports: \s+ ([^\x00]+) # swallow all /x; my $paramre = qr/ "([^"]+)" # name inside quotes \s+ (.+) # rest /x; my $i; for my $file (@plugins){ my @stanzas = split "\n\n", qx(analyseplugin $file); for my $stanza (@stanzas) { my ($plugin_name, $plugin_label, $plugin_unique_id, $ports) = $stanza =~ /$pluginre/ or carp "*** couldn't match plugin stanza $stanza ***"; $debug and print "plugin label: $plugin_label $plugin_unique_id\n"; my @lines = grep{ /input/ and /control/ } split "\n",$ports; my @params; # data my @names; for my $p (@lines) { next if $p =~ /^\s*$/; $p =~ s/\.{3}/10/ if $p =~ /amplitude|gain/i; $p =~ s/\.{3}/60/ if $p =~ /delay|decay/i; $p =~ s(\.{3})($ladspa_sample_rate/2) if $p =~ /frequency/i; $p =~ /$paramre/; my ($name, $rest) = ($1, $2); my ($dir, $type, $range, $default, $hint) = split /\s*,\s*/ , $rest, 5; $debug and print join( "|",$name, $dir, $type, $range, $default, $hint) , $/; # if $hint =~ /logarithmic/; if ( $range =~ /toggled/i ){ $range = q(0 to 1); $hint .= q(toggled); } my %p; $p{name} = $name; $p{dir} = $dir; $p{hint} = $hint; my ($beg, $end, $default_val, $resolution) = range($name, $range, $default, $hint, $plugin_label); $p{begin} = $beg; $p{end} = $end; $p{default} = $default_val; $p{resolution} = $resolution; push @params, { %p }; } $plugin_label = "el:" . $plugin_label; $ladspa_help{$plugin_label} = $stanza; $effects_ladspa_file{$plugin_unique_id} = $file; $ladspa_unique_id{$plugin_label} = $plugin_unique_id; $ladspa_unique_id{$plugin_name} = $plugin_unique_id; $ladspa_label{$plugin_unique_id} = $plugin_label; $effects_ladspa{$plugin_label}->{name} = $plugin_name; $effects_ladspa{$plugin_label}->{id} = $plugin_unique_id; $effects_ladspa{$plugin_label}->{params} = [ @params ]; $effects_ladspa{$plugin_label}->{count} = scalar @params; $effects_ladspa{$plugin_label}->{display} = 'scale'; } # pager( join "\n======\n", @stanzas); #last if ++$i > 10; } $debug and print yaml_out(\%effects_ladspa); } sub srate_val { my $input = shift; my $val_re = qr/( [+-]? # optional sign \d+ # one or more digits (\.\d+)? # optional decimal (e[+-]?\d+)? # optional exponent )/ix; # case insensitive e/E my ($val) = $input =~ /$val_re/; # or carp "no value found in input: $input\n"; $val * ( $input =~ /srate/ ? $ladspa_sample_rate : 1 ) } sub range { my ($name, $range, $default, $hint, $plugin_label) = @_; my $multiplier = 1;; my ($beg, $end) = split /\s+to\s+/, $range; $beg = srate_val( $beg ); $end = srate_val( $end ); $default = srate_val( $default ); $default = $default || $beg; $debug and print "beg: $beg, end: $end, default: $default\n"; if ( $name =~ /gain|amplitude/i ){ $beg = 0.01 unless $beg; $end = 0.01 unless $end; } my $resolution = ($end - $beg) / 100; if ($hint =~ /integer|toggled/i ) { $resolution = 1; } elsif ($hint =~ /logarithmic/ ) { $beg = round ( log $beg ) if $beg; $end = round ( log $end ) if $end; $resolution = ($end - $beg) / 100; $default = $default ? round (log $default) : $default; } $resolution = d2( $resolution + 0.002) if $resolution < 1 and $resolution > 0.01; $resolution = dn ( $resolution, 3 ) if $resolution < 0.01; $resolution = int ($resolution + 0.1) if $resolution > 1 ; ($beg, $end, $default, $resolution) } sub integrate_ladspa_hints { $debug2 and print "&integrate_ladspa_hints\n"; map{ my $i = $effect_i{$_}; # print("$_ not found\n"), if ($i) { $effects[$i]->{params} = $effects_ladspa{$_}->{params}; # we revise the number of parameters read in from ladspa-register $effects[$i]->{count} = scalar @{$effects_ladspa{$_}->{params}}; $effects[$i]->{display} = $effects_ladspa{$_}->{display}; } } keys %effects_ladspa; my %L; my %M; map { $L{$_}++ } keys %effects_ladspa; map { $M{$_}++ } grep {/el:/} keys %effect_i; for my $k (keys %L) { $M{$k} or $debug and print "$k not found in ecasound listing\n"; } for my $k (keys %M) { $L{$k} or $debug and print "$k not found in ladspa listing\n"; } $debug and print join "\n", sort keys %effects_ladspa; $debug and print '-' x 60, "\n"; $debug and print join "\n", grep {/el:/} sort keys %effect_i; #print yaml_out \@effects; exit; } ## generate effects help data sub prepare_effects_help { # presets map{ s/^.*? //; # remove initial number $_ .= "\n"; # add newline my ($id) = /(pn:\w+)/; # find id s/,/, /g; # to help line breaks push @effects_help, $_; #store help } split "\n",eval_iam("preset-register"); # LADSPA my $label; map{ if ( my ($_label) = /-(el:[-\w]+)/ ){ $label = $_label; s/^\s+/ /; # trim spaces s/'//g; # remove apostrophes $_ .="\n"; # add newline push @effects_help, $_; # store help } else { # replace leading number with LADSPA Unique ID s/^\d+/$ladspa_unique_id{$label}/; s/\s+$/ /; # remove trailing spaces substr($effects_help[-1],0,0) = $_; # join lines $effects_help[-1] =~ s/,/, /g; # $effects_help[-1] =~ s/,\s+$//; } } reverse split "\n",eval_iam("ladspa-register"); #my @lines = reverse split "\n",eval_iam("ladspa-register"); #pager( scalar @lines, $/, join $/,@lines); #my @crg = map{s/^.*? -//; $_ .= "\n" } # split "\n",eval_iam("control-register"); #pager (@lrg, @prg); exit; } sub automix { # get working track set my @tracks = grep{ $tn{$_}->rec_status eq 'MON' or $bn{$_} and $tn{$_}->rec_status eq 'REC' } $main->tracks; say "tracks: @tracks"; ## we do not allow automix if inserts are present say("Cannot perform automix if inserts are present. Skipping."), return if grep{$tn{$_}->prefader_insert || $tn{$_}->postfader_insert} @tracks; #use Smart::Comments '###'; # add -ev to summed signal my $ev = add_effect( { chain => $tn{Master}->n, type => 'ev' } ); ### ev id: $ev # turn off audio output $tn{Master}->set(rw => 'OFF'); ### Status before mixdown: command_process('show'); ### reduce track volume levels to 10% ## accommodate ea and eadb volume controls my $vol_operator = $cops{$tn{$tracks[0]}->vol}{type}; my $reduce_vol_command = $vol_operator eq 'ea' ? 'vol / 10' : 'vol - 10'; my $restore_vol_command = $vol_operator eq 'ea' ? 'vol * 10' : 'vol + 10'; ### reduce vol command: $reduce_vol_command for (@tracks){ command_process("$_ $reduce_vol_command") } command_process('show'); generate_setup('automix') # pass a bit of magic or say("automix: generate_setup failed!"), return; connect_transport(); # start_transport() does a rec_cleanup() on transport stop eval_iam('start'); # don't use heartbeat sleep 2; # time for engine to stabilize while( eval_iam('engine-status') ne 'finished'){ print q(.); sleep 1; update_clock_display()}; print " Done\n"; # parse cop status my $cs = eval_iam('cop-status'); ### cs: $cs my $cs_re = qr/Chain "1".+?result-max-multiplier ([\.\d]+)/s; my ($multiplier) = $cs =~ /$cs_re/; ### multiplier: $multiplier remove_effect($ev); # deal with all silence case, where multiplier is 0.00000 if ( $multiplier < 0.00001 ){ say "Signal appears to be silence. Skipping."; for (@tracks){ command_process("$_ $restore_vol_command") } $tn{Master}->set(rw => 'MON'); return; } ### apply multiplier to individual tracks for (@tracks){ command_process( "$_ vol*$multiplier" ) } ### mixdown command_process('mixdown; arm; start'); ### turn on audio output # command_process('mixplay'); # rec_cleanup does this automatically #no Smart::Comments; } 1; __END__Audio-Nama-1.078/lib/Audio/Nama/Fade.pm0000644000175000017500000001747511623337667016416 0ustar jrothjroth# ----------- Fade ------------ package Audio::Nama::Fade; use Modern::Perl; use List::Util qw(min); our $VERSION = 1.0; use Carp; use warnings; no warnings qw(uninitialized); our @ISA; use vars qw($n %by_index $fade_down_fraction $fade_time1_fraction $fade_time2_fraction $fader_op); use Audio::Nama::Object qw( n type mark1 mark2 duration relation track class ); initialize(); # example # # if fade time is 10 for a fade out # and fade start time is 0: # # from 0 to 9, fade from 0 (100%) to -64db # from 9 to 10, fade from -64db to -256db sub initialize { %by_index = (); @Audio::Nama::fade_data = (); # for save/restore } sub next_n { my $n = 1; while( $by_index{$n} ){ $n++} $n } sub new { my $class = shift; my %vals = @_; croak "undeclared field: @_" if grep{ ! $_is_field{$_} } keys %vals; my $object = bless { # class => $class, # not needed yet n => next_n(), relation => 'fade_from_mark', @_ }, $class; $by_index{$object->n} = $object; #print "object class: $class, object type: ", ref $object, $/; my $id = add_fader($object->track); # only when necessary my $track = $Audio::Nama::tn{$object->track}; # add linear envelope controller -klg if needed refresh_fade_controller($track); $object } # helper routines sub refresh_fade_controller { my $track = shift; my %mute_level = (ea => 0, eadb => -256); my $operator = $Audio::Nama::cops{$track->fader}->{type}; my $off_level = $mute_level{$operator}; my $on_level = $Audio::Nama::unity_level{$operator}; # remove controller if present if( $track->fader and my ($old) = @{$Audio::Nama::cops{$track->fader}{owns}}) { Audio::Nama::remove_effect($old) } return unless my @pairs = fader_envelope_pairs($track); # add fader if it is missing add_fader($track->name); # add controller Audio::Nama::Text::t_add_ctrl($track->fader, # parent 'klg', # Ecasound controller [1, # Ecasound parameter 1 $off_level, $on_level, @pairs, ] ); # set fader to correct initial value # first fade is type 'in' : 0 # first fade is type 'out' : 100% Audio::Nama::effect_update_copp_set($track->fader,0, initial_level($track->name)) } sub all_fades { my $track_name = shift; grep{ $_->track eq $track_name } values %by_index } sub fades { # get fades within playable region my $track_name = shift; my $track = $Audio::Nama::tn{$track_name}; my @fades = all_fades($track_name); if($Audio::Nama::offset_run_flag){ # get end time my $length = $track->wav_length; my $play_end = Audio::Nama::play_end_time(); my $play_end_time = $play_end ? min($play_end, $length) : $length; # get start time my $play_start_time = Audio::Nama::play_start_time(); # throw away fades that are not in play region @fades = grep { my $time = $Audio::Nama::Mark::by_name{$_->mark1}->{time}; $time >= $play_start_time and $time <= $play_end_time } @fades } # sort remaining fades by unadjusted mark1 time sort{ $Audio::Nama::Mark::by_name{$a->mark1}->{time} <=> $Audio::Nama::Mark::by_name{$b->mark1}->{time} } @fades; } # our envelope must include a straight segment from the # beginning of the track (or region) to the fade # start. Similarly, we need a straight segment # from the last fade to the track (or region) end # - If the first fade is a fade-in, the straight # segment will be at zero-percent level # (otherwise 100%) # # - If the last fade is fade-out, the straight # segment will be at zero-percent level # (otherwise 100%) # although we can get the precise start and endpoints, # I'm using 0 and $track->adjusted_playat_time + track length sub initial_level { # return 0, 1 or undef my $track_name = shift; my @fades = fades($track_name) or return undef; # if we fade in we'll hold level zero from beginning (scalar @fades and $fades[0]->type eq 'in') ? 0 : 1 } sub exit_level { my $track_name = shift; my @fades = fades($track_name) or return undef; # if we fade out we'll hold level zero from end (scalar @fades and $fades[-1]->type eq 'out') ? 0 : 1 } sub initial_pair { # duration: zero to... my $track_name = shift; my $init_level = initial_level($track_name); defined $init_level or return (); (0, $init_level ) } sub final_pair { # duration: .... to length my $track_name = shift; my $exit_level = exit_level($track_name); defined $exit_level or return (); my $track = $Audio::Nama::tn{$track_name}; ( $track->adjusted_playat_time + $track->wav_length, $exit_level ); } sub fader_envelope_pairs { # return number_of_pairs, pos1, val1, pos2, val2,... my $track = shift; my @fades = fades($track->name); my @specs; for my $fade ( @fades ){ # calculate fades my $marktime1 = Audio::Nama::Mark::mark_time($fade->mark1); my $marktime2 = Audio::Nama::Mark::mark_time($fade->mark2); if ($marktime2) {} # nothing to do elsif( $fade->relation eq 'fade_from_mark') { $marktime2 = $marktime1 + $fade->duration } elsif( $fade->relation eq 'fade_to_mark') { $marktime2 = $marktime1; $marktime1 -= $fade->duration } else { $fade->dumpp; die "fade processing failed" } #say "marktime1: $marktime1"; #say "marktime2: $marktime2"; push @specs, [ $marktime1, $marktime2, $fade->type, $Audio::Nama::cops{$track->fader}->{type}, ]; } # sort fades # already done! XXX @specs = sort{ $a->[0] <=> $b->[0] } @specs; #say( Audio::Nama::yaml_out( \@specs)); my @pairs = map{ spec_to_pairs($_) } @specs; # XXX results in bug via AUTOLOAD for EditTrack # @pairs = (initial_pair($track->name), @pairs, final_pair($track->name)); # add flat segments # - from start to first fade # - from last fade to end # prepend number of pairs; unshift @pairs, (scalar @pairs / 2); @pairs; } # each 'spec' is an array reference of the form [ $from, $to, $type, $op ] # # $from: time (in seconds) # $to: time (in seconds) # $type: 'in' or 'out' # $op: 'ea' or 'eadb' sub spec_to_pairs { my ($from, $to, $type, $op) = @{$_[0]}; $Audio::Nama::debug and say "from: $from, to: $to, type: $type"; my $cutpos; my @pairs; # op 'eadb' uses two-stage fade if ($op eq 'eadb'){ if ( $type eq 'out' ){ $cutpos = $from + $fade_time1_fraction * ($to - $from); push @pairs, ($from, 1, $cutpos, $fade_down_fraction, $to, 0); } elsif( $type eq 'in' ){ $cutpos = $from + $fade_time2_fraction * ($to - $from); push @pairs, ($from, 0, $cutpos, $fade_down_fraction, $to, 1); } } # op 'ea' uses one-stage fade elsif ($op eq 'ea'){ if ( $type eq 'out' ){ push @pairs, ($from, 1, $to, 0); } elsif( $type eq 'in' ){ push @pairs, ($from, 0, $to, 1); } } else { die "missing or illegal fader op: $op" } @pairs } # the following routine makes it possible to # remove an edit fade by the name of the edit mark # ???? does it even work? sub remove_by_mark_name { my $mark1 = shift; my ($i) = map{ $_->n} grep{ $_->mark1 eq $mark1 } values %by_index; remove($i) if $i; } sub remove_by_index { my $i = shift; my $fade = $by_index{$i}; $fade->remove; } sub remove { my $fade = shift; my $track = $Audio::Nama::tn{$fade->track}; my $i = $fade->n; # remove object from index delete $by_index{$i}; # remove fader entirely if this is the last fade on the track my @track_fades = all_fades($fade->track); if ( ! @track_fades ){ Audio::Nama::remove_effect($track->fader); $Audio::Nama::tn{$fade->track}->set(fader => undef); } else { refresh_fade_controller($track) } } sub add_fader { my $name = shift; my $track = $Audio::Nama::tn{$name}; my $id = $track->fader; # create a fader if necessary if (! $id){ my $first_effect = $track->ops->[0]; if ( $first_effect ){ $id = Audio::Nama::Text::t_insert_effect($first_effect, $fader_op, [0]); } else { $id = Audio::Nama::Text::t_add_effect($fader_op, [0]) } $track->set(fader => $id); } $id } 1;Audio-Nama-1.078/lib/Audio/Nama/Terminal_subs.pm0000644000175000017500000001003411623337670020340 0ustar jrothjroth# ----------- Terminal related subroutines --------- package Audio::Nama; use Modern::Perl; no warnings 'uninitialized'; use Carp; our ( $term, $attribs, $this_bus, $this_track, %event_id, $debug, $debug2, %effect_j, $press_space_to_start_transport, $use_pager, $previous_text_command, @keywords, %commands, %iam_cmd, %midish_command, $midish_enable, ); sub issue_first_prompt { $term->stuff_char(10); # necessary to respond to Ctrl-C at first prompt &{$attribs->{'callback_read_char'}}(); set_current_bus(); print prompt(); $attribs->{already_prompted} = 0; } sub initialize_terminal { $term = new Term::ReadLine("Ecasound/Nama"); $attribs = $term->Attribs; $attribs->{attempted_completion_function} = \&complete; $attribs->{already_prompted} = 1; detect_spacebar(); # if $press_space_to_start_transport; revise_prompt(); # handle Control-C from terminal $SIG{INT} = \&cleanup_exit; $SIG{USR1} = sub { save_state() }; #$event_id{sigint} = AE::signal('INT', \&cleanup_exit); } {my $override; sub revise_prompt { # hack to allow suppressing prompt $override = $_[0] eq "default" ? undef : $_[0] if defined $_[0]; $term->callback_handler_install($override//prompt(), \&process_line); } } sub prompt { "nama [". ($this_bus eq 'Main' ? '': "$this_bus/"). ($this_track ? $this_track->name : '') . "] ('h' for help)> " } sub check_for_spacebar_hit { $event_id{stdin} = AE::io(*STDIN, 0, sub { &{$attribs->{'callback_read_char'}}(); if ( $attribs->{line_buffer} eq " " ){ toggle_transport(); $attribs->{line_buffer} = q(); $attribs->{point} = 0; $attribs->{end} = 0; $term->stuff_char(10); &{$attribs->{'callback_read_char'}}(); } }); } sub detect_spacebar { $event_id{stdin} = undef; # clean up after get_edit_mark() check_for_spacebar_hit() if $press_space_to_start_transport; } sub pager { $debug2 and print "&pager\n"; my @output = @_; my ($screen_lines, $columns) = $term->get_screen_size(); my $line_count = 0; map{ $line_count += $_ =~ tr(\n)(\n) } @output; if ( $use_pager and $line_count > $screen_lines - 2) { my $fh = File::Temp->new(); my $fname = $fh->filename; print $fh @output; file_pager($fname); } else { print @output; } print "\n\n"; } sub file_pager { $debug2 and print "&file_pager\n"; my $fname = shift; if (! -e $fname or ! -r $fname ){ carp "file not found or not readable: $fname\n" ; return; } my $pager = $ENV{PAGER} || "/usr/bin/less"; my $cmd = qq($pager $fname); system $cmd; } 1; # command line processing routines sub get_ecasound_iam_keywords { my %reserved = map{ $_,1 } qw( forward fw getpos h help rewind quit q rw s setpos start stop t ? ); local $debug = 0; %iam_cmd = map{$_,1 } grep{ ! $reserved{$_} } split /[\s,]/, eval_iam('int-cmd-list'); } sub process_line { $debug2 and print "&process_line\n"; my ($user_input) = @_; $debug and print "user input: $user_input\n"; if (defined $user_input and $user_input !~ /^\s*$/) { $term->addhistory($user_input) unless $user_input eq $previous_text_command; $previous_text_command = $user_input; command_process( $user_input ); reconfigure_engine(); revise_prompt(); } } sub load_keywords { @keywords = keys %commands; push @keywords, grep{$_} map{split " ", $commands{$_}->{short}} @keywords; push @keywords, keys %iam_cmd; push @keywords, keys %effect_j; push @keywords, keys %midish_command if $midish_enable; push @keywords, "Audio::Nama::"; } sub complete { my ($text, $line, $start, $end) = @_; # print join $/, $text, $line, $start, $end, $/; return $term->completion_matches($text,\&keyword); }; { my $i; sub keyword { my ($text, $state) = @_; return unless $text; if($state) { $i++; } else { # first call $i = 0; } for (; $i<=$#keywords; $i++) { return $keywords[$i] if $keywords[$i] =~ /^\Q$text/; }; return undef; } }; 1; __END__Audio-Nama-1.078/lib/Audio/Nama.pm0000644000175000017500000040771411623337667015556 0ustar jrothjroth## Note on object model # # All graphic method are defined in the base class Audio::Nama . # These are overridden in the Audio::Nama::Text class with no-op stubs. # How is $ui->init_gui interpreted? If $ui is class Audio::Nama::Text # Nama finds a no-op init_gui stub in package Audio::Nama::Text. # # If $ui is class Audio::Nama::Graphical, # Nama looks for init_gui() in package Audio::Nama::Graphical, # finds nothing, so goes to look in the root namespace :: # of which Audio::Nama::Text and Audio::Nama::Graphical are both descendants. # All the routines in Graphical_methods.pl can consider # themselves to be in the base class, and can call base # class subroutines without a package prefix # Text_method.pl subroutines live in the Audio::Nama::Text class, # and so they must use the Audio::Nama prefix when calling # subroutines in the base class. # # However because both subclass packages occupy the same file as # the base class package, all variables (defined by 'our') can # be accessed without a package prefix. package Audio::Nama; require 5.10.0; use vars qw($VERSION); $VERSION = 1.078; use Modern::Perl; #use Carp::Always; no warnings qw(uninitialized syntax); use autodie qw(:default); use Carp; use Cwd; use Data::Section -setup; use File::Find::Rule; use File::Path; use File::Spec; use File::Spec::Link; use File::Temp; use Getopt::Long; use Graph; use IO::Socket; use IO::Select; use IPC::Open3; use Module::Load::Conditional qw(can_load); use Parse::RecDescent; use Storable; use Term::ReadLine; use Text::Format; # use File::HomeDir;# Assign.pm # use File::Slurp; # several # use List::Util; # Fade.pm # use Time::HiRes; # automatically detected # use Tk; # loaded conditionally # use Event; # loaded conditionally # use AnyEvent; # loaded after Tk or Event ## Load my modules use Audio::Nama::Assign qw(:all); use Audio::Nama::Track; use Audio::Nama::Group; use Audio::Nama::Bus; use Audio::Nama::Mark; use Audio::Nama::IO; use Audio::Nama::Graph; use Audio::Nama::Wav; use Audio::Nama::Insert; use Audio::Nama::Fade; use Audio::Nama::Edit; use Audio::Nama::Text; use Audio::Nama::Graphical; # the following separate out functionality # however occupy the Audio::Nama namespace use Audio::Nama::Initialize_subs (); use Audio::Nama::Option_subs (); use Audio::Nama::Config_subs (); use Audio::Nama::Terminal_subs (); use Audio::Nama::Wavinfo_subs (); use Audio::Nama::Project_subs (); use Audio::Nama::Mode_subs (); use Audio::Nama::ChainSetup (); use Audio::Nama::Engine_setup_subs (); use Audio::Nama::Engine_cleanup_subs (); use Audio::Nama::Realtime_subs (); use Audio::Nama::Mute_Solo_Fade (); use Audio::Nama::Jack_subs (); use Audio::Nama::Region_subs (); use Audio::Nama::Effect_chain_subs (); use Audio::Nama::Midi_subs (); use Audio::Nama::Memoize_subs (); use Audio::Nama::CacheTrack (); use Audio::Nama::Effect_subs (); use Audio::Nama::Persistence (); use Audio::Nama::Util qw( rw_set process_is_running d1 d2 dn colonize time_tag heuristic_time dest_type channels signal_format dest_type input_node output_node ); ## Definitions ## $| = 1; # flush STDOUT buffer on every write # 'our' declaration: code in all packages in Nama.pm can address # the following variables without package name prefix our ( # category: fixed $banner, $debug, # debug level flags for diagnostics $debug2, # for subroutine names as execute $debug3, # deprecated # category: help $help_screen, @help_topic, # array of help categories %help_topic, # help text indexed by topic # category: text UI $use_pager, # display lengthy output data using pager $use_placeholders, # use placeholders in show_track output $grammar, # filled by Grammar.pm $parser, # for the objected created by Parse::RecDescent $text_wrap, # Text::Format object @format_fields, # data for replies to text commands $commands_yml, # commands.yml as string %commands, # created from commands.yml %iam_cmd, # dictionary of Ecasound IAM commands @nama_commands, %nama_commands, # as hash $term, # Term::ReadLine object $previous_text_command, # to check for repetition @keywords, # for autocompletion $prompt, $attribs, # Term::Readline::Gnu object $format_top, # show_tracks listing $format_divider, $custom_pl, # default customization file %user_command, %user_alias, # category: UI $ui, # object providing class behavior for graphic/text functions # category: serialization @persistent_vars, # a set of variables we save @effects_static_vars,# the list of which variables to store and retrieve @config_vars, # contained in config file # category: config %opts, # command line options $default, # the internal default configuration file, as string # category: routing $preview, # for preview and doodle modes # category: engine, realtime operation $ecasound, # the name to invoke when we want to kill ecasound @ecasound_pids, # processes started by Nama $e, # the name of the variable holding # the Ecasound engine object. $run_time, # engine processing time limit (none if undef) $seek_delay, # delay to allow engine to seek # under JACK before restart $fade_time, # duration for fadein(), fadeout() # category: MIDI %midish_command, # keywords listing $midi_input_dev, $midi_output_dev, $controller_ports, # where we listen for MIDI messages $midi_inputs, # on/off/capture # category: view waveform $waveform_viewer, # mhwaveedit at present # category: filenames $effects_cache_file, # where we keep info on Ecasound # and LADSPA effects, presets, etc. $state_store_file, # filename for storing @persistent_vars $effect_chain_file, # for storing effect chains $effect_profile_file, # for storing effect templates $chain_setup_file, # Ecasound uses this $user_customization_file, # category: pronouns $this_track, # the currently active track -- # used by Text UI only at present $this_mark, # current mark # for future $this_bus, # current bus $this_edit, # current edit # category: project $project_name, # current project name # buses $main_bus, $main, # main group $null_bus, $null, # null group @system_buses, %is_system_bus, # aliases %ti, # track by index (alias to %Audio::Nama::Track::by_index) %tn, # track by name (alias to %Audio::Nama::Track::by_name) %bn, # bus by name (alias to %Audio::Nama::Bus::by_name) # category: effects $magical_cop_id, # cut through five levels of subroutines $cop_hints_yml, # ecasound effects hints %offset, # index by chain, offset for user-visible effects # pertains to engine @mastering_effect_ids, # effect ids for mastering mode $tkeca_effects_data, # original tcl code, actually %L, %M, @already_muted, # for soloing, a list of Track objects that are # muted before we begin $soloing, # one user track is on, all others are muted %effect_chain, # named effect sequences %effect_profile, # effect chains for multiple tracks %mute_level, # 0 for ea as vol control, -127 for eadb %fade_out_level, # 0 for ea, -40 for eadb $fade_resolution, # steps per second %unity_level, # 100 for ea, 0 for eadb $default_fade_length, # category: external resources (ALSA, JACK, etc.) $jack_system, # jack soundcard device $jack_running, # jackd server status $jack_plumbing, # jack.plumbing daemon status $jack_lsp, # jack_lsp -Ap $fake_jack_lsp, # for testing %jack, # jack clients data from jack_lsp $sampling_frequency, # of souncard # category: events %event_id, # events will store themselves with a key %duplicate_inputs, # named tracks will be OFF in doodle mode %already_used, # source => used_by $memoize, # do I cache this_wav_dir? $hires, # do I have Timer::HiRes? $old_snapshot, # previous status_snapshot() output # to check if I need to reconfigure engine %old_rw, # previous track rw settings (indexed by track name) @mastering_track_names, # reserved for mastering mode $disable_auto_reconfigure, # for debugging %cooked_record_pending, # an intermediate mixdown for tracks $sock, # socket for Net-ECI mode %versions, # store active versions for use after engine run $track_snapshots, # to save recalculating for each IO object $regenerate_setup, # force us to generate new chain setup %wav_info, # caches path/length/format/modify-time # category: edits $offset_run_flag, # indicates edit or offset_run mode $offset_run_start_time, $offset_run_end_time, $offset_mark, @edit_points, $edit_playback_end_margin, # play a little more after edit recording finishes $edit_crossfade_time, $last_edit_name, # for save/restore # category: Graphical UI, GUI $tk_input_channels,# for menubutton # variables for GUI text input widgets $project, $track_name, $ch_r, # recording channel assignment $ch_m, # monitoring channel assignment $save_id, # name for save file $default_palette_yml, # default GUI colors # Widgets $mw, # main window $ew, # effects window $canvas, # to lay out the effects window # each part of the main window gets its own frame # to control the layout better $load_frame, $add_frame, $group_frame, $time_frame, $clock_frame, $oid_frame, $track_frame, $effect_frame, $iam_frame, $perl_eval_frame, $transport_frame, $mark_frame, $fast_frame, # forward, rewind, etc. ## collected widgets (i may need to destroy them) %parent, # ->{mw} = $mw; # main window # ->{ew} = $ew; # effects window # eventually will contain all major frames $group_label, $group_rw, # $group_version, # %track_widget, # for chains (tracks) %track_widget_remove, # what to destroy by remove_track %effects_widget, # for effects @widget_o, # for templates (oids) %widget_o, # %mark_widget, # marks @global_version_buttons, # to set the same version for # all tracks $markers_armed, # set true to enable removing a mark $mark_remove, # a button that sets $markers_armed $time_step, # widget shows jump multiplier unit (seconds or minutes) $clock, # displays clock $setup_length, # displays setup running time $project_label, # project name $sn_label, # project load/save/quit $sn_text, $sn_load, $sn_new, $sn_quit, $sn_palette, # configure default master window colors $sn_namapalette, # configure nama-specific master-window colors $sn_effects_palette, # configure effects window colors @palettefields, # set by setPalette method @namafields, # field names for color palette used by nama %namapalette, # nama's indicator colors %palette, # overall color scheme $rec, # background color $mon, # background color $off, # background color $palette_file, # where to save selections ### A separate box for entering IAM (and other) commands $iam_label, $iam_text, $iam, # variable for text entry $iam_execute, $iam_error, # unused # add track gui # $build_track_label, $build_track_text, $build_track_add_mono, $build_track_add_stereo, $build_track_rec_label, $build_track_rec_text, $build_track_mon_label, $build_track_mon_text, $build_new_take, # transport controls $transport_label, $transport_setup_and_connect, $transport_setup, # unused $transport_connect, # unused $transport_disconnect, $transport_new, $transport_start, $transport_stop, $old_bg, # initial background color. $old_abg, # initial active background color $sn_save_text,# text entry widget $sn_save, # button to save settings $sn_recall, # button to recall settings # end $saved_version, $cop_id, %cops, %copp, %copp_exp, $unit, %oid_status, @tracks_data, @bus_data, @groups_data, @marks_data, @fade_data, @edit_data, @inserts_data, @loop_endpoints, $loop_enable, $length, %bunch, @command_history, $mastering_mode, $this_track_name, $this_op, %devices, $alsa_playback_device, $alsa_capture_device, $soundcard_channels, %abbreviations, $mix_to_disk_format, $raw_to_disk_format, $cache_to_disk_format, $mixer_out_format, $ladspa_sample_rate, $ecasound_tcp_port, $ecasound_globals_realtime, $ecasound_globals_default, $project_root, $use_group_numbering, $press_space_to_start_transport, $execute_on_project_load, $initial_user_mode, $autosave_interval, $midish_enable, $quietly_remove_tracks, $use_jack_plumbing, $jack_seek_delay, $use_monitor_version_for_mixdown, $volume_control_operator, $mastering_effects, $eq, $low_pass, $mid_pass, $high_pass, $compressor, $spatialiser, $limiter, @effects, %effect_i, %effect_j, @effects_help, @ladspa_sorted, %effects_ladspa, %effects_ladspa_file, %ladspa_unique_id, %ladspa_label, %ladspa_help, %e_bound, ); @config_vars = qw( %devices $alsa_playback_device $alsa_capture_device $soundcard_channels %abbreviations $mix_to_disk_format $raw_to_disk_format $cache_to_disk_format $mixer_out_format $ladspa_sample_rate $ecasound_tcp_port $ecasound_globals_realtime $ecasound_globals_default $project_root $use_group_numbering $press_space_to_start_transport $execute_on_project_load $initial_user_mode $autosave_interval $midish_enable $quietly_remove_tracks $use_jack_plumbing $jack_seek_delay $use_monitor_version_for_mixdown $volume_control_operator $mastering_effects $eq $low_pass $mid_pass $high_pass $compressor $spatialiser $limiter ); @persistent_vars = qw( $saved_version $cop_id %cops %copp %copp_exp $unit %oid_status @tracks_data @bus_data @groups_data @marks_data @fade_data @edit_data @inserts_data @loop_endpoints $loop_enable $length %bunch @command_history $mastering_mode $this_track_name $this_op ); @effects_static_vars = qw( @effects %effect_i %effect_j @effects_help @ladspa_sorted %effects_ladspa %effects_ladspa_file %ladspa_unique_id %ladspa_label %ladspa_help %e_bound ); $text_wrap = new Text::Format { columns => 75, firstIndent => 0, bodyIndent => 0, tabstop => 4, }; $debug2 = 0; # subroutine names $debug = 0; # debug statements $banner = < 0, eadb => -96); %fade_out_level = (ea => 0, eadb => -40); %unity_level = (ea => 100, eadb => 0); $fade_resolution = 200; # steps per second $default_fade_length = 0.5; # for fade-in, fade-out $edit_playback_end_margin = 3; $edit_crossfade_time = 0.03; # $Audio::Nama::Fade::fade_down_fraction = 0.75; $Audio::Nama::Fade::fade_time1_fraction = 0.9; $Audio::Nama::Fade::fade_time2_fraction = 0.1; $Audio::Nama::Fade::fader_op = 'ea'; @mastering_track_names = qw(Eq Low Mid High Boost); $mastering_mode = 0; init_memoize() if $memoize; # aliases for concise access *bn = \%Audio::Nama::Bus::by_name; *tn = \%Audio::Nama::Track::by_name; *ti = \%Audio::Nama::Track::by_index; # $ti{3}->rw sub setup_grammar { } ### COMMAND LINE PARSER $debug2 and print "Reading grammar\n"; *commands_yml = __PACKAGE__->section_data("commands_yml"); $commands_yml = quote_yaml_scalars($commands_yml); *cop_hints_yml = __PACKAGE__->section_data("chain_op_hints_yml"); %commands = %{ Audio::Nama::yaml_in( $Audio::Nama::commands_yml) }; $Audio::Nama::AUTOSTUB = 1; $Audio::Nama::RD_TRACE = 1; $Audio::Nama::RD_ERRORS = 1; # Make sure the parser dies when it encounters an error $Audio::Nama::RD_WARN = 1; # Enable warnings. This will warn on unused rules &c. $Audio::Nama::RD_HINT = 1; # Give out hints to help fix problems. *grammar = __PACKAGE__->section_data("grammar"); $parser = Parse::RecDescent->new($grammar) or croak "Bad grammar!\n"; @help_topic = qw( all project track chain_setup transport marks effects group bus mixdown prompt diagnostics fades edits ) ; %help_topic = ( help => < - show help for help - show help for commands matching // help - invoke analyseplugin for info on a LADSPA id help - list commands under help - list commands under (lower case) help yml - browse command source file HELP project => < < <