GitHub
/
pbot
mirror of https://github.com/pragma-/pbot.git
3
0
Fork 0
Code Issues Projects Releases Wiki Activity

Plugin/Wordle: Wordle improvements 

- refactor `wordlists` into structure with more details
  - added `name` field for language names
  - added `prompt` field for localized "Guess the word!" prompt
  - added `supp` field for supplemental wordlists
    (used to add words to list for guessing, e.g. urban with insane supplement
    allows initial word selection from urban list and then adds words from
    insane list for more options for guessing)
  - moved accents into added `accents` field
  - added `min_length` and `max_length` fields for lists that are different
    from default lengths
- misc minor adjustments
This commit is contained in:
Pragmatic Software 2024-04-29 03:15:05 -07:00
parent 8e3652bc8e
commit 40aa37bc7c
No known key found for this signature in database
GPG Key ID: CC916B6E3C84ECCE
2 changed files with 126 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

181
lib/PBot/Plugin/Wordle.pm
View File

@ -11,6 +11,8 @@ use parent 'PBot::Plugin::Base';
use PBot::Imports;
use utf8;
sub initialize($self, %conf) {
$self->{pbot}->{commands}->add(
name => 'wordle',
@ -29,9 +31,10 @@ use constant {
USAGE => 'Usage: wordle start [length [wordlist]] | custom <word> <channel> [wordlist] | guess <word> | letters | show | giveup',
NO_WORDLE => 'There is no Wordle yet. Use `wordle start` to begin a game.',
DEFAULT_LENGTH => 5,
MIN_LENGTH => 3,
MAX_LENGTH => 22,
DEFAULT_LIST => 'american',
DEFAULT_LENGTH => 5,
DEFAULT_MIN_LENGTH => 3,
DEFAULT_MAX_LENGTH => 22,
LETTER_CORRECT => 1,
LETTER_PRESENT => 2,
@ -39,27 +42,75 @@ use constant {
};
my %wordlists = (
default => '/wordle/american',
american => '/wordle/american',
insane => '/wordle/american-insane',
british => '/wordle/british',
canadian => '/wordle/canadian',
finnish => '/wordle/finnish',
french => '/wordle/french',
german => '/wordle/german',
italian => '/wordle/italian',
polish => '/wordle/polish',
spanish => '/wordle/spanish',
urban => '/wordle/urban',
);
my %accents = (
finnish => 'åäöšž',
french => 'éàèùçâêîôûëïü',
german => 'äöüß',
italian => 'èéìòù',
polish => 'ćńóśźżąęł',
spanish => 'áéíóúüñ',
american => {
name => 'American English',
prompt => 'Guess the American English word!',
list => '/wordle/american',
supp => 'insane',
},
insane => {
name => 'American English (Insanely Huge List)',
prompt => 'Guess the American English (Insanely Huge List) word!',
list => '/wordle/american-insane',
},
british => {
name => 'British English',
prompt => 'Guess the British English word!',
list => '/wordle/british',
supp => 'insane',
},
canadian => {
name => 'Canadian English',
prompt => 'Guess the Canadian English word!',
list => '/wordle/canadian',
supp => 'insane',
},
finnish => {
name => 'Finnish',
prompt => 'Arvaa suomenkielinen sana!',
list => '/wordle/finnish',
accents => 'åäöšž',
min_len => 5,
max_len => 8,
},
french => {
name => 'French',
prompt => 'Devinez le mot Français !',
list => '/wordle/french',
accents => 'éàèùçâêîôûëïü',
},
german => {
name => 'German',
prompt => 'Erraten Sie das Deutsches Wort!',
list => '/wordle/german',
accents => 'äöüß',
},
italian => {
name => 'Italian',
prompt => 'Indovina la parola italiana!',
list => '/wordle/italian',
accents => 'èéìòù',
},
polish => {
name => 'Polish',
prompt => 'Odgadnij polskie słowo!',
list => '/wordle/polish',
accents => 'ćńóśźżąęł',
min_len => 5,
max_len => 8,
},
spanish => {
name => 'Spanish',
prompt => '¡Adivina la palabra en español!',
list => '/wordle/spanish',
accents => 'áéíóúüñ',
},
urban => {
name => 'Urban Dictionary',
prompt => 'Guess the Urban Dictionary word!',
list => '/wordle/urban',
supp => 'insane',
},
);
my %color = (
@ -116,20 +167,23 @@ sub wordle($self, $context) {
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];
}
my $wordlist = $args[1] // 'default';
my $wordlist = $args[1] // DEFAULT_LIST;
if (not exists $wordlists{$wordlist}) {
return 'Invalid wordlist; options are: ' . (join ', ', sort keys %wordlists);
}
if (defined $args[0]) {
my $min = $wordlists{$wordlist}->{min_len} // DEFAULT_MIN_LENGTH;
my $max = $wordlists{$wordlist}->{max_len} // DEFAULT_MAX_LENGTH;
if ($args[0] !~ m/^[0-9]+$/ || $args[0] < $min || $args[0] > $max) {
return "Invalid word length `$args[0]` for $wordlists{$wordlist}->{name} words; must be integer >= $min and <= $max.";
}
$length = $args[0];
}
return $self->make_wordle($channel, $length, undef, $wordlist);
}
@ -143,8 +197,17 @@ sub wordle($self, $context) {
my $custom_wordlist = $args[2];
my $length = length $custom_word;
if ($length < MIN_LENGTH || $length > MAX_LENGTH) {
return "Invalid word length; must be >= ".MIN_LENGTH." and <= ".MAX_LENGTH.".";
my $wordlist = $custom_wordlist // DEFAULT_LIST;
if (not exists $wordlists{$wordlist}) {
return 'Invalid wordlist; options are: ' . (join ', ', sort keys %wordlists);
}
my $min = $wordlists{$wordlist}->{min_len} // DEFAULT_MIN_LENGTH;
my $max = $wordlists{$wordlist}->{max_len} // DEFAULT_MAX_LENGTH;
if ($length < $min || $length > $max) {
return "Invalid word length for $wordlists{$wordlist}->{name} words; must be >= $min and <= $max.";
}
if (not $self->{pbot}->{channels}->is_active($custom_channel)) {
@ -155,16 +218,10 @@ sub wordle($self, $context) {
return "There is already a Wordle underway! Use `wordle show` to see the current progress or `wordle giveup` to end it.";
}
my $wordlist = $custom_wordlist // 'default';
if (not exists $wordlists{$wordlist}) {
return 'Invalid wordlist; options are: ' . (join ', ', sort keys %wordlists);
}
$custom_word =~ s/ß/ẞ/g; # avoid uppercasing to SS in German
my $result = $self->make_wordle($custom_channel, $length, uc $custom_word, $wordlist);
if ($result !~ /Guess/) {
if ($result !~ /Legend: /) {
return $result;
}
@ -211,7 +268,7 @@ sub wordle($self, $context) {
return NO_WORDLE;
}
return $self->show_letters($channel);
return $self->show_letters($channel);
}
default {
@ -220,30 +277,30 @@ sub wordle($self, $context) {
}
}
sub load_words($self, $length, $wordlist = 'default') {
$wordlist = $self->{datadir} . $wordlists{$wordlist};
sub load_words($self, $length, $wordlist = DEFAULT_LIST, $words = undef) {
$wordlist = $self->{datadir} . $wordlists{$wordlist}->{list};
if (not -e $wordlist) {
die "Wordle database `" . $wordlist . "` not available. Set WORDLIST to a valid location of a wordlist file.\n";
die "Wordle database `" . $wordlist . "` not available.\n";
}
open my $fh, '<:encoding(UTF-8)', $wordlist or die "Failed to open Wordle database.";
my %words;
$words //= {};
while (my $line = <$fh>) {
chomp $line;
if (length $line == $length) {
$line =~ s/ß/ẞ/g; # avoid uppercasing to SS in German
$words{uc $line} = 1;
$words->{uc $line} = 1;
}
}
close $fh;
return \%words;
return $words;
}
sub make_wordle($self, $channel, $length, $word = undef, $wordlist = 'default') {
sub make_wordle($self, $channel, $length, $word = undef, $wordlist = DEFAULT_LIST) {
eval {
$self->{$channel}->{words} = $self->load_words($length, $wordlist);
};
@ -264,6 +321,20 @@ sub make_wordle($self, $channel, $length, $word = undef, $wordlist = 'default')
@wordle = split //, $words[rand @words];
}
if (not @wordle) {
return "Failed to find a suitable word.";
}
if (exists $wordlists{$wordlist}->{supp}) {
eval {
$self->load_words($length, $wordlists{$wordlist}->{supp}, $self->{$channel}->{words});
};
if ($@) {
return "Failed to load words: $@";
}
}
$self->{$channel}->{wordle} = \@wordle;
$self->{$channel}->{guess} = '';
$self->{$channel}->{correct} = 0;
@ -274,8 +345,8 @@ sub make_wordle($self, $channel, $length, $word = undef, $wordlist = 'default')
$self->{$channel}->{letters}->{$letter} = 0;
}
if (exists $accents{$wordlist}) {
foreach my $letter (split //, $accents{$wordlist}) {
if (exists $wordlists{$wordlist}->{accents}) {
foreach my $letter (split //, $wordlists{$wordlist}->{accents}) {
$letter =~ s/ß/ẞ/g; # avoid uppercasing to SS in German
$letter = uc $letter;
$self->{$channel}->{letters}->{$letter} = 0;
@ -286,11 +357,7 @@ sub make_wordle($self, $channel, $length, $word = undef, $wordlist = 'default')
$self->{$channel}->{guess} .= ' ? ' x $self->{$channel}->{wordle}->@*;
$self->{$channel}->{guess} .= $color{reset};
my $language = $wordlist;
$language = ucfirst $language;
$language = 'American' if $language eq 'Default';
return $self->show_wordle($channel) . " Guess the $language word! Legend: $color{invalid}X $color{reset} not in word; $color{present}X$color{present_a}?$color{reset} wrong position; $color{correct}X$color{correct_a}*$color{reset} correct position";
return $self->show_wordle($channel) . " $wordlists{$wordlist}->{prompt} Legend: $color{invalid}X $color{reset} not in word; $color{present}X$color{present_a}?$color{reset} wrong position; $color{correct}X$color{correct_a}*$color{reset} correct position";
}
sub show_letters($self, $channel) {

4
lib/PBot/VERSION.pm
View File

@ -25,8 +25,8 @@ use PBot::Imports;
# These are set by the /misc/update_version script
use constant {
BUILD_NAME => "PBot",
BUILD_REVISION => 4751,
BUILD_DATE => "2024-04-17",
BUILD_REVISION => 4752,
BUILD_DATE => "2024-04-29",
};
sub initialize {}