#!/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.4 2000/12/28 16:17:46 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 %opt;
getopts('doftsg:h', \%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)
-g  geometry. Select window size.
    0: fullscreen (default)
EOF
    my $x=1;
    foreach (sort {$a <=> $b } keys %screen){
        printf "\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});

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";
    }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 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=<>;
    };
    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);
};

my @colors=qw(grey darkred darkgreen darkblue);

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');
print "Question-Font:\n$qfont\n" if ($debug);

my $tfont=$tl->X11Font('-*-helvetica-medium-r-*--30-*-*-*-*-*-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  ]);
    };
};
$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";

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');

    my $question = $tl->Label(
            -text   => $jdata{$Cat[$c]}[$f],
            -font   => $qfont,
    )->pack(
            -fill   =>'both',
            -expand =>1
    );

    $tl->focusForce if ($force);

    &ser_en($tl,$c,$f) if ($tty);
    $tl->bind('<Key>',[\&answerQuest,$c,$f,Ev('A')]);
};

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});

    $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;
        $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";
    $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,
    );
#   $button[$c][$f]->GeometryRequest(40,$oheight/2);
    print "Pts:\n",map {sprintf "%s:%d/",$players[$_],$points[$_]} (1..$#points);
    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;
    $reset->deiconify;
    $reset->raise;
    $reset->grab;
    do {
        &ser_dis;
        print Client "R\r\n";
        $ok=<Client>;
        if ($ok ne "A\r\n"){
            if ($ok =~ /(\d)\r\n/) {
                &ser_fatal($players[$1].", bitte Knopf loesen.");
            }else{
                &ser_fatal("ser_reset got $ok");
            };
        };
    }while($ok ne "A\r\n");
    print "...done\n" if ($debug);
    $reset->grabRelease;
    $reset->withdraw;
    $tl->focusForce;
};

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


sub ser_fatal{
    my $fatal=(shift)."\n";

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

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

# Eat anything you get.
sub ser_eat {
    my $ref=shift;
    my $foo=scalar(<Client>);
    print "got: ",$foo;
    chomp($foo);
    ${$ref}.=$foo;
};