2024-03-07 12:17:07 +01:00
# 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 ,
2024-03-07 17:59:41 +01:00
MIN_LENGTH = > 3 ,
2024-03-07 12:17:07 +01:00
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: $@" ;
}
2024-03-07 17:59:41 +01:00
my @ words = keys $ self - > { $ channel } - > { words } - > % * ;
2024-03-07 12:17:07 +01:00
my @ wordle = split // , $ words [ rand @ words ] ;
2024-03-07 17:59:41 +01:00
$ self - > { $ channel } - > { wordle } = \ @ wordle ;
2024-03-07 12:17:07 +01:00
$ 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 ) ;
}
2024-03-07 17:59:41 +01:00
return $ self - > guess_wordle ( $ channel , $ args [ 0 ] ) ;
2024-03-07 12:17:07 +01:00
}
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 ;
2024-03-07 17:59:41 +01:00
while ( my $ line = <$fh> ) {
chomp $ line ;
2024-03-07 12:17:07 +01:00
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 ;
for ( my $ i = 0 ; $ i < @ wordle ; $ i + + ) {
2024-03-07 17:59:41 +01:00
$ count { $ wordle [ $ i ] } + + ;
$ seen { $ wordle [ $ i ] } = 0 ;
2024-03-07 18:09:59 +01:00
$ correct { $ wordle [ $ i ] } = 0 unless exists $ correct { $ wordle [ $ i ] } ;
2024-03-07 17:59:41 +01:00
2024-03-07 12:17:07 +01:00
if ( $ guess [ $ i ] eq $ wordle [ $ i ] ) {
$ correct { $ guess [ $ i ] } + + ;
}
}
2024-03-07 17:59:41 +01:00
my @ result ;
my $ correct = 0 ;
2024-03-07 12:17:07 +01:00
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 ;