#!/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
#  * output in color, so children can better distinguish between
#    the computer's questions and their own answers
#
# 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 = "1.0.2";


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

# set the color codes for terminal output
my $color_reset = "\033[0m";
my $color_error = "\033[31m";
my $color_computer = "\033[01;33m";
my $color_gameend = "\033[36m";
my $color_user = "\033[32m";

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

if ($opt_blackandwhite eq "1") {
	$color_reset = $color_error = $color_computer =
	$color_gameend = $color_user = "";
}
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 $color_error;
	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";
	print $color_reset;
	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 $color_computer;
print gettext("Welcome to animals-game!"), "\n\n";


# The main part of the program - add more info to the binary tree
# unless the user doesn't want to play any more
{
	print $color_computer;
	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";
	my $ret = <STDIN>;
	exit unless defined($ret);

	try($info);
	print $color_gameend;
	print gettext("Do you want to play again (yes/no)?")." ";
	redo if yes();
}


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


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 $color_gameend;
		print gettext("I got it!"), "\n";
		return 1;
	};
	print $color_gameend;
	print gettext("No!? I give up. You win! Which animal were you thinking of?")."\n";
	print $color_user."-> ";
	chomp(my $new = <STDIN>);
	exit unless defined($new);
	print $color_computer;
	printf gettext("And a question that distinguishes a/an %s\nfrom a/an %s would be?")."\n", $this, $new;
	print $color_user . "-> ";
	chomp(my $question = <STDIN>);
	exit unless defined($question);
	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 $color_computer;
	print "@_\n";
	print $color_user."-> ";
	my $answer = <STDIN>;
	exit unless defined($answer);
	return $answer =~ /^$first_letter_of_yes_answer/i;
}


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


sub show_usage {
	&show_version;

	print $color_computer;
	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("  --black-and-white    do not use colored output"), "\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";
	print $color_reset;
}
