#!/usr/bin/perl -w

# vim:set ts=4 sw=4 cin sm:

# This code is under the BSD Licence
# (c) by Stefan `Sec` Zehl <sec@42.org>

use constant beopardy =>
	q$Id: beopardy,v 1.8 2001/08/10 13:53:59 sec Exp sec $;

use strict;
use Tk;
use Tk::X11Font;
use Tk::Dialog;
use Socket;
use FileHandle;
use Getopt::Std;

# Global options. Set via getopt.
my $debug=0;
my $override=0;					# Ignore windowmanager?
my $force=0;					# move focus for kbd-mode?
my $tty=0;						# use tty/serial input?
my $socket=0;					# tty emulated by tcp socket?
my $geometry=0;					# How big should I be?
my $readfile;					# Should I read from a file?
my $savefile=0;					# Should I save to a file?

# L10n
my %ln = (
		"Richtig"			=> "right",
		"Falsch"			=> "wrong",
		"Oops"				=> "oops",
		"ist etwas unruhig"	=> "seems a bit nervous",
		"Knopf loesen"		=> "release your button",
		);

sub _ {
	my $key=shift;
	if (defined ($ln{$key})){
		return $ln{$key};
	}else{
		return $key;
	};
};

my %opt;
getopts('doftsg:r:hw', \%opt);

# Possible screen sizes
my %screen=( 320 => 200,
			 640 => 480,
		     800 => 600, 
			1024 => 786);

my @beopardy = split(/ /,beopardy);

if (defined $opt{h}){
	print <<EOF;
This is Beopardy $beopardy[2] $beopardy[3].

beopardy -options Gamefile Player1 Player2 ...

-h		This help.
-d		Debug mode. Print lots'o stuff.
-o		Override. Ignore Windowmanager. (fullscreen)
-f		Force keyboard focus.           (fullscreen)
-t		Tty input. Use when Buzzers are connected.
-s		Socket. Emulate Tty input via tcp socket (port 3333)
-r <file>	Read saved game from File.
-w		Save game progress for reading with -r.
-g <size>	geometry. Select window size.
		0: fullscreen (default)
EOF
	my $x=1;
	foreach (sort {$a <=> $b } keys %screen){
		printf "\t\t%1d: %4dx%4d\n",$x++,$_,$screen{$_};
	}
	print "";
	exit(42);
}

$debug=1	if (defined $opt{d});
$override=1	if (defined $opt{o});
$force=1	if (defined $opt{f});
$tty=1		if (defined $opt{t});
$socket=1	if (defined $opt{s});
$savefile=1	if (defined $opt{w});

if($opt{r}){ # Read savefile
	if ( -f $opt{r} ){
		$readfile=$opt{r};
	};
};

if ($socket){$tty=1};	# socket emulates tty.

my $tl = MainWindow -> new -> toplevel;
$tl->appname(beopardy);
my ($width,$height)=($tl->screenwidth,$tl->screenheight);	# Size of game field.

if (defined $opt{g}){
	if ($opt{g} =~ /^(\d+)[x*](\d+)$/){
		($width,$height)=($1,$2);
	} elsif ( defined $screen{$opt{g}}){
		($width,$height)=($opt{g},$screen{$opt{g}});
	}else{
		my @x = (sort {$a<=>$b} keys %screen);
		if ((--$opt{g}<=$#x) && ($opt{g}>=0 )){
			$width=$x[$opt{g}];
			$height=$screen{$width};
		};
	};
}

my $q=5;						# Wieviele Fragen/Kategorie?
my $qwidth=35;					# Width of a question.
my $catwidth =10;				# Width of categories.
my $namewidth=10;				# Width of player names

if ($tty){
	print "Opening tty\n";
	if($socket){
		my $port = 3333;
		my $proto = getprotobyname('tcp');
		socket(Server, PF_INET, SOCK_STREAM, $proto)	|| die "socket: $!";
		setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1))
														|| die "setsockopt: $!";
		bind(Server, sockaddr_in($port, INADDR_ANY))	|| die "bind: $!" ;
		listen(Server,SOMAXCONN)						|| die "listen: $!";
		print "Now connect to port $port...\n";
		my $paddr = accept(Client,Server);
		my($iport,$iaddr) = sockaddr_in($paddr);
		my $name = gethostbyaddr($iaddr,AF_INET);
		print "connection from $name [", inet_ntoa($iaddr), "] at port $iport\n";
	}else{
		# Be sure to set device to -crtscts 19200
		open(Client,"+>/dev/cuaa0") || die "open: $!";
	};
	print "done.\n";
	autoflush Client;
};

print "Reading questions....\n";
my %jdata;
open (J,"<Jeopardy") || die;
my ($nam,$c);
while (<J>){
	chomp;
	next if ((!defined $nam) && (!/^>/));
	next if /^\s*(#|$)/;
	if (/^>(.*)/){
		if(defined $nam){
			printf "%-20s:%2d\n",$nam,$c if ($debug);
		};
		$nam=$1;
		$c=0;
		next;
	}
	$_.=" ";
	if (!s/\\n/\n/){
		s/(.{10,$qwidth})\s+/$1\n/mg;
	};
	$jdata{$nam}[++$c]=$_;
};
close(J);
printf "%-20s:%2d\n",$nam,$c if ($debug);

print "Totalling ",(scalar keys %jdata)," categories.\n";

sub logname{
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
	$year+=1900;$mon++;
	return (sprintf "%04d%02d%02d.%02d%02d",$year,$mon,$mday,$hour,$min);
}

sub read_game{
	my @Cat;			# Namen der Kategorien
	my $q=shift;		# Wieviele Fragen/Kategorie?
	my $gamefile=shift(@ARGV)||"Test.jg";
	$gamefile .= ".jg" if ( -f $gamefile.".jg" );
	$gamefile =~ /^([^.]+)(.jg)?/;
	my $title=$1;		# Titel des Spielfelds.

	print "\nReading game '$title' ...\n";
	open(G,"<$gamefile") || die;
	while (<G>){
		chomp;
		next if (/^\s*(#|$)/);
		push @Cat,$_;
	};
	close(G);

	my $p=0;
	for (@Cat){
		printf "%-20s:%2d\n",$_,$#{$jdata{$_}} if ($debug);
		if ($#{$jdata{$_}} < $q){
			print "ERROR: not enough questions in \"$_\"\n";
			$p++;
		};
		if ($#{$jdata{$_}} > $q){
			print "WARN : too many questions in \"$_\"\n";
#			$p++;
		};
	};
	if ($p){
		print "Hit enter to continue...\n";
		$p=<>;
	};
	if($savefile){
		my($ts)=logname();
		open(SAV,">$gamefile.$ts");
		select(SAV);$|=1;
		select(STDOUT);
	}else{
		open(SAV,">-");
	};

	return $title,@Cat;
};

# Titel und Fragen
my ($title,@Cat)=&read_game($q);

my @players;
if ($#ARGV>0){
	@players=@ARGV;
}else{
	@players=qw(Foo Bar Baz);
};

print SAV "[ply] ",join("/",@players),"\n";

my @colors=qw(darkgrey darkred darkgreen darkblue cyan);

unshift @players,"Nobody";
my @points=(0)x($#players+1);

# Here starts the Tk part...
#my $qfont=$tl->X11Font('-*-new century schoolbook-medium-r-*--40-*-*-*-*-*-iso8859-1');
my $qfont=$tl->X11Font('-truetype-arial-medium-r-*-*-40-*-*-*-*-*-ascii-*');
print "Question-Font:\n$qfont\n" if ($debug);
my $qsfont=$tl->X11Font('-truetype-arial-medium-r-*-*-35-*-*-*-*-*-ascii-*');

#my $tfont=$tl->X11Font('-*-helvetica-medium-r-*--30-*-*-*-*-*-iso8859-1');
my $tfont=$tl->X11Font('-bitstream-*-medium-r-*-*-36-*-*-*-*-*-iso8859-1');
print "Title-Font:\n$tfont\n" if($debug);

$tl->configure(-height => $height, -width => $width);
$tl->resizable(0,0);
$tl->packPropagate(0);	# Keep the size.
$tl->overrideredirect(1) if ($override);

# Title of Gamefield
my $tlabel = $tl -> Label (
		-text	=> $title,
		-relief => 'ridge',
		-font	=> $tfont,
) -> pack(-fill	=> 'x');

$tl->eventAdd('<<quit>>'=>'<Button-3>');
$tl->eventAdd('<<quit>>'=>'<Q>');
$tl->bind('<<quit>>',sub{print "Done:\n",map {sprintf "%10s:%5d\n",$players[$_],$points[$_]} sort {$points[$b]<=>$points[$a]} (1..$#points);exit});

# Game-Buttons.
my $bframe=$tl->Frame->pack(-fill=>'both',-expand=>1);
my @button;	# The TkButtons 
my @pts;	# Who got points from this question?
my @frame;  # The TkFrames, one per category.
for my $cat (0..$#Cat){
	$frame[$cat]=$bframe->Frame->pack(
			-side	=>'left',
			-fill	=>'both',
			-expand	=> 1,
	);

	$button[$cat][0] = $frame[$cat]->Label(
			-width	=> $catwidth,
			-text	=> $Cat[$cat],
	)->pack(-fill	=> 'both');

	for my $q (1..$q) {
		$button[$cat][$q] = $frame[$cat]->Button(
				-text		=> "${q}00",
				-command	=> [\&selectQuest,$tl,$cat,$q],
				-font		=> $tfont,
		)->pack( -fill => 'both', -expand => 1);
		$button[$cat][$q]->bind('<h>',[\&moveCrsr,$cat-1,$q  ]);
		$button[$cat][$q]->bind('<j>',[\&moveCrsr,$cat  ,$q+1]);
		$button[$cat][$q]->bind('<k>',[\&moveCrsr,$cat  ,$q-1]);
		$button[$cat][$q]->bind('<l>',[\&moveCrsr,$cat+1,$q  ]);
# Fuer mh, der die VI-Keys nicht mag...
		$button[$cat][$q]->bind('<Left>' ,[\&moveCrsr,$cat-1,$q  ]);
		$button[$cat][$q]->bind('<Down>' ,[\&moveCrsr,$cat  ,$q+1]);
		$button[$cat][$q]->bind('<Up>'   ,[\&moveCrsr,$cat  ,$q-1]);
		$button[$cat][$q]->bind('<Right>',[\&moveCrsr,$cat+1,$q  ]);
	};
};
$button[0][1]->focus;
#$button[0][1]->focusForce if ($force);

# Scoreboard.
my $sframe=$tl->Frame->pack(-side=>'top',-fill=>'x');
my @pborder;
my @pframes;
my @pnames;
my @pscores;
for (1..$#players){
	if ($_ == $#players){
		$pborder[$_]=$sframe;
	}else{
		$pborder[$_]=$sframe->Frame->pack(
				-side	=>'left',
				-fill	=>'x',
				-expand	=>1,
		);
	};

	$pframes[$_]=$pborder[$_]->Label( -relief=>'ridge')->pack( -side=>'left');
	$pnames[$_] =$pframes[$_]->Label(
			-width		=>$namewidth,
			-anchor		=>'w',
			-textvar	=> \$players[$_],
			-background	=> $colors[$_],
			-foreground	=> "white",
	)->pack;
	$pscores[$_]=$pframes[$_]->Label(
			-textvar	=> \$points[$_],
			-anchor		=>'e',
	)->pack(-fill=>'x');
};

#print "Board done.\n";

if(defined $readfile){
	my($c,$f,$sgn,$ply);
	print "Reading Savegame...\n";
	open(RSAV,$readfile) || die "Savegame error: $!";
	while(<RSAV>){
		if (/^\[ply\]/){
			(undef,$ply)=split;
			@players=split(/\//,$ply);
			unshift @players,"Nobody";
			next;
		};
		next if(! /^\[sav\]/);
		(undef,$c,$f,$sgn,$ply)=split;
		print "$c - $f - $sgn - $ply\n";
		updPlayfield($c,$f,$ply,$sgn);
	};
	close(RSAV);
};

print "\nGame start.\n\n";

if($tty){
	my $dlg=$tl->Toplevel;
	$dlg->Button(
			-text	=> "Start",
			-font	=> $qfont,
			-width	=> 30,
			-height	=> 10,
			-command	=> sub { $dlg->destroy;&ser_reset;$button[0][1]->focusForce if ($force)},
	)->pack(
			-fill	=>'x',
			-expand	=>1,
	);
	$dlg->raise;
	$dlg->grab;
	$dlg->focusForce;
	$tl->lower($dlg);
};

# Make the 'resetting' window...
my $reset=$tl->Toplevel;
$reset->overrideredirect(1);
$reset->resizable(0,0);
$reset->geometry("-0+0");
$reset->withdraw;
$reset->Label(-text=>"resetting",-background=>"green")->pack;

MainLoop;

# We selected a question...

sub selectQuest{
	my ($otl,$c,$f)=@_;
	print "Q$f / \"$Cat[$c]\":\n$jdata{$Cat[$c]}[$f]\n";

	my $tl = $otl->Toplevel;
	$tl->configure(-height => $height, -width => $width);
	$tl->resizable(0,0);
	$tl->packPropagate(0);	# Keep the size.
	$tl->overrideredirect(1) if($override);
	$tl->grab;

	my $tlabel = $tl->Label(
			-text	=> $Cat[$c],
			-relief	=> 'ridge',
			-font	=> $tfont,
	) -> pack(-fill	=> 'x');

# XXX Pixmap-Hack. *funfunfun*

	my ($i,$fnam);
	if ($jdata{$Cat[$c]}[$f] =~ s/^\[(img):(.*?)\]//){
		$fnam=$2;
		print "This is a $1 - $2\n";
		$i= $tl->Pixmap($fnam,-file => "img/".$fnam.".xpm");
	}

	my $question;
	if (defined $i){
		$question = $tl->Label(
			-image	=> "$fnam",
		);
	}else{
		$question = $tl->Label(
			-text	=> $jdata{$Cat[$c]}[$f],
			-font	=> $qfont,
		);
	};

	$question->pack(
			-fill	=>'both',
			-expand	=>1
	);

	$tl->focusForce if ($force);

	$tl->bind('<Key>',[\&answerQuest,$c,$f,Ev('A')]);
	$tl->afterIdle(sub {&ser_en($tl,$c,$f) if ($tty);}); # fix Bug#2
};

sub ser_answerQuest {
	my ($crap,$c,$f)=@_;

	my $key=<Client>;
	$key=~s/\r?\n$//;

	my $ich=$crap->Toplevel;

	$ich->overrideredirect(1) if($override);
	$ich->resizable(0,0);
	$ich->geometry("-0-0");

	my $ftl = $ich->Frame( -relief => 'ridge', -bd => 4)->pack;
	$ftl->Label(
			-text	=> $players[$key],
			-font	=> $qfont,
	)->pack(
			-fill	=>'x',
			-expand	=> 1,
	);
	my $bframe=$ftl->Frame->pack(-fill=>'both',-expand=>1);

	my $br=$bframe->Button(
			-text		=> _('Richtig'),
			-command	=> [\&answerQuest,$crap,$c,$f,$key],
	)->pack(-side	=>'left');
	my $bf=$bframe->Button(
			-text		=> _('Falsch'),
			-command	=> sub{
							$ich->destroy;
							&answerQuest($crap,$c,$f,-$key);
							$crap->focusForce if ($force);
							&ser_en($crap,$c,$f)},
	)->pack(-side	=>'left');
	my $bo=$bframe->Button(
			-text		=> _('Oops'),
			-command	=> sub{$ich->destroy;
							  &ser_reset;
							  $crap->focusForce if ($force);
							  &ser_en($crap,$c,$f)},
	)->pack;
#	$ich->bind('<q>',sub{$ich->destroy; &ser_reset; &ser_en($crap,$c,$f)});
#	$ich->bind('<o>',sub{$ich->destroy; &ser_reset; &ser_en($crap,$c,$f)});
#	$ich->bind('<r>',[\&answerQuest,$crap,$c,$f,$key]);
#	$ich->bind('<f>',sub{$ich->destroy;&answerQuest($crap,$c,$f,-$key);&ser_en($crap,$c,$f)});

	$br->bind('<l>',sub{$bf->focus});
	$bf->bind('<l>',sub{$bo->focus});
	$bo->bind('<l>',sub{$br->focus});
	$br->bind('<h>',sub{$bo->focus});
	$bf->bind('<h>',sub{$br->focus});
	$bo->bind('<h>',sub{$bf->focus});
# mh ist auch hier faul :)
	$br->bind('<Right>',sub{$bf->focus});
	$bf->bind('<Right>',sub{$bo->focus});
	$bo->bind('<Right>',sub{$br->focus});
	$br->bind('<Left>' ,sub{$bo->focus});
	$bf->bind('<Left>' ,sub{$br->focus});
	$bo->bind('<Left>' ,sub{$bf->focus});

	$br->focusForce if($force);

#	print "ser_answer done\n";
};

sub ser_en{
	$tl->fileevent(\*Client,'readable',[\&ser_answerQuest,@_]);
};
sub ser_dis{
	$tl->fileevent(\*Client,'readable',[\&ser_noinp]);
};

# User answered the Question.
sub answerQuest{
	my ($crap,$c,$f,$key)=@_;
	print "answered: $c $f $key\n";
	my $sgn=1;
	if($key eq "q"){
		$crap->destroy;
		&ser_dis if ($tty);  # "input nach 'q' auf frage" fix.
		$button[$c][$f]->focusForce if ($force);
		return;
	};
	my $pos;
	$key=-$pos if (($pos=index('0!"#$%&/()',$key))>0);
	$key=-3  if($key eq '§');
	$key="0" if($key eq "`"); # Be nice on ami-kbd
	$key="0" if($key eq "^"); # Be nice on german-kbd

	print "->$key\n" if ($debug);

	if($key=~/^-?\d$/){
		if ($key<0) {
			$sgn=-$sgn;
			$key=-$key;
		};
		if ($key <= $#players){
			&updPlayfield($c,$f,$key,$sgn);
			$crap->destroy if ($sgn>0);
			&ser_reset if ($tty);
			$button[$c][$f]->focusForce if ($force && ($sgn>0));
			return;
		};
	};
	print "I don't like this key ($key)...\n" if($debug);
};

sub updPlayfield {
	my ($c,$f,$key,$sgn)=@_;
	print $sgn<0?"bad":"good"," for ",$players[$key],"\n";
	print SAV "[sav] $c $f $sgn $key\n";
	$points[$key]+=$sgn*$f*100;
	
	push @{$pts[$c][$f]},$sgn*$key;
	my $pl=join("\n",map {($_<0?"-":" ").$players[abs]} @{$pts[$c][$f]});
#	my $pl=join("",map {($_<0?"-":"+").abs} @{$pts[$c][$f]});
	my $col=${pts[$c][$f]}[-1];
	if($col<0){$col=0};
	$col=$colors[$col];
#	print ">$pl<\n";
#	my $oheight=$button[$c][$f]->height;
	$button[$c][$f]->configure(
			-text				=> $pl,
			-relief				=> "flat",
			-foreground			=>'grey',
			-activeforeground	=>'grey',
			-height				=> 1,
			-width				=> 1,
			-background			=> $col,
			-font				=> $qfont,
	);
#	$button[$c][$f]->GeometryRequest(40,$oheight/2);
    print "Pts:",(map {sprintf "%s:%d/",$players[$_],$points[$_]} (1..$#points)),"\n";
	return $pl;
}

sub moveCrsr{
	my ($widget,$c,$f)=@_;
	$c=0 if($c>$#Cat);
	$c=$#Cat if($c<0);
	$f=1 if($f>$q);
	$f=$q if($f<1);
	$button[$c][$f]->focus;
	return;
};

sub ser_reset{
	print "Resetting...\n" if ($debug);
	my $ok;
	my $quux= $tl->focusSave();

	$reset->deiconify;
	$reset->raise;
	$reset->grab;
	do {
		&ser_dis;
		print Client "R\r\n";
		$ok=<Client>;
		$ok=~s/\r?\n//;
		if ($ok ne "A"){
			if ($ok =~ /(\d)/) {
				&ser_fatal($players[$1].", "._("Knopf loesen").".");
			}else{
				&ser_fatal("ser_reset got $ok");
			};
		};
	}while($ok ne "A");
	print "...done\n" if ($debug);
	$reset->grabRelease;
	$reset->withdraw;
#	$tl->focusForce if ($force);
	&$quux;
};

sub ser_noinp{
	&ser_fatal("");
	&ser_reset;
#	$button[0][0]->focus;
};


sub ser_fatal{
	my $fatal=(shift);

	my $quux= $tl->focusSave();
#	print "froobel: ",$quux,"\n";

	$tl->fileevent(\*Client,'readable',[\&ser_eat,\$fatal]);

	my $answer = $tl->Dialog(-title => "ser_junk",
			-textvar => \$fatal,
			-buttons => [ "try again" ],
			);
	$answer->overrideredirect(1);
	$answer->focusForce;
	$answer->Show();
	&$quux;
};

# Eat anything you get.
sub ser_eat {
	my $ref=shift;
	my $foo=scalar(<Client>);
	print "got: ",$foo;
	$foo=~s/\r?\n//;
	if($foo =~ /^\d+$/){
		$foo = $players[$foo] ." ". _("ist etwas unruhig")."\n";
	}else{
		$foo="Unexpected serial input:\n$foo\n";
	};
	${$ref}.=$foo;
};