view release on metacpan or  search on metacpan

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

		use_popup => 0, 
		ignore_case => 1); 

	my $backspace  = sub { 
		my $stop_pos = length prompt();
		$entry->text_delete( $entry->position - 1, 1 ) 
			unless $entry->position <= $stop_pos 
	};
	my $left = sub { 
		my $stop_pos = length prompt();
		$entry->set_position( $entry->position - 1 ) 
			unless $entry->position <= $stop_pos 
	};

	my $spacebar = sub {
		if ( $config->{press_space_to_start}
				and $entry->position == length prompt()
				and ! ($mode->song or $mode->live) )
		{ toggle_transport() }
		else { $entry->on_text(' ') }
	};

	$entry->bind_keys( 
	'Up' 		=> sub { previous_command() }, 
	'Down'		=> sub { next_command()     }, 
	'Left'		=> $left,
	'C-a'	  	=> sub { $entry->set_position( length prompt() ) },
	'Home'  	=> sub { $entry->set_position( length prompt() ) },
	'C-k'		=> sub { $entry->text_delete(  $entry->position, 999) },
	'C-u'   	=> sub { $entry->text_delete(  
							length prompt(), 
							$entry->position - length prompt() ) },
	'C-h'   	=> $backspace,
	'Backspace' => $backspace,
    ' '			=> $spacebar,
	'C-z'		=> \&suspend,
	); 

}

sub suspend
{
	$term->pause;
	kill STOP => $$;
	$term->resume;
}

sub show_prompt {
	$entry->set_text(prompt());
	$entry->set_position(99); 
}
 
sub print_to_terminal (@text) {
	return unless defined $scroller;
	chomp for @text;
	$scroller->push( Tickit::Widget::Scroller::Item::Text->new( join ' ', @text ));
	$scroller->scroll_to_bottom;
}

sub prompt { 
	logsub((caller(0))[3]);
		my $prompt = join ' ', 'nama', git_branch_display(), bus_track_display(),'> ';
}
sub next_command {
	$text->{command_index}++ unless $text->{command_index} == scalar $text->{command_history}->@*;
	print_command();
}
sub previous_command {
	$text->{command_index}-- unless $text->{command_index} == 0;
	print_command();
}
sub print_command {
	$entry->set_text(prompt().$text->{command_history}->[$text->{command_index}]);
	$entry->set_position(99);
}
 
sub command {
	substr( $entry->text, length prompt() )
}

}
our ($old_output_fh);
sub redirect_stdout {
	open(FH, '>', '/dev/null') or die; 
	FH->autoflush;
	$old_output_fh = select FH;
   	tie *FH, 'Tie::Simple', '', 
     		WRITE     => sub {  },
			PRINT 		=> sub { my $text = $_[1]; print_to_terminal($text) },
             PRINTF    => sub {  },
             READ      => sub {  },
             READLINE  => sub {  },
             GETC      => sub {  },
             CLOSE     => sub {  };
			
}
BEGIN { $SIG{__WARN__} = \&filter_print_to_terminal }
$SIG{INT} = \&cleanup_exit;
sub filter_print_to_terminal {
	print_to_terminal(@_) unless $_[0] =~ /ScrollBox/;
}

sub restore_stdout {
	select $old_output_fh;
	close FH;
}

sub end_of_list_sound { system( $config->{hotkey_beep} ) }

sub previous_track {
	end_of_list_sound(), return if $this_track->n == 1;
	do{ $this_track = $ti{$this_track->n - 1} } until !  $this_track->hide;
}
sub next_track {
	end_of_list_sound(), return if ! $ti{ $this_track->n + 1 };
	do{ $this_track = $ti{$this_track->n + 1} } until ! $this_track->hide;
}
sub previous_effect {
	my $op = $this_track->op;
	my $pos = $this_track->pos;
	end_of_list_sound(), return if $pos == 0;
	$pos--;
	set_current_op($this_track->ops->[$pos]);
}
sub next_effect {
	my $op = $this_track->op;
	my $pos = $this_track->pos;
	end_of_list_sound(),return if $pos == scalar @{ $this_track->ops } - 1;
	$pos++;
	set_current_op($this_track->ops->[$pos]);
}
sub previous_param {
	my $param = $this_track->param;
	$param > 1  ? set_current_param($this_track->param - 1)
				: end_of_list_sound()
}
sub next_param {
	my $param = $this_track->param;
	$param < scalar @{ fxn($this_track->op)->params }
		? $project->{current_param}->{$this_track->op}++ 
		: end_of_list_sound()
}
{my $override;
sub revise_prompt {
}
=comment
	logsub((caller(0))[3]);
	# hack to allow suppressing prompt
	$override = ($_[0] eq "default" ? undef : $_[0]) if defined $_[0];
    $override//prompt()
=cut
}

sub throw {
	logsub((caller(0))[3]);
	pager_newline(@_)
}
sub pagers { &pager_newline(join "",@_) } # pass arguments along

sub pager_newline { 

	# Add a newline if necessary to each line
	# push them onto the output buffer
	# print them to the screen
	
	my @lines = @_;
	for (@lines){ $_ .= "\n" if  ! /\n$/ }
	print(@lines);
}

sub paging_allowed {

		# The pager interferes with GUI and testing
		# so do not use the pager in these conditions
		# or if use_pager config variable is not set.
		
		$config->{use_pager} 
		and ! $config->{opts}->{T}
}
sub pager {

	# push array onto output buffer, add two newlines
	# and print on terminal or view in pager
	# as appropriate
	
	logsub((caller(0))[3]);
	my @output = @_;
	@output or return;
	chomp $output[-1];
	$output[-1] .= "\n\n";
	@output = map{"$_\n"} map{ split "\n"} @output;
	return unless scalar @output;
	print for @output;
}
sub file_pager {};
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
									?	);
	
	%{$text->{iam}} = map{$_,1 } 
				grep{ ! $reserved{$_} } split /[\s,]/, ecasound_iam('int-cmd-list');
}
sub load_keywords {
	my @keywords = keys %{$text->{commands}};
 	# complete hyphenated forms as well
 	my %hyphenated = map{my $h = $_; $h =~ s/_/-/g; $h => $_ }grep{ /_/ } @keywords;
	$text->{hyphenated_commands} = \%hyphenated;
	push @keywords, keys %hyphenated;
	push @keywords, keys %{$text->{iam}};
	push @keywords, keys %{$text->{midi_cmd}} if $config->{use_midi};
	$text->{keywords}    = [sort {$a cmp $b} @keywords ];
	$text->{autocomplete_keywords}->@* = grep { not /_/ } $text->{keywords}->@*;
	$text->{executables} = [sort {$a cmp $b} executables()];
	$text->{project_list} = project_list();
	$text->{effects}     =  [sort {$a cmp $b} keys $fx_cache->{partial_label_to_full}->%*];
}

sub project_list { 
	my $root = path(project_root());
	[ sort { $a cmp $b }
	 	map { $_-> basename } 
		grep { -d } 
		$root->children ]; 
}

sub gen_words {
	state $pwd = path(getcwd);
	my %args = @_;
	my $word = $args{word};