view release on metacpan or  search on metacpan

lib/Audio/Nama/Grammar.pm  view on Meta::CPAN

# --------------------- Command Grammar ----------------------

package Audio::Nama;
use Audio::Nama::Effect  qw(:all);
use Modern::Perl '2020';

sub setup_grammar {

	### COMMAND LINE PARSER 

	logsub((caller(0))[3]);

	$text->{commands_yml} = get_data_section("commands_yml");
	$text->{commands_yml} = quote_yaml_scalars($text->{commands_yml});
	$text->{commands} = yaml_in( $text->{commands_yml}) ;
	map
	{ 
		my $full_name = $_; 
		my $shortcuts = $text->{commands}->{$full_name}->{short};
		my @shortcuts = ();
		@shortcuts = split " ", $shortcuts if $shortcuts;
		map{ $text->{command_shortcuts}->{$_} = $full_name } @shortcuts;

	} keys %{$text->{commands}};

	$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.

	$text->{grammar} = get_data_section('grammar');

	$text->{parser} = Parse::RecDescent->new($text->{grammar}) or croak "Bad grammar!\n";

	# Midish command keywords
	
	# prepend 'm' to all midish commands
	# suppress midi record, play, stop commands - Nama will handle them
	# also suppress ct tnew tdel tren
	my %skip = map{$_, 1} qw(r p s ct tnew tdel tren);

	$text->{midi_cmd} = 
	{
		map{ 'm'.$_, 1} grep{ !$skip{$_} } split " ", get_data_section("midi_commands")
	};
	for (keys %{$text->{midi_cmd}}){
		say "$_: midi command same as Nama command" if $text->{commands}->{$_}
	}

}
sub process_line {
	state $total_effects_count;
	logsub((caller(0))[3]);
	no warnings 'uninitialized';
	my ($user_input) = @_;
	logpkg(__FILE__,__LINE__,'debug',"user input: $user_input");
	if (defined $user_input and $user_input !~ /^\s*$/) {
		$term->addhistory($user_input) 
			unless $user_input eq $text->{previous_cmd} or ! $term;
		$text->{previous_cmd} = $user_input;
		
		# convert hyphenated commands to underscore form
		while( my($from, $to) = each %{$text->{hyphenated_commands}} ){ $user_input =~ s/$from/$to/g }
			my $context = context();