#! /usr/bin/perl
#
# $Id$


use strict;
use warnings;
require Term::ReadKey;
require Tree::Binary::Search;
use Getopt::Long;
require Time::Piece::ISO;
require POSIX;


our $opt_debug=1;
my $opt_dict=$ENV{"HOME"}."/priv/japan-lang/jfe_1-9.csv";
my $opt_log=$opt_dict.".log";

$Getopt::Long::ignorecase=0;
$Getopt::Long::bundling=1;
die if !GetOptions(
		"d|debug+"=>\$opt_debug,
		"c|dict=s"=>\$opt_dict,
		"l|log=s" =>\$opt_log,
		);

my $T;

sub schedule($)
{
	my($r)=@_;

	my $sum=0;
	for my $result (@{$r->{"result"}}) {
		my $age=time()-$result->{"time"};
		$age=0 if $age<0;
		# $age:   0..  big importance
		# $age: big..small importance
		# $ok: 0..mistake
		# $ok: 1..correct
		# $sum:   big..far
		# $sum: small..soon
		# 1/log(2+$age): big..  big importance
		# 1/log(2+$age):   0..small importance
		$sum+=1/log(2+$age)*($result->{"ok"}?+1:-1);
		}
	my $arr=[];
	if ($T->exists($sum)) {
		$arr=$T->select($sum)->{"arr"};
		$T->delete($sum);
	}
	splice @$arr,int(rand(@$arr+1)),0,$r;
	$T->insert($sum=>{"key"=>$sum,"arr"=>$arr});
	print STDERR "; schedule=$sum" if $opt_debug;
}

sub best()
{
	return if $T->isEmpty();
	my $min=$T->min()->{"key"};
	my $arr=$T->select($min)->{"arr"};
	$T->delete($min);
	my $r=shift @$arr;
	$T->insert($min=>{"key"=>$min,"arr"=>$arr}) if @$arr;
	print STDERR "min=$min\n" if $opt_debug;
	return $r;
}

sub identify($)
{
	my($r)=@_;

	return join " ",map(($r->{$_}||"-"),qw(
			written
			phonetic
			));
}

sub result($$)
{
	my($r,$ok)=@_;

	local *LOG_APPEND;
	open LOG_APPEND,">>".$opt_log or die "append \"$opt_log\": $!";
	print LOG_APPEND Time::Piece::ISO::localtime().POSIX::strftime("%z",localtime())." ok=$ok: ".identify($r)."\n";
	close LOG_APPEND or die "close \"$opt_log\": $!";

	push @{$r->{"result"}},{
		"time"=>time(),
		"ok"=>$ok,
		};
	schedule $r;
}

my @R;
my %keyword;
$T=Tree::Binary::Search->new();
$T->useNumericComparison();
local *DICT;
open DICT,$opt_dict or die "open \"$opt_dict\": $!";
while (<DICT>) {
	chomp;
	my $r;
	my $rest;
	(
		$r->{"written"},
		$r->{"phonetic"},
		$r->{"meaning"},
		$r->{"category"},
		$r->{"learned"},
		$rest,
		)=split /\t/;
	next if $r->{"written"} eq "";
	die "Excessive argument: $rest" if defined $rest;
	while ($r->{"meaning"}=~s/\s*<([-\w]+)>\s*//) {
		my $keyword=$1;
		$r->{"meaning_keyword"}{$keyword}=1;
		$keyword{$keyword}=1;
		}
	$r->{"meaning"}!~/[<>]/ or warn "Meaning constains invalid characters: ".$r->{"meaning"};
	push @R,$r;
}
close DICT or die "close \"$opt_dict\": $!";

my %identify=map((identify($_)=>$_),@R);

local *LOG_READ;
if (!open LOG_READ,$opt_log) {
	warn "open \"$opt_log\": $!";
} else {
	while (<LOG_READ>) {
		chomp;
		# 2002-04-25T21:17:52+0900 ok=1: identify($r)
		my($year, $month, $day,   $hour,  $minute,$second,$zonepm,$zonehour,$zoneminute,$ok,$identify)=
		/^(\d{4})-(\d{1,2})-(\d{2})T(\d{2}):(\d{2}):(\d{2})([+-])(\d{2})(\d{2}) ok=(\d+): (.+)$/
				or do { warn "Unrecognized line: $_\n"; next; };
		$year-=1900;
		$month--;
		my $localtime=POSIX::mktime($second,$minute,$hour,$day,$month,$year);
		$localtime or do { warn "Unparsable time at line: $_\n"; next; };
		my $gmtime=$localtime-($zonepm."1")*($zonehour*60+$zoneminute);
		my $r=$identify{$identify}
				or do { warn "Word not found from line: $_\n"; next; };
		push @{$r->{"result"}},{
			"time"=>$gmtime,
			"ok"=>$ok,
			};
	}
	close LOG_READ or die "close \"$opt_log\": $!";
}

for my $r (@R) {
	local $opt_debug=0 if $opt_debug<2;
	print STDERR $r->{"phonetic"}."\t".$r->{"meaning"} if $opt_debug;
	schedule $r;
	print STDERR "\n" if $opt_debug;
}

my %exam=(
	"phonetic"=>"meaning",
	"meaning"=>"phonetic",
	);
my @exam=keys(%exam);
my $r_last;
my $exam_from_last;
for (;;) {
	my $r=best();
	# Do not change $exam_from if $r remained the same:
	my $exam_from=$exam_from_last;
	if (!$r_last || $r ne $r_last) {
		$exam_from=$exam[int rand @exam];
		}
	my $exam_to  =$exam{$exam_from};
	print $r->{$exam_from}.": ";
	my $got=<STDIN>;
	chomp $got;
	my $want=$r->{$exam_to};
	print "-------> $want\n";
	(my $got_chk =lc $got )=~s/\s//g;
	(my $want_chk=lc $want)=~s/\s//g;
	$got_chk=~s/\bto\b//g;
	$want_chk=~s/\bto\b//g;
	$want_chk=~s/[(][^)]*[)]//g;
	warn "Parenthesis ('(',')') not supported in the user input: $got\n" if $got=~/[()]/;
	warn "Comma (',') not well supported in the user input: $got\n" if $got=~/,/;
	my $ok;
	$ok=1 if $got_chk eq $want_chk;	# incl. commas
	for (split /,/,$want_chk) {
		$ok=1 if $got_chk eq $_;
	}
	if (!$ok) {
		if ($exam_to eq "meaning" && $got=~/\S/ && $want=~/\Q$got\E/) {
			my $key;
			do {
				print STDERR "Is your answer correct? [y/n] ";
				sub restore
				{
					Term::ReadKey::ReadMode(0);
				}
				local $SIG{"__DIE__"}=\&restore;
				Term::ReadKey::ReadMode(4);
				$key=Term::ReadKey::ReadKey(0);
				print STDERR "\n";	# no echo
				restore();
				$ok=1 if $key eq "y";
				$ok=0 if $key eq "n";
			} while (!defined $ok);
		}
	}
	$ok||=0;
	print STDERR "result: ".($ok ? "ok" : "WRONG");
	result($r,$ok);
	print "\n";
	$r_last=$r;
	$exam_from_last=$exam_from;
}