#!/usr/bin/perl -w

use strict;
use Getopt::Std;
use Term::ReadLine;

my (%opts, $term);

%opts = (
    r => 10,	# radix or radix string
    d => 4,	# number of digits
);

my (%problem);
# 有關題目的描述, 共有三個欄位:
# ans		答案 (例如 4172)
# n_g		已經猜了幾次 (例如 3)
# digits	題目可能用到的數字或字母有那些 (例如 "0123456789")

sub match {
    # 輸入 $x, $y 兩個字串, 傳回兩個數字, 分別代表幾 A 幾 B,
    # 例如 match("past", "tape") 傳回 (1, 2)
    my ($x, $y) = @_;
    my ($i, $A, $B);
    $A = $B = 0;
    for ($i=0; $i<length($x); ++$i) {
	my ($t) = substr($x,$i,1);	# 抓出 $x 的第 $i 個字元 $t
	next if index($y, $t) < 0;	# 如果 $t 並未出現在 $y 當中, 跳過
	# 看看 $t 是否出現在 $y 的第 $i 個字元, 來決定要加 $A 還是加 $B
	if ($t eq substr($y,$i,1)) { ++$A; } else { ++$B; }
    }
    return ($A, $B);
}

sub find_duplicate {
    # 傳回 $x 字串裡面, 所有重複的字元。 (以 list 傳回)
    # 例如 find_duplicate("5566") 傳回 ("5", "6")
    # 又如 find_duplicate("fantastic") 傳回 ("a", "t")
    # 再如 find_duplicate("uniq") 傳回 ( )
    my ($x) = @_;
    my (%t);
    map { ++$t{$_} } split(//,$x);
    return grep { $t{$_} > 1 } keys %t;
}

sub subset {
    # 如果 $x 的每個字元, 在 $y 裡面都找得到, 就傳回 true;
    # 不然就傳回 false。 例如 subset("bad", "abcde")
    # 與 subset("ace", "abcde") 都是 true; 而 subset("care", "abcde")
    # 則是 false, 因為 "r" 在 "abcde" 裡面找不到
    my ($x, $y) = @_;
    return not grep { index($y,$_)<0 } split("", $x);
}

sub rand_str {
    # 產生一個長度為 $n_d 的亂數字串 (拿 $digits 裡面的字元當材料)
    # 裡面不可以出現重複的字元。 例如 rand_str(3, "abcdefg")
    # 可能會產生 "fad", 但不可以產生 "egg"
    my ($n_d, $digits) = @_;
    my ($i, $d, $s);
    $s = "";
    for ($i=0; $i<$n_d; ++$i) {
	while (1) {
	    # 從 $digits 當中, 用亂數取出一個字元 $d
	    $d = substr($digits, rand(length($digits)), 1);
	    # 如果 $d 並未出現在 $s 當中, 就成功跳出無窮迴圈
	    last if index($s,$d) < 0;
	}
	# 把 $d 接到 $s 尾巴去
	$s .= $d;
    }
    return $s;
}

sub digit_string {
    my ($radix) = @_;
    return $radix unless $radix =~ /^\d\d?$/;
    my ($rs) =  [
	(map { chr($_+ord('0')) } 0..9),
	(map { chr($_+ord('a')) } 0..25),
    ];
    return substr(join("", @$rs),0,$radix);
}

sub cmd_print_help {
    print <<eof;
	:h		help
	:q		quit
	:n [d] [r]	generates a new game with a d-digit radix-r number
	:i		query information about the answer
	:peek		peek the answer (don't do it)
eof
}

sub cmd_print_info {
    print "the answer is a ", length($problem{ans}),
	" digit string composed of '$problem{digits}'\n";
}

sub cmd_new_game {
    my ($n_d, $radix) = @_;
    $n_d = $opts{d} unless defined $n_d;
    $radix = $opts{r} unless defined $radix;
    my ($digits) = digit_string($radix);
    if ($n_d > length($digits)) {
	print STDERR "error: too many digits requested!\n";
	return;
    }
    if ($digits =~ /(\W)/) {
	print STDERR "error: illegal character '$1' in digit string\n";
	return;
    }
    print "-" x 20, " new game ", "-" x 20, "\n";
    %problem = ( n_d=>$n_d, digits=>$digits, ans=>rand_str($n_d, $digits) );
    cmd_print_info();
}

sub cmd_match {
    my ($guess) = @_;
    if (length($guess) != length($problem{ans})) {
	print STDERR "error: needed ", length($problem{ans}),
	    " digits but got ", length($guess), " digits\n";
	return;
    }
    my (@dup) = find_duplicate($guess);
    if (@dup) {
	print STDERR "error: duplicated digits <@dup>\n";
	return;
    }
    my ($A, $B) = match($guess, $problem{ans});
    ++$problem{n_g};
    if ($A == length($problem{ans})) {
	print "you've got it right in ", $problem{n_g}, " guesses!\n";
	cmd_new_game();
    } else {
	print "$A A $B B\n";
    }
}

getopts('r:d:', \%opts);
$term = new Term::ReadLine 'Number/String Guessing Game';
print "Type ':h' to get help\n";
cmd_new_game();
while ( defined ($_ = $term->readline("Your Guess? ")) ) {
    s/#.*$//;
    my ($cmd, @args) = split " ";
    next unless defined $cmd;
    if ($cmd eq ":q") {
	last;
    } elsif ($cmd eq ":n") {
	cmd_new_game(@args);
    } elsif ($cmd eq ":i") {
	cmd_print_info();
    } elsif ($cmd eq ":peek") {
	print "<$problem{ans}>\n";
    } elsif ($cmd =~ /\?/ or $cmd =~ /^:h/) {
	cmd_print_help();
    } elsif (subset($cmd, $problem{digits})) {
	cmd_match($cmd);
    } else {
	print STDERR "unkown command '$cmd' ignored\n";
    }
}
print "bye!\n";

__END__

=head1 NAME

guessnumber - a number guessing game

=head1 SYNOPSIS

B<guessnumber> [ B<-r> I<'radix_string'> ] [ B<-d> I<'n_digits'> ]

=head1 DESCRIPTION

There are two players in the game of guessing numbers,
one selecting a number and counting matches,
the other guessing the number. This program plays the
role of the former, while the user plays the role of
the latter. The program first generates a 4-digit random
number whose digits are all distinct. This number is kept
secrete from the user. Each time the user guesses a 4-digit
number, the program counts the number of digits whose
positions coincide with those in the answer, and report
this number as A. It also counts the number of digits
which appear in the answer but have different positions,
and report this number as B. For example, if the answer
is "3085" and the guess is "8057", then the computer reports
"1A2B" since "0" counts as an A, while "8" and "5" count as
B's. The game continues until the user gets the answer
correctly, namely obtaining a "4A0B" report from the program.

This program is a perl script. You can run it by typing
C<perl guessnumber> and read its documentation by typing
C<perldoc guessnumber>. Once inside, type C<:h> to get help.
(The html page is generated by typing C<pod2html guessnumber>
and therefore is pretty much the same as, possibly older than,
the document embedded in the program.)

=head1 OPTIONS

=over 8

=item B<-r> I<'radix_string'>

Use I<radix_string> as the radix string instead of '0123456789'.
If I<radix_string> is a one-digit or two-digit number,
the first I<radix_string> characters of '0123456789abcdef...xyz'
is used.

=item B<-d> I<'n_digits'>

Generate I<n_digits>-digit numbers instead of 4-digit numbers.

=back

=head1 LICENSE

This code is distributed under the GNU General Public License

=head1 AUTHOR

B<Chao-Kuei Hung> ckhung AT cyut DOT edu DOT tw

The latest version is available at:
L<http://www.cyut.edu.tw/~ckhung/p/toy/guessnumber>

=cut