Add Wordle plugin; update games section of README

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

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 <pragma78@gmail.com>
+# 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 <word> | 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 <word>";
+            }
+
+            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;

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 {}