#!/usr/bin/perl
#
# This program was originally written by Randal L. Schwartz.
# Modifications by Tobias Toedter.
#
# This program is copyright (c) by
#     Randal L. Schwartz         2002
#     Tobias Toedter             2003-2004
#
# This program is licensed under the Artistic License, see
# the file COPYING for details.
#
# I found it in a newsgroup and added some features:
#  * stores the knowledgebase in a file in the users home dir
#  * parses commandline for new, version and help requests
#  * since it's a childrens game, use i18n for translations
#
# Please find below the original comment from Randal.
#
# I originally wrote this for a column,
# but haven't gotten around to using it yet.
# just think of an animal, and invoke it.
# It's an example of a self-learning game.
# When you choose not to continue, it'll dump out
# the data structure of knowledge it has accumulated.


use warnings;
use strict;
use Data::Dumper;
use Getopt::Long;
use POSIX;
use Locale::gettext;

my $release_version = "0.9.1";


# do the inits for i18n
setlocale(LC_MESSAGES, "");
textdomain("animals-game");


# check for commandline arguments
my $opt_version = "";
my $opt_help = "";
my $opt_new = "";
my $result = GetOptions(
	"version" => \$opt_version,
	"help"    => \$opt_help,
	"new"     => \$opt_new);

if ($opt_version eq "1") {
	&show_version;
	exit;
}
if ($opt_help eq "1" or !$result) {
	&show_usage;
	exit;
}


# The location of the knowledgebase-file
if ($ENV{'HOME'} eq "") {
	# Notice for translation:
	# Since this program is intented to be a children's game, it's probably
	# better to address the user in a "non-formal" way than using a more
	# "polite" one.
	# Now don't get me wrong: Please don't swear at the user! ;-)
	# Be polite, but keep in mind that your primary audience will be
	# children.
	#
	# This applies only to some languages, e.g. German, French, Spanish...
	# ("Du" instead of "Sie", "tu" instead of "vous" and so on)
	# If you don't have this difference in your grammar (e.g. English),
	# you don't have to care about this paragraph. :-)
	print gettext("Error: Please specify your home directory in the environment variable \"HOME\"."), "\n";
	print gettext("Maybe you can use this commandline: \"HOME=/home/yourname animals-game\""), "\n";
	exit;
}
my $knowledgebase = "$ENV{'HOME'}/.animals-game-knowledge";


# See if we can use an old knowledgebase
my $info = gettext("dog");
unless ($opt_new eq "1") {
	$info = do "$knowledgebase" if -r "$knowledgebase";
}


# nice greeting message
print gettext("Welcome to animals-game!"), "\n\n";
print gettext("Think of an animal, and I'll try to guess which one you were thinking of."), "\n";
print gettext("Press <RETURN> when ready..."), "\n";
<STDIN>;


# The main part of the program - add more info to the binary tree
# unless the user doesn't want to play any more
{
	try($info);
	redo if (yes(gettext("Do you want to play again (yes/no)? ")));
}


# Finished the game. Save the knowledgebase in a format parseable for perl
open KNOWLEDGEBASE, "> $knowledgebase"
	or die sprintf(gettext("Unable to write to file \"%s\":"), $knowledgebase), " $!\n";
print KNOWLEDGEBASE Dumper($info);
print gettext("Bye!"), "\n";


sub try {
	my $this = $_[0];
	if (ref $this) {
		return try($this->{yes($this->{Question}.gettext(" (yes/no)? ")) ? 'Yes' : 'No' });
	}
	# Notice for translation:
	# Please consider that your language may have different articles
	# depending on the gender of the animal. Examples:
	# German: "Ist es ein/eine %s (ja/nein)? " -> applies to Hund vs. Katze
	# French: "Est-ce que c'est un/une %s (oui/non)? "
	#         -> applies to chien vs. souris
	#
	# Note that the French example may not be absolutely accurate, since
	# I'm not a native speaker. But at least you get the idea... ;-)
	if (yes(sprintf(gettext("Is it a/an %s (yes/no)? "), $this))) {
		print gettext("I got it!"), "\n";
		return 1;
	};
	print gettext("No!? I give up. You win! Which animal were you thinking of?"), " ";
	chomp(my $new = <STDIN>);
	printf gettext("And a question that distinguishes a/an %s\nfrom a/an %s would be? "), $this, $new;
	chomp(my $question = <STDIN>);
	my $yes = yes(sprintf(gettext("And for a/an %s, the answer would be (yes/no)? "), $new));
	$_[0] = {
		Question => $question,
		Yes => $yes ? $new : $this,
		No => $yes ? $this : $new,
	};
	return 0;
}


sub yes {
	# Notice for translation:
	# This should be the first letter of the word "yes" in your language.
	# If the words "yes" and "no" both start with the same letter in your
	# language, please supply as many letters as are necessary for
	# distinguishing between the "yes" and the "no" answers.
	my $first_letter_of_yes_answer = gettext("y");
	print @_;
	<STDIN> =~ /^$first_letter_of_yes_answer/i;
}


sub show_version {
	printf gettext("animals-game version %s"), $release_version."\n";
}


sub show_usage {
	&show_version;

	print gettext("Original program copyright (c) 2002 Randal L. Schwartz"), "\n";
	print gettext("Modifications copyright (c) 2003-2004 Tobias Toedter"), "\n";
	# Notice for translation:
	# The next (translated msgstr) line should be modified in the .po-file by the
	# translator to include his/her name and the correct language, of course...
	# Please let the msgid-string intact.
	print gettext("English translation by Tobias Toedter"), "\n";
	print gettext("This software is licensed under the Artistic License."), "\n\n";
	print gettext("Commandline options:"), "\n";
	print gettext("  --new        start with an empty knowledge base"), "\n";
	print gettext("  --help       show this text"), "\n";
	print gettext("  --version    show the current version of animals-game"), "\n";
}
