mirror of
https://github.com/pragma-/pbot.git
synced 2024-11-05 19:49:32 +01:00
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
parent
8e3652bc8e
commit
40aa37bc7c
@ -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) {
|
||||
|
||||
@ -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 {}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user