#!/usr/bin/perl

use strict;  # original code by tybalt89 https://perlmonks.org/?node_id=11150326
use warnings;    # constant autocomplete
use List::Util qw( uniq );
use Term::ReadKey;
$| = 1;
print "PID $$\n";
my $debug = $ARGV[0] ? 1 : 0;

my @animals = (qw( cow camel dog cat  ));
my @foods   = (qw( fish pasture meat  ));
my @places  = (qw( wood sea    desert ));

my $commands = {
    select => {
        completion_list => \@animals,
        commands        => {
            give    => { completion_list => \@foods, },
            take_to => { completion_list => \@places, },
        },
    },
    kill => { completion_list => \@animals, }
};

my $completed = autocomplete( $commands, 'auto> ' );
print $completed ? "\nThe user entered: $completed\n" : "\nEscape\n";
exit;

######################################################################

sub autocomplete {
    print "START initialization\n" if $debug;
    my $commands = shift;
    my $prompt   = shift // '> ';
    my $lines    = ref $commands ? join "\n", lines($commands), '' : $commands;
    my $input    = '';
    if ($debug) {
        print "\$prompt = [$prompt]\n\$lines = [$lines]\n";
        print "END initialization\n\n" if $debug;
    }
    my ( $clearline, $color, $reset ) = ( "\e[G\e[K", "\e[32m", "\e[m" );
	# Control Sequence Introducer, or CSI is: \e[
	# clearline: CSI n G	CHA	Cursor Horizontal Absolute	Moves the cursor to column n (default 1)
	# color    : CSI n m, named Select Graphic Rendition (SGR) where 32 is foregroound green
	# reset    : CSI m is treated as CSI 0 m (reset / normal)
    ReadMode 'raw';
    eval {
        while () {
			$input = "$input\n$lines" =~ /^(.*).*\n(?:.*\n)*\1/ ? $1 : '';
			#tybalt89: Trims back $input so it only contains a string that exists in one of
			#the valid lines. It's looking for the longest initial string that also
			#starts one of the other lines. The (?:.*\n)* allows for skipping over
			#any lines that do not match.
            print "\$input 1 = [$input] line: " . __LINE__ . "\n" if $debug;
            $input = $lines =~ s/^(?!\Q$input\E).*\n//gmr =~
			#tybalt89: Removes from $lines any line that does not start with $input. Returns
			#a multiline string where every line starts with $input.
              /^(.*).*\n(?:\1.*\n)*\z/ ? $1 : '';
			#tybalt89: Finds the longest initial substring that starts every line. This will
			#extend the match until the next decision point that requires user input.
            print "\$input 2 = [$input] line: " . __LINE__ . "\n" if $debug;
            my $words = join ' ', sort +uniq $lines =~ /^\Q$input\E ?(\S+)/gm;
			#tybalt89: Finds the next word after the matching part of each valid line.
            print "\$words = [$words] line: " . __LINE__ . "\n" if $debug;
            $lines =~ /^$input\n/m and $words = '*** Completed!';
			#tybalt89: Matches $input against each valid line looking for a complete line match.
            my $backup = "\e[" . ( 2 + length $words ) . "D";
			# Control Sequence Introducer, or CSI: \e[  + number + D(cursor back)
            print "\n\$backup = [CURSOR BACK 2 + length \$words ( 2 + "
              . ( length $words )
              . " )] line: "
              . __LINE__ . "\n"
              if $debug;
            print "$clearline$prompt$input  $color$words$reset$backup";
            my $char = ReadKey(0);
            # next unless defined $char;    # you need this only if unsane ReadKey -1
			# catch ESC and CTRL-C
			if ( $debug and $char =~ tr/\e\cc// ){
				print "\n***ESC or CTRL-C was inserted! Clearing \$input and exiting the loop\n";
				$input = '';
				last;
			}
            else {
				$char =~ tr/\e\cc// and $input = '', last;
			}
			# catch ENTER
			if ( $debug and $char =~ tr/\n\r// ){
				print "\n***ENTER was inserted!\n";
				if ( $lines =~ /^$input$/m ){
					print "\$line matches \$input: FINISH\n";
					last;
				}
				else { 
						print "\$line does NOT matches \$input: NEXT\n";
						next;
				}
			}
			else {
				$char =~ tr/\n\r// and $lines =~ /^$input$/m ? last : next;
			}
			# catch space
			if ( $debug and $char =~ tr/ -~// ){
				print "\n***SPACE (or - or ~) catched and removed\n";
				$input .= $char;
			}
            else {
					$char =~ tr/ -~// and $input .= $char;
			}
            print "\nINPUT=> \$char = [".( $char =~ /[\b\x7f]/ ? '**BACKSPACE**' : $char)."] line: " . __LINE__ . "\n"
			# $char =~ tr/\b\x7f// takes a list of chars
			# $char =~ /[\b\x7f]/  \b in regexex is word boundary, but inside a char class is backspace
			# see https://perldoc.perl.org/perlrebackslash
              if $debug;
            # if ( $char =~ tr/\b// )    # also this seems to work for backspace
			if ( $char =~ tr/\b\x7f// )  # backspace
            {
                my $match = 1 + ( () = $lines =~ /^\Q$input\E/gm );
				#tybalt89: Counts how many lines are still valid matches, that is they are still
				#possibilities that require a user decision at this point.  Adds 1
				#because we need to go back to the previous decision point which will
				#(by definition) have at least one more valid match.
                $input =
                  "$input\n$lines" =~
                  /^(.*).*\n(?:(?:(?!\1).*\n)*\1.*\n){$match}/ ? $1 : '';
				#tybalt89: Finds the longest initial substring that also is the initial substring
				#of $match following lines. Lines that do not start with the candidate
				#initial match are skipped by (?:(?!\1).*\n)* .  This longest initial
				#substring is the previous decision point, and is then stored into $input.
            }
            print "======> iteration ".$debug++."\n\n" if $debug;
        }
        1;
    };
    my $error = $@;
    ReadMode 'restore';
    print "$error\n";
    return $input;
}

sub lines {
    my $cmd = shift or return '';
    map s/ +$//r, map {
        my $key = $_;    # fun triple map nesting
        map {
            my $prev = $_;
            map "$key $_ $prev", @{ $cmd->{$key}{completion_list} };
          } lines( $cmd->{$key}{commands} )
    } keys %$cmd;
}