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

Improvements to C Jeopardy module 

Moved to its own cjeopardy directory.

Added IRCColors module to print colored text.

Added Scorekeeper module to track scoring statistics.
This commit is contained in:
Pragmatic Software 2015-01-28 00:40:40 -08:00
parent 12cd9cb8e0
commit 1f260c9e94
8 changed files with 293 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
modules/cjeopardy/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
scores.sqlite

38
modules/cjeopardy/IRCColors.pm Normal file
View File

@ -0,0 +1,38 @@
#!/usr/bin/env perl
use warnings;
use strict;
package IRCColors;
use Exporter;
our @ISA = 'Exporter';
our @EXPORT = qw(%color);
our %color = (
white => "\x0300",
black => "\x0301",
blue => "\x0302",
green => "\x0303",
red => "\x0304",
maroon => "\x0305",
purple => "\x0306",
orange => "\x0307",
yellow => "\x0308",
lightgreen => "\x0309",
teal => "\x0310",
cyan => "\x0311",
lightblue => "\x0312",
magneta => "\x0313",
gray => "\x0314",
lightgray => "\x0315",
bold => "\x02",
italics => "\x1D",
underline => "\x1F",
reverse => "\x16",
reset => "\x0F",
);
1;

153
modules/cjeopardy/Scorekeeper.pm Normal file
View File

@ -0,0 +1,153 @@
#!/usr/bin/env perl
package Scorekeeper;
use warnings;
use strict;
use DBI;
use Carp qw(shortmess);
sub new {
my ($class, %conf) = @_;
my $self = bless {}, $class;
$self->initialize(%conf);
return $self;
}
sub initialize {
my ($self, %conf) = @_;
$self->{filename} = $conf{filename} // 'scores.sqlite';
}
sub begin {
my $self = shift;
print STDERR "Opening scores SQLite database: $self->{filename}\n";
$self->{dbh} = DBI->connect("dbi:SQLite:dbname=$self->{filename}", "", "", { RaiseError => 1, PrintError => 0 }) or die $DBI::errstr;
eval {
$self->{dbh}->do(<< 'SQL');
CREATE TABLE IF NOT EXISTS Scores (
id INTEGER PRIMARY KEY,
nick TEXT NOT NULL,
channel TEXT NOT NULL,
correct_answers INTEGER DEFAULT 0,
wrong_answers INTEGER DEFAULT 0,
lifetime_correct_answers INTEGER DEFAULT 0,
lifetime_wrong_answers INTEGER DEFAULT 0,
correct_streak INTEGER DEFAULT 0,
wrong_streak INTEGER DEFAULT 0,
lifetime_highest_correct_streak INTEGER DEFAULT 0,
lifetime_highest_wrong_streak INTEGER DEFAULT 0,
highest_correct_streak INTEGER DEFAULT 0,
highest_wrong_streak INTEGER DEFAULT 0,
hints INTEGER DEFAULT 0,
lifetime_hints INTEGER DEFAULT 0,
last_wrong_timestamp NUMERIC DEFAULT 0,
last_correct_timestamp NUMERIC DEFAULT 0,
quickest_correct NUMERIC DEFAULT 0
)
SQL
};
print STDERR $@ if $@;
}
sub end {
my $self = shift;
print STDERR "Closing scores SQLite database\n";
if(exists $self->{dbh} and defined $self->{dbh}) {
$self->{dbh}->disconnect();
delete $self->{dbh};
}
}
sub add_player {
my ($self, $nick, $channel) = @_;
my $id = eval {
my $sth = $self->{dbh}->prepare('INSERT INTO Scores (nick, channel) VALUES (?, ?)');
$sth->bind_param(1, $nick) ;
$sth->bind_param(2, $channel) ;
$sth->execute();
return $self->{dbh}->sqlite_last_insert_rowid();
};
print STDERR $@ if $@;
return $id;
}
sub get_player_id {
my ($self, $nick, $channel) = @_;
my $id = eval {
my $sth = $self->{dbh}->prepare('SELECT id FROM Scores WHERE nick = ? AND channel = ?');
$sth->bind_param(1, $nick);
$sth->bind_param(2, $channel);
$sth->execute();
my $row = $sth->fetchrow_hashref();
return $row->{id};
};
print STDERR $@ if $@;
$id = $self->add_player($nick, $channel) if not defined $id;
return $id;
}
sub get_player_data {
my ($self, $id, @columns) = @_;
my $player_data = eval {
my $sql = 'SELECT ';
if(not @columns) {
$sql .= '*';
} else {
my $comma = '';
foreach my $column (@columns) {
$sql .= "$comma$column";
$comma = ', ';
}
}
$sql .= ' FROM Scores WHERE id = ?';
my $sth = $self->{dbh}->prepare($sql);
$sth->bind_param(1, $id);
$sth->execute();
return $sth->fetchrow_hashref();
};
return $player_data;
}
sub update_player_data {
my ($self, $id, $data) = @_;
eval {
my $sql = 'UPDATE Scores SET ';
my $comma = '';
foreach my $key (keys %$data) {
$sql .= "$comma$key = ?";
$comma = ', ';
}
$sql .= ' WHERE id = ?';
my $sth = $self->{dbh}->prepare($sql);
my $param = 1;
foreach my $key (keys %$data) {
$sth->bind_param($param++, $data->{$key});
}
$sth->bind_param($param, $id);
$sth->execute();
};
}
1;

15
modules/cjeopardy.pl → modules/cjeopardy/cjeopardy.pl
View File

@ -6,9 +6,11 @@ use strict;
use Time::HiRes qw/gettimeofday/;
use Time::Duration qw/duration/;
use IRCColors;
my $CJEOPARDY_FILE = 'cjeopardy.txt';
my $CJEOPARDY_DATA = 'cjeopardy.dat';
my $CJEOPARDY_SHUFFLE = 'cjeopardy.shuffle';
my $CJEOPARDY_DATA = 'data/cjeopardy.dat';
my $CJEOPARDY_SHUFFLE = 'data/cjeopardy.shuffle';
my $TIMELIMIT = 300;
@ -31,8 +33,8 @@ if (defined $ret) {
if (scalar gettimeofday - $last_timestamp <= $TIMELIMIT) {
my $duration = duration($TIMELIMIT - scalar gettimeofday - $last_timestamp);
print "The current question is: $last_question";
print "You may request a new question in $duration.\n";
print "$color{green}The current question is$color{reset}: $last_question";
print "$color{red}You may request a new question in $duration.$color{reset}\n";
close $fh;
exit;
}
@ -48,7 +50,7 @@ if (not length $text) {
close $fh;
if (not @indices) {
print "(Shuffling.)\n";
print "$color{teal}(Shuffling.)$color{reset}\n";
shuffle_questions(0);
} else {
open my $fh, ">", "$CJEOPARDY_SHUFFLE-$channel" or print "Failed to shuffle questions.\n" and exit;
@ -58,7 +60,7 @@ if (not length $text) {
close $fh;
}
} else {
print "(Shuffling!)\n";
print "$color{teal}(Shuffling!)$color{reset}\n";
$question_index = shuffle_questions(1);
}
}
@ -91,6 +93,7 @@ chomp $a;
$q =~ s/\\\|/|/g;
$q =~ s/^\[.*?\]\s+//;
$q =~ s/(this keyword|this operator|this behavior|this preprocessing directive|this escape sequence|this mode|this function specifier|this function|this macro|this predefined macro|this header|this pragma|this fprintf length modifier|this type qualifier|this type|this value|this operand|this many|this|these)/$color{bold}$1$color{reset}/gi;
print "$q\n";
open $fh, ">", "$CJEOPARDY_DATA-$channel" or die "Could not open $CJEOPARDY_DATA-$channel: $!";

9
modules/cjeopardy.txt → modules/cjeopardy/cjeopardy.txt
View File

@ -8,8 +8,8 @@
[3.6 Terms, definitions, and symbols] A byte is composed of a contiguous sequence of bits, the number of which is this.|implementation-defined{Bet you thought it was 8!}
[3.6 Terms, definitions, and symbols] The least significant bit is called this.|low-order bit|low-order
[3.6 Terms, definitions, and symbols] The most significant bit is called this.|high-order bit|high-order
[3.6 Terms, definitions, and symbols] The the low-order bit is also known as this.|least significant bit|least significant
[3.6 Terms, definitions, and symbols] The the high-order bit is also known as this.|most significant bit|most significant
[3.6 Terms, definitions, and symbols] The low-order bit is also known as this.|least significant bit|least significant
[3.6 Terms, definitions, and symbols] The high-order bit is also known as this.|most significant bit|most significant
[3.15 Terms, definitions, and symbols] This is a region of data storage in the execution environment, the contents of which can represent values.|object
[3.15 Terms, definitions, and symbols] An object is a region of data storage in the execution environment, the contents of which can represent these.|values
[4. Conformance] In the standard, ``shall'' is to be interpreted as this on an implementation, or on a program.|requirement{If violated, the behavior is undefined.}
@ -272,7 +272,7 @@
[6.2.5 Types] The construction of a pointer type from a referenced type is called this.|pointer type derivation
[6.2.5 Types] This type describes the type designated by the construct _Atomic (type-name).|atomic
[6.2.5 Types] An array type of unknown size is this kind of type.|incomplete
[6.2.5 Types] A type has known constant size if the type is not incomplete and is not this type of array.|VLA{VLA stands for variable length array.}|variable length array
[6.2.5 Types] A type has known constant size if the type is not incomplete and is not this type of array.|VLA{VLA stands for variable length array.}|variable length|variable length array
[6.2.5 Types] A pointer to void shall have the same representation and alignment requirements as a pointer to this type.|char|character
[6.2.6.1 General] Values stored in unsigned bit-fields and objects of type unsigned char shall be represented using this notation.|binary|pure binary|pure binary notation
[6.2.6.1 General] A value may be copied into an object of type unsigned char [n] (e.g., by memcpy); the resulting set of bytes is called this.|object representation
@ -997,7 +997,8 @@
[7.21.9.2 The fseek function] This function sets the file position indicator for the stream pointed to by its stream argument.|fseek
[7.21.9.2 The fseek function] For a text stream, offset argument shall be either zero or a value returned by an earlier successful call to the ftell function on a stream associated with the same file and its whence argument shall be this.|SEEK_SET
[7.21.9.2 The fseek function] The fseek function returns this value for a request that cannot be satisfied.|nonzero|!0
[7.21.9.3 The fsetpos function] This function sets the mbstate_t object (if any) and file position indicator for the stream pointed to by stream according to the value of the object pointed to by pos, which shall be a value obtained from an earlier successful call to this function on a stream associated with the same file.|fsetpos
[7.21.9.3 The fsetpos function] This function sets the mbstate_t object (if any) and file position indicator for the stream pointed to by stream according to the value of the object pointed to by pos.|fsetpos
[7.21.9.3 The fsetpos function] The fsetpos function sets the mbstate_t object (if any) and file position indicator for the stream pointed to by stream according to the value of the object pointed to by pos, which shall be a value obtained from an earlier successful call to this function on a stream associated with the same file.|fgetpos
[7.21.9.4 The ftell function] This function obtains the current value of the file position indicator for the stream pointed to by stream.|ftell
[7.21.9.5 The rewind function] This function sets the file position indicator for the stream pointed to by stream to the beginning of the file.|rewind
[7.21.10.1 The clearerr function] This function clears the end-of-file and error indicators for the stream pointed to by stream.|clearerr

87
modules/cjeopardy_answer.pl → modules/cjeopardy/cjeopardy_answer.pl
View File

@ -6,14 +6,17 @@ use strict;
use Text::Levenshtein qw(fastdistance);
use Time::HiRes qw(gettimeofday);
my $CJEOPARDY_DATA = 'cjeopardy.dat';
my $CJEOPARDY_HINT = 'cjeopardy.hint';
my $CJEOPARDY_LAST_ANSWER = 'cjeopardy.last_ans';
use Scorekeeper;
use IRCColors;
my $CJEOPARDY_DATA = 'data/cjeopardy.dat';
my $CJEOPARDY_HINT = 'data/cjeopardy.hint';
my $CJEOPARDY_LAST_ANSWER = 'data/cjeopardy.last_ans';
my $hint_only_mode = 0;
my $channel = shift @ARGV;
my $nick = shift @ARGV;
my $channel = shift @ARGV;
my $text = join(' ', @ARGV);
sub encode { my $str = shift; $str =~ s/\\(.)/{sprintf "\\%03d", ord($1)}/ge; return $str; }
@ -85,9 +88,9 @@ if (defined $ret) {
if ($distance / $length < 0.15) {
if ($last_nick eq $nick) {
print "Er, you already correctly answered that question.\n";
print "$color{red}Er, you already correctly answered that question.$color{reset}\n";
} else {
print "Too slow! $last_nick got the correct answer.\n";
print "$color{red}Too slow! $color{orange}$last_nick$color{red} got the correct answer.$color{reset}\n";
}
exit;
}
@ -101,6 +104,11 @@ if (not @data) {
close $fh;
}
my $scores = Scorekeeper->new;
$scores->begin;
my $player_id = $scores->get_player_id($nick, $channel);
my $player_data = $scores->get_player_data($player_id);
my @valid_answers = map { decode $_ } split /\|/, encode $data[1];
my $incorrect_percentage = 100;
@ -115,13 +123,17 @@ foreach my $answer (@valid_answers) {
}
if ($answer =~ /^[0-9]+$/ and $lctext =~ /^[0-9]+$/) {
my $is_wrong = 0;
if ($lctext > $answer) {
print "$lctext is too big!\n";
exit;
print "$color{red}$lctext is too high!$color{reset}\n";
$is_wrong = 1;
} elsif ($lctext < $answer) {
print "$lctext is too small!\n";
exit;
print "$color{red}$lctext is too low!$color{reset}\n";
$is_wrong = 1;
}
goto WRONG_ANSWER if $is_wrong;
}
my $distance = fastdistance($lctext, lc $answer);
@ -135,13 +147,13 @@ foreach my $answer (@valid_answers) {
if ($percentage < 15) {
if ($distance == 0) {
print "'$answer' is correct!";
print "'$color{green}$answer$color{reset}' is correct!";
} else {
print "'$text' is close enough to '$answer'. You are correct!"
print "'$color{green}$text$color{reset}' is close enough to '$color{green}$answer$color{reset}'. You are correct!"
}
if (defined $supplemental_text) {
print " $supplemental_text\n";
print " $color{teal}$supplemental_text$color{reset}\n";
} else {
print "\n";
}
@ -155,27 +167,62 @@ foreach my $answer (@valid_answers) {
close $fh;
if ($channel eq '#cjeopardy') {
my $question = `./cjeopardy.pl $channel`;
my $question = `./cjeopardy/cjeopardy.pl $channel`;
if ($hint_only_mode) {
my $hint = `./cjeopardy_hint.pl $channel`;
my $hint = `./cjeopardy/cjeopardy_hint.pl $channel`;
$hint =~ s/^Hint: //;
print "Next hint: $hint\n";
} else {
print "Next question: $question\n";
print "$color{green}Next question$color{reset}: $question\n";
}
}
$player_data->{correct_answers}++;
$player_data->{lifetime_correct_answers}++;
$player_data->{correct_streak}++;
$player_data->{last_correct_timestamp} = scalar gettimeofday;
$player_data->{wrong_streak} = 0;
if ($player_data->{correct_streak} > $player_data->{highest_correct_streak}) {
$player_data->{highest_correct_streak} = $player_data->{correct_streak};
}
if ($player_data->{highest_correct_streak} > $player_data->{lifetime_highest_correct_streak}) {
$player_data->{lifetime_highest_correct_streak} = $player_data->{highest_correct_streak};
}
$scores->update_player_data($player_id, $player_data);
$scores->end;
exit;
}
}
my $correct_percentage = 100 - $incorrect_percentage;
if ($correct_percentage >= 80) {
printf "Sorry, '$text' is %.1f%% correct. So close!\n", $correct_percentage;
printf "Sorry, '$color{red}$text$color{reset}' is %.1f%% correct. So close!\n", $correct_percentage;
} elsif ($correct_percentage >= 70) {
printf "Sorry, '$text' is %.1f%% correct. Almost.\n", $correct_percentage;
printf "Sorry, '$color{red}$text$color{reset}' is %.1f%% correct. Almost.\n", $correct_percentage;
} elsif ($correct_percentage >= 50) {
printf "Sorry, '$text' is only %.1f%% correct.\n", $correct_percentage;
printf "Sorry, '$color{red}$text$color{reset}' is only %.1f%% correct.\n", $correct_percentage;
} else {
print "Sorry, '$text' is incorrect.\n";
print "Sorry, '$color{red}$text$color{reset}' is incorrect.\n";
}
WRONG_ANSWER:
$player_data->{wrong_answers}++;
$player_data->{lifetime_wrong_answers}++;
$player_data->{wrong_streak}++;
$player_data->{last_wrong_timestamp} = scalar gettimeofday;
$player_data->{correct_streak} = 0;
if ($player_data->{wrong_streak} > $player_data->{highest_wrong_streak}) {
$player_data->{highest_wrong_streak} = $player_data->{wrong_streak};
}
if ($player_data->{highest_wrong_streak} > $player_data->{lifetime_highest_wrong_streak}) {
$player_data->{lifetime_highest_wrong_streak} = $player_data->{highest_wrong_streak};
}
$scores->update_player_data($player_id, $player_data);
$scores->end;

23
modules/cjeopardy_hint.pl → modules/cjeopardy/cjeopardy_hint.pl
View File

@ -6,14 +6,20 @@ use strict;
use Time::HiRes qw/gettimeofday/;
use Time::Duration qw/duration/;
my $CJEOPARDY_DATA = 'cjeopardy.dat';
my $CJEOPARDY_HINT = 'cjeopardy.hint';
use Scorekeeper;
use IRCColors;
my $CJEOPARDY_DATA = 'data/cjeopardy.dat';
my $CJEOPARDY_HINT = 'data/cjeopardy.hint';
my @hints = (0.90, 0.75, 0.50, 0.25, 0.10);
my $timeout = 30;
my $nick = shift @ARGV;
my $channel = shift @ARGV;
print STDERR "nick: $nick, channel: $channel\n";
sub encode { my $str = shift; $str =~ s/\\(.)/{sprintf "\\%03d", ord($1)}/ge; return $str; }
sub decode { my $str = shift; $str =~ s/\\(\d{3})/{"\\" . chr($1)}/ge; return $str }
@ -59,7 +65,7 @@ my $duration = scalar gettimeofday - $last_timeout;
if ($duration < $timeout) {
$duration = duration($timeout - $duration);
unless ($duration eq 'just now') {
print "Please wait $duration before requesting another hint.\n";
print "$color{red}Please wait $duration before requesting another hint.$color{reset}\n";
exit;
}
}
@ -91,4 +97,13 @@ foreach my $index (@indices) {
substr $hint, $index, 1, '.';
}
print "Hint: $hint\n";
print "$color{lightgreen}Hint$color{reset}: $hint\n";
my $scores = Scorekeeper->new;
$scores->begin;
my $id = $scores->get_player_id($nick, $channel);
my $player_data = $scores->get_player_data($id, 'hints', 'lifetime_hints');
$player_data->{hints}++;
$player_data->{lifetime_hints}++;
$scores->update_player_data($id, $player_data);
$scores->end;

1
modules/cjeopardy/data/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
*