#!/usr/local/bin/perl
#
# Copyright (C) 1992 by Gustaf Neumann, Stefan Nusser
#
#      Wirtschaftsuniversitaet Wien,
#      Abteilung fuer Wirtschaftsinformatik
#      Augasse 2-6,
#      A-1090 Vienna, Austria
#      neumann@wu-wien.ac.at, nusser@wu-wien.ac.at
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appears in all copies and that both that
# copyright notice and this permission notice appear in all supporting
# documentation.  This software is provided "as is" without expressed or
# implied warranty.
#
# Date: Mon, Apr 13 1992
# Author: Gustaf Neumann
# Version: 0.9
#

%privOptions = (  
		"f", "filename:name of the multiple choice test",
		"l", "language:language to use (english or german)",
		);

$WafeLib = $ENV{'WAFELIB'} || "/usr/lib/X11/wafe";
require "$WafeLib/perl/wafe.pl";

$opt_l = $opt_l || "german";
$mcFile = $opt_f || "test.mini.$opt_l";

@noetig = ( 48, 42, 36, 30, 0 );

%Bitmap = (
    "r", "bitmap $WafeLib/bitmaps/richtig.xbm",
    "f", "bitmap $WafeLib/bitmaps/falsch.xbm",
    "","bitmap None",
);

$cRight = "background limegreen",
    $cWrong  = "background pink" 
    unless $opt_c eq "mono";

%AntwortAttribut = (
     "richtig", "$Bitmap{'r'} $cRight",
     "unbeantwortet", "$Bitmap{''} background white",
     "falsch", "$Bitmap{'f'} $cWrong",
);

$cRight = "background green",
    $cWrong  = "background red" 
    unless $opt_c eq "mono";

@LoesungsAttribut = (
	"$cRight $Bitmap{''}",
	"$cWrong $Bitmap{''}",
);

$auswertung = "Auswertung",
    $report = "%s: Dauer: %s min, max erreichbare Punkte: %s, erreicht: %4.2f",
    $evaluation = "%4.2f von maximal %d Punkten erreicht, Note: %d",
    $qlabel = "%d: Dauer: %d min, erreichbare Punkte: %d",
    $tosolve = "%d Teilfragen von %d sind noch zu lsen",
    $sofar = "In %.2f Minuten haben Sie Fragen fr %.2f Minuten beantwortet"
    if $opt_l eq "german";
$auswertung = "Evaluation",
    $report = "%s: Duration: %s min, max points for this question: %s, achieved: %4.2f",
    $evaluation = "%4.2f of  %d points achieved, Grade: %d (best 1, worst 5)",
    $qlabel = "%d: Time: %d min, max points for this question: %d",
    $tosolve = "%d questions of %d still to solve",
    $sofar = "In %.2f minutes you have answered questions for %.2f minutes"
    if $opt_l eq "english";

($ExpectHeader,$ExpectInfo,$ExpectText,$Alternative)=(1,0,0,"");
open(MC, "<$mcFile") || 
	open(MC,"<$WafeLib/$mcFile") || 
	open(MC,"<$WafeLib/test.$mcFile") || 
	die "cannot open $mc for reading";
while(<MC>) {
    ($ExpectHeader,$ExpectInfo,$ExpectText,$Alternative)=(0,0,1,"") ,next if /^\.f.*/;
    ($ExpectHeader,$ExpectInfo,$ExpectText,$Alternative)=(1,0,0,""), next if /^\f.*/;  
    ($ExpectHeader,$ExpectInfo,$ExpectText,$Alternative)=(0,1,0,""), next if /\.i.*/;

    if (/^\.(\S)\((\S)\).*/) {
	$Alternative=$1;
	$Loesung{$lnr,$Alternative}=$2;
	($ExpectHeader,$ExpectInfo,$ExpectText)=(0,0,0);
	$Richtige[$lnr] ++ if $2 eq "r";
	$zuLoesen++;
	next;
    }

    if ($ExpectHeader) {
	$lnr = $1 if /^\s*LAUFNUMMER:\s+(\d+)/;
	($frageNummer[$lnr],$buch[$lnr],$autor[$lnr]) = ($1,$2,$3) 
	    if /^\s*FRAGENUMMER:\s+(\d+)\s+BUCH:\s+(\S+)\s+AUTOR:\s+(\S+).*/;
	($dauer[$lnr],$punkte[$lnr]) = ($1,$2) 
	    if /^\s*DAUER:\s+(\d+\.\d+)\s+\S+\s+PUNKTE:\s+(\d+\.\d+).*/;
    } 

    $info[$lnr] .= $_  if $ExpectInfo;
    $intro[$lnr] .= $_  if $ExpectText;
    $text{$lnr,$Alternative} .= $_ if $Alternative;
}
close(MC);



$bot = "bottom chainBottom top chainBottom";
&UI( <<"End of TCL");
    form top topLevel $backGround
       label header top $backGround $normalFont width 650 borderWidth 0 \\
	    label {} top chainTop bottom chainTop
       viewport vp top allowVert true forceBars true height 550 width 666 \\
                  top chainTop bottom chainBottom fromVert header
          form f vp
          action f override "<Key>Down: exec(sL +)";
          action f override "<Key>Up: exec(sL -)";
          action f override "<Key>Prior: exec(sP -)";
          action f override "<Key>Next: exec(sP +)";
          action f override "Meta<Key>Prior: exec(sA 0.0)";
          action f override "Meta<Key>Next: exec(sA 1.0)";

       command quit top $buttonAtts fromVert vp $bot
       callback quit callback exec quit
       command auswertung top label {$auswertung} $buttonAtts sensitive false $bot \\
             fromVert vp fromHoriz quit 
       callback auswertung callback exec "echo auswertung"
       label info top label {} $backGround $bot $normalFont width 550 borderWidth 0 \\
            fromVert vp fromHoriz auswertung

proc setKeys {w l a} { \\
      action \$w override "<Btn1Up>: \\
        exec(echo toggle \$l \$a 1; sV c\$l\$a $AntwortAttribut{'richtig'})"; \\
      action \$w override "<Btn3Up>: \\
           exec(echo toggle \$l \$a 3;sV c\$l\$a $AntwortAttribut{'falsch'})"; \\
      action \$w override "<Btn2Up>: \\
           exec(echo toggle \$l \$a 2;sV c\$l\$a $AntwortAttribut{'unbeantwortet'})"; \\
      action \$w override "<Key>r: \\
        exec(echo toggle \$l \$a 1; sV c\$l\$a $AntwortAttribut{'richtig'})"; \\
      action \$w override "<Key>f: \\
        exec(echo toggle \$l \$a 3;sV c\$l\$a $AntwortAttribut{'falsch'})"; \\
      action \$w override "<Key>question: \\
           exec(echo toggle \$l \$a 2;sV c\$l\$a $AntwortAttribut{'unbeantwortet'})"; \\
       sV \$w cursor spider;\\
       action \$w override "<Key>Down: exec(sL +)"; \\
       action \$w override "<Key>Up: exec(sL -)"; \\
       action \$w override "<Key>Prior: exec(sP -)"; \\
       action \$w override "<Key>Next: exec(sP +)"; \\
       action \$w override "Meta<Key>Prior: exec(sA 0.0)"; \\
       action \$w override "Meta<Key>Next: exec(sA 1.0)"; \\
}

proc setToggle {l a} { \\
      setKeys c\$l\$a \$l \$a; \\
      setKeys a\$l\$a \$l \$a; \\
}

proc sL {pm} { \\
     set rel [expr 0\$pm{17.0}/[gV f height int]]; \\
          set pos [expr [gV vertical topOfThumb float]+\$rel]; \\
     scrollbarSetThumb vertical \$pos -1.0; \\
     callCallbacks vertical jumpProc float \$pos; \\
}

proc sP {pm} { \\
     set rel [expr 0\$pm\{17.0}/[gV f height int]]; \\
     set lines [expr [gV vp height int]/17.0]; \\
     set pos [expr [gV vertical topOfThumb float]+\$rel*0.5*\$lines]; \\
    echo setting scrollbar to \$pos;\\
     scrollbarSetThumb vertical \$pos -1.0; \\
     callCallbacks vertical jumpProc float \$pos; \\
     }

proc sA {pos} { \\
    echo setting scrollbar to \$pos absolute;\\
     scrollbarSetThumb vertical \$pos -1.0; \\
     callCallbacks vertical jumpProc float \$pos; \\
     }

End of TCL

sub rund { int($_[0]+0.5); }
#
# auswertung der eingebenen alternativen
#
sub auswertung {
    local($gesamt,$ppf,$p,$max);
 
    for $l (1 .. $#punkte) {
	$pkt{'r'} = 1/$Richtige[$l];
	$pkt{'f'} = $Richtige[$l] < 5 ? 1/(5-$Richtige[$l]) : 0;
#	print "richtige = $Richtige[$l], pkt = $pkt{'r'}, $pkt{'f'}\n";
        $ppf = 0;

	foreach $alt ("a","b","c","d","e") {

	    $p = ($Antwort{$l,$alt} eq "r") ? 
		       ($Loesung{$l,$alt} eq 'r' ? $pkt{'r'} : -$pkt{'f'}) :
		       0;
            &Xui("sV cl$l$alt background white label {}") if $p == 0;
	    &Xui("sV cl$l$alt label {".(sprintf("%.2f",$p*$punkte[$l])."} "
	             .($LoesungsAttribut[$Antwort{$l,$alt} ne $Loesung{$l,$alt}])))
	             if $p != 0;
	    $ppf += $p;
	}
	$ppf = 0 if $ppf < 0;

	&Xui("sV T$l label {".sprintf($report,$l,$dauer[$l],$punkte[$l],$ppf*$punkte[$l])."}");
        $gesamt += $ppf*$punkte[$l];
        $max += $punkte[$l];
    }

    $gesamtr = &rund($gesamt);
    $auf60 = 60/$max;
    for ($[ .. $#noetig) {
	$n = $_+1, last  if &rund($gesamt*$auf60) >= $noetig[$_] ;
    }
    &info(sprintf($evaluation, $gesamt,$max,$n));
}



sub nLabel {
    local($text,$w,$atts) = @_;
    $text =~ s/(\[|\")/\\$1/g;
    $text =~ s/\n/\\n/g;
    $vert = $prev == -1 ?  "" : "fromVert $prev"; 
    $w = $w || "l$current";
    $prev = $w;
    $current ++;
    &Xui("label $w f label \"$text\" $vert justify left borderWidth 0 width 500 $atts");
}

$current = 0;
$prev= -1;
for $l (1 .. $#punkte) {
    &nLabel(sprintf($qlabel,$l,$dauer[$l],$punkte[$l]),"T$l",
	    "$boldFont vertDistance 15");
    &nLabel("$intro[$l]","","$textFont horizDistance 20");
    foreach $alt ("a","b","c","d","e") {
	&Xui("label cl$l$alt f  fromVert $prev horizDistance 10 label {} width 35 borderWidth 0");
	&Xui("label c$l$alt f label {?} fromVert $prev horizDistance 55");
	&nLabel("$text{$l,$alt}","a$l$alt","$textFont horizDistance 75");
	&Xui("setToggle $l $alt");
    }
}
&Xui("realize");

$startTime = "";
while (1) {
   $_ = &wafe'readTimeout(10);

    if (/^toggle\s+(\S+)\s+(\S+)\s+(\d+).*/) {
	local($nr,$alt,$key) = ($1,$2,$3);
        $startTime = time if ! $startTime;

        $before = $Antwort{$nr,$alt};
        $Antwort{$nr,$alt} = "r" if $key == 1;
        $Antwort{$nr,$alt} = ""  if $key == 2;
        $Antwort{$nr,$alt} = "f" if $key == 3;
        $now = $Antwort{$nr,$alt};
#	    print "antwort $nr $alt = <$Antwort{$nr,$alt}>\n";

	$zuLoesen--,$timeBudget += $dauer[$nr]/5 if $before eq "" && $now ne "";
	$zuLoesen++,$timeBudget -= $dauer[$nr]/5 if $before ne "" && $now eq "";

	&info(sprintf($tosolve,$zuLoesen,($#punkte*5)));
   }

    if (/^auswertung/) {
	&auswertung();
    }

   &Xui("sV header label {".sprintf($sofar,(time - $startTime)/60,$timeBudget)."}")
         if $startTime;

    &wafe'sensitive($zuLoesen eq 0, "auswertung");
#    print;
}


