#!/usr/bin/perl -w # Copyright (c) 2003-2005, Geoff Broadwell; this script is released # as open source and may be distributed and modified under the terms # of either the Artistic License or the GNU General Public License, # in the same manner as Perl itself. These licenses should have been # distributed to you as part of your Perl distribution, and can be # read using `perldoc perlartistic` and `perldoc perlgpl` respectively. use strict; use Text::Autoformat; our $VERSION = '0.1.1'; my ($info, $quit, $stat, @questions, $question_num, $limit_regex); my ($question_format, %valid_types, $actions, $desc); $question_format = { justify => 'left', left => 3, all => 1 }; %valid_types = map {$_ => 1} qw( define ); $actions = { n => \&next_question, p => \&prev_question, r => \&reshow_question, h => \&give_hint, a => \&give_answer, k => \&show_known, l => \&limit_questions, 'q' => \&quit, reload => \&reload_kb, bad_command => \&bad_command, '?' => \&show_commands, }; $desc = { n => "N_ext question", p => "P_revious question", r => "R_edisplay question", h => "show H_int", a => "show A_nswer", k => "show K_nown subjects", l => "L_imit subjects to regex matches", 'q' => "Q_uit", reload => "RELOAD knowledge base", '?' => "show available commands", }; init(); display_message("Knowledge base contains " . scalar(keys %$info) . " subjects."); next_question(); loop(); sub init { my @defs = fetch_defs(); $info = { map { my ($name, $data) = split /\n+/, $_, 2; ( $name => { map { split /\s*:\s*/, $_, 2 } split /\s*>>>\s*/, $data } ) } @defs }; $quit = 0; $stat = {}; $stat->{questions} = 0; $stat->{question}{$_} = 0 foreach keys %$info; @questions = (); $question_num = 0; $limit_regex = qr/./; } sub reload_kb { init(); display_message("Knowledge base reloaded (" . scalar(keys %$info) . " subjects); session reset."); next_question(); } sub loop { while (!$quit) { print "\n> "; $_ = <>; chomp; $stat->{commands}++; $stat->{command}{$_}++; next if /^\s*$/; next if /^\s*#/; my ($cmd, $rest) = split ' ', $_, 2; my $action = $actions->{$cmd} || $actions->{bad_command}; $action->({cmdline => $_, cmd => $cmd, args => $rest}); } } sub quit { $quit = 1; } sub bad_command { display_message("Unrecognized command."); } sub valid_subjects { return grep {/$limit_regex/} keys %$info; } sub limit_questions { my $command = shift; my $arg = $command->{args}; my $regex; eval {$regex = qr/$arg/i}; if ($@) { display_message("Bad regex: $@"); } else { $limit_regex = $regex; display_message("There are " . valid_subjects() . " subjects matching $limit_regex."); } } sub new_question { my @subjects = sort { $stat->{question}{$b} <=> $stat->{question}{$a} } valid_subjects(); my $total = 0; $total += $stat->{question}{$_} foreach @subjects; my $sum = 0; $sum += $total - $stat->{question}{$_} foreach @subjects; my $rand = int rand $sum; my $subject; my $cur = 0; do { $subject = pop @subjects; $cur += $total - $stat->{question}{$subject}; } while ($cur < $rand); $stat->{questions}++; $stat->{question}{$subject}++; push @questions, [define => $subject]; } sub next_question { new_question() if $question_num == @questions; $question_num++; display_question($question_num); } sub prev_question { if ($question_num == 1) { display_message("You are already at the first question."); } else { $question_num--; display_question($question_num); } } sub reshow_question { display_question($question_num); } sub give_hint { display_hint($question_num); } sub give_answer { display_answer($question_num); } sub show_known { my @subjects = valid_subjects(); print "I know about " . @subjects . " subjects matching $limit_regex:\n\n"; foreach (sort @subjects) { print " $_\n"; } } sub show_commands { print "Known commands:\n\n"; foreach (sort keys %$actions) { print "$_\t$desc->{$_}\n" if exists $desc->{$_}; } } sub display_question { my ($num, $type, $q) = check_question(shift) or return; # XXXX - v. v. bad. # system('clear'); my $count = $stat->{question}{$q->[1]}; if ($type eq 'define') { print "Question $num (#$count on this subject):\n\n", autoformat "Define '$q->[1]'.\n", $question_format; } } sub display_hint { my ($num, $type, $q) = check_question(shift) or return; if ($type eq 'define') { print "Hint for question $num:\n\n", autoformat($info->{$q->[1]}{hint} || 'Sorry, no hint found.', $question_format); } } sub display_answer { my ($num, $type, $q) = check_question(shift) or return; if ($type eq 'define') { print "Answer for question $num:\n\n", autoformat $info->{$q->[1]}{definition}, $question_format; } } sub display_message { print autoformat @_; } sub check_question { my $num = shift; display_message("Unknown question number $num."), return if $num > @questions; my $q = $questions[ $num-1 ]; my $type = $q->[0]; display_message("Unknown question type $type for question $num."), return unless $valid_types{$type}; return ($num, $type, $q); } sub fetch_defs { local $/; open DEFS, '<', 'definitions.txt' or die "Could not open fact definition file: $!\n"; my @defs = split /^-----\s*\n+/m, ; close DEFS; return @defs; }