view release on metacpan or  search on metacpan

lib/App/Greple/wordle.pm  view on Meta::CPAN

    map { ( '--re' => $_ ) } $green, $yellow, $black;
}

sub title {
    my $app = shift;
    my $label = 'Greple::wordle';
    return $label if not defined $app->index;
    sprintf('%s %s%s',
	    $label,
	    $app->series == 0 ? '' : sprintf("%d-", $app->series),
	    $app->index);
}

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

my $app = __PACKAGE__->new or die;
my $game;

sub prompt {
    sprintf '%d: ', $game->attempt + 1;
}

sub initialize {
    my($mod, $argv) = @_;
    $app->parseopt($argv)->setup;
    $game = App::Greple::wordle::game->new(answer => $app->answer);
    push @$argv, $app->patterns;
    if (-t STDIN) {
	push @$argv, '--interactive', ('/dev/stdin') x $app->total;
	select->autoflush;
	say $app->title;
	print prompt();
    }
}

sub respond {
    local $_ = $_;
    my $chomped = chomp;
    print ansi_code("{CHA}{CUU}") if $chomped;
    print ansi_code(sprintf("{CHA(%d)}",
			    max(11, vwidth($_) + length(prompt()) + 2)));
    print s/(?<=.)\z/\n/r for @_;
}

sub show_answer {
    say colorize('#6aaa64', uc $game->answer);
}

sub show_result {
    printf "\n%s %d/%d\n\n", $app->title, $game->attempt, $app->trial;
    say $game->result;
}

sub check {
    my $word = lc s/\n//r;
    if (not $word_all{$word}) {
	command($word) or respond $app->wrong;
	$_ = '';
    } else {
	# show previous attempts above the line greple prints
	say for $app->history ? $game->guess_color(@{$game->attempts}) : ();
	$game->try($word);
	# greple matches case-insensitively, so show the word in upper case
	$_ = uc $_;
    }
}

sub command {
    my $word = shift;
    my @cmd = split ' ', $word or return;
    my @word = @word_all;
    state @remember;
    my $done;
    $cmd[0] =~ /^u(niq)?$/ and unshift @cmd, 'hint';

    while (@cmd) {
	local $_ = shift @cmd;
	# "return" in try block only leaves the block, so use $done
	try {
	    if    ($_ eq '|')   {}
	    elsif (/^d$/)       {
		$app->debug ^= 1;
		printf "Debug %s\n", $app->debug ? 'on' : 'off';
		return $done = 1;
	    }
	    elsif (/^\?$/)      { help(); return $done = 1 }
	    elsif (/^!!$/)      { @word = @remember }
	    elsif (/^h(int)?$/) { @word = choose($game->hint, @word) }
	    elsif (/^u(niq)?$/) { @word = grep { !/(.).*\1/i } @word }
	    elsif (/^=(.+)/)    { @word = choose(includes($1), @word) }
	    elsif (/^!(.+)/)    { @word = choose("^(?!.*[$1])", @word) }
	    elsif (/\W/)        { @word = choose($_, @word); }
	    else  { return }
	    1;
	} or do {
	    warn "ERROR: $_" if $app->debug;
	    return /^[a-z]+$/i ? 0 : 1;
	};
	return 1 if $done;
    }
    if (@word == 0) {
	warn "No match\n";
	return 1;
    }
    @remember = @word;
    do {
	local $, = ' ';
	say $game->hint_color(@word);
    };
    1;
}

sub help {
    my $message = << "    END";
#   d      debug
    ?      help
    h      show hint
    u      uniq
    !!     repeat last result
    =<str> include characters
    !<str> exclude characters