From 435faaa18c76cd5c0aed6010f87e6ce05e24b503 Mon Sep 17 00:00:00 2001 From: Pragmatic Software Date: Thu, 7 Mar 2024 03:17:07 -0800 Subject: [PATCH] Add Wordle plugin; update games section of README --- README.md | 6 +- lib/PBot/Plugin/Wordle.pm | 222 ++++++++++++++++++++++++++++++++++++++ lib/PBot/VERSION.pm | 4 +- 3 files changed, 228 insertions(+), 4 deletions(-) create mode 100644 lib/PBot/Plugin/Wordle.pm diff --git a/README.md b/README.md index 181b9bec..e17fe1f8 100644 --- a/README.md +++ b/README.md @@ -239,9 +239,11 @@ There are even a few games! Plugin | Description --- | --- -[Battleship](lib/PBot/Plugin/Battleship.pm) | The classic Battleship board game, simplified for IRC -[Connect4](lib/PBot/Plugin/Connect4.pm) | The classic Connect-4 game. +[Battleship](lib/PBot/Plugin/Battleship.pm) | The classic Battleship board game, simplified for IRC. Multiple players can compete at once on the same battlefield! +[Connect4](lib/PBot/Plugin/Connect4.pm) | The classic two-player Connect-4 game. [Spinach](lib/PBot/Plugin/Spinach.pm) | An advanced multiplayer Trivia game engine with a twist! A question is shown. Everybody privately submits a false answer. All false answers and the true answer is shown. Everybody tries to guess the true answer. Points are gained when people pick your false answer! +[Wordle](lib/PBot/Plugin/Wordle.pm) | Guess a word by submitting words for clues about which letters belong to the word. +[WordMorph](lib/PBot/Plugin/WordMorph.pm) | Solve a path between two words by changing one letter at a time. #### Applets Applets are external command-line executable programs and scripts that can be diff --git a/lib/PBot/Plugin/Wordle.pm b/lib/PBot/Plugin/Wordle.pm new file mode 100644 index 00000000..cea1d702 --- /dev/null +++ b/lib/PBot/Plugin/Wordle.pm @@ -0,0 +1,222 @@ +# File: Wordle.pm +# +# Purpose: Wordle game. Try to guess a word by submitting words for clues about +# which letters belong to the word. + +# SPDX-FileCopyrightText: 2024 Pragmatic Software +# SPDX-License-Identifier: MIT + +package PBot::Plugin::Wordle; +use parent 'PBot::Plugin::Base'; + +use PBot::Imports; + +sub initialize($self, %conf) { + $self->{pbot}->{commands}->add( + name => 'wordle', + help => 'Wordle game! Guess target word by submitting words for clues about which letters belong to the word!', + subref => sub { $self->wordle(@_) }, + ); +} + +sub unload($self) { + $self->{pbot}->{commands}->remove('wordle'); +} + +use constant { + USAGE => 'Usage: wordle start [word length] | guess | show | giveup', + NO_WORDLE => 'There is no Wordle yet. Use `wordle start` to begin a game.', + DEFAULT_LENGTH => 5, + MIN_LENGTH => 4, + MAX_LENGTH => 10, + WORDLIST => '/usr/share/dict/words', +}; + +sub wordle($self, $context) { + my @args = $self->{pbot}->{interpreter}->split_line($context->{arguments}); + + my $command = shift @args; + + if (not length $command) { + return USAGE; + } + + my $channel = $context->{from}; + + given ($command) { + when ('show') { + if (not defined $self->{$channel}->{wordle}) { + return NO_WORDLE; + } + + return "Wordle: " . $self->show_wordle($channel); + } + + when ('giveup') { + if (not defined $self->{$channel}->{wordle}) { + return NO_WORDLE; + } + + my $wordle = join '', $self->{$channel}->{wordle}->@*; + $self->{$channel}->{wordle} = undef; + + return "The word was $wordle. Better luck next time."; + } + + when ('start') { + if (@args > 1) { + return "Invalid arguments; Usage: wordle start [word length]"; + } + + if (defined $self->{$channel}->{wordle} && $self->{$channel}->{correct} == 0) { + return "There is already a Wordle underway! Use `wordle show` to see the current progress or `wordle giveup` to end it."; + } + + my $length = DEFAULT_LENGTH; + + if (defined $args[0]) { + if ($args[0] !~ m/^[0-9]+$/ || $args[0] < MIN_LENGTH || $args[0] > MAX_LENGTH) { + return "Invalid word length `$args[0]`; must be integer >= ".MIN_LENGTH." and <= ".MAX_LENGTH."."; + } + + $length = $args[0]; + } + + eval { + $self->{$channel}->{words} = $self->load_words($length); + }; + + if ($@) { + return "Failed to load words: $@"; + } + + my @words = keys $self->{$channel}->{words}->%*; + my @wordle = split //, $words[rand @words]; + $self->{$channel}->{wordle} = \@wordle; + + $self->{$channel}->{guesses} = []; + $self->{$channel}->{correct} = 0; + + push $self->{$channel}->{guesses}->@*, '? ' x $self->{$channel}->{wordle}->@*; + + return "Wordle: " . $self->show_wordle($channel) . " (Guess the word! ?X? means correct letter in wrong position. *X* means correct letter in right position. X means letter is not in the word.)"; + } + + when ('guess') { + if (!@args || @args > 1) { + return "Usage: wordle guess "; + } + + if (not defined $self->{$channel}->{wordle}) { + return NO_WORDLE; + } + + if ($self->{$channel}->{correct}) { + return "Wordle already solved. " . $self->show_wordle($channel); + } + + return $self->guess_wordle($channel, uc $args[0]); + } + + default { + return "Unknown command `$command`; " . USAGE; + } + } +} + +sub load_words($self, $length) { + if (not -e WORDLIST) { + die "Wordle database `" . WORDLIST . "` not available. Set WORDLIST to a valid location of a wordlist file.\n"; + } + + open my $fh, '<', WORDLIST or die "Failed to open Wordle database."; + + my %words; + + while (chomp(my $line = <$fh>)) { + next if $line !~ /^[a-z]+$/; + + if (length $line == $length) { + $words{uc $line} = 1; + } + } + + close $fh; + return \%words; +} + +sub show_wordle($self, $channel) { + return join ' -> ', $self->{$channel}->{guesses}->@*; +} + +sub guess_wordle($self, $channel, $guess) { + if (length $guess != $self->{$channel}->{wordle}->@*) { + return "The length of your guess does not match length of current Wordle. Try again."; + } + + $guess = uc $guess; + + if (not exists $self->{$channel}->{words}->{$guess}) { + return "I don't know that word. Try again." + } + + my @guess = split //, $guess; + my @wordle = $self->{$channel}->{wordle}->@*; + + my %count; + my %seen; + my %correct; + + foreach my $letter (@wordle) { + $count{$letter}++; + $seen{$letter} = 0; + $correct{$letter} = 0; + } + + my @result; + my $correct = 0; + + for (my $i = 0; $i < @wordle; $i++) { + if ($guess[$i] eq $wordle[$i]) { + $correct{$guess[$i]}++; + } + } + + for (my $i = 0; $i < @wordle; $i++) { + if ($guess[$i] eq $wordle[$i]) { + $seen{$guess[$i]}++; + $correct++; + push @result, "*$guess[$i]*"; + } else { + my $present = 0; + + for (my $j = 0; $j < @wordle; $j++) { + if ($wordle[$j] eq $guess[$i]) { + if ($seen{$wordle[$j]} + $correct{$wordle[$j]} < $count{$wordle[$j]}) { + $present = 1; + } + + $seen{$wordle[$j]}++; + last; + } + } + + if ($present) { + push @result, "?$guess[$i]?"; + } else { + push @result, "$guess[$i]"; + } + } + } + + push $self->{$channel}->{guesses}->@*, join ' ', @result; + + if ($correct == length $guess) { + $self->{$channel}->{correct} = 1; + return "Correct! " . $self->show_wordle($channel); + } else { + return $self->show_wordle($channel); + } +} + +1; diff --git a/lib/PBot/VERSION.pm b/lib/PBot/VERSION.pm index 7933a1c2..7ee9e18c 100644 --- a/lib/PBot/VERSION.pm +++ b/lib/PBot/VERSION.pm @@ -25,8 +25,8 @@ use PBot::Imports; # These are set by the /misc/update_version script use constant { BUILD_NAME => "PBot", - BUILD_REVISION => 4706, - BUILD_DATE => "2024-03-06", + BUILD_REVISION => 4707, + BUILD_DATE => "2024-03-07", }; sub initialize {}