#!/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.96
#

%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 richtig.xbm",
    "f", "bitmap 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 lösen",
    $sofar = "In %.2f Minuten haben Sie Fragen für %.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";
&Xui(<<"End of TCL");

 mergeResources topLevel *Label*borderWidth 0

 Form top topLevel $backGround
   Label header top {
       $backGround $normalFont width 650
       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 translations {#override
	<Key>Down:  exec(sL +)
        <Key>Up:    exec(sL -)
        <Key>Prior: exec(sP -)
        <Key>Next:  exec(sP +)
        Meta<Key>Prior: exec(sA 0.0)
        Meta<Key>Next:  exec(sA 1.0)
      }

 Command quit top $buttonAtts fromVert vp $bot callback quit
 Command auswertung top {
     label {$auswertung} $buttonAtts $bot 
     sensitive false fromVert vp fromHoriz quit
     callback {echo auswertung}
 }
 Label info top {
    label {} $backGround $bot $normalFont width 550 
    fromVert vp fromHoriz auswertung
 }

 proc doToggle {l a nr args} {
    echo Toggle \$l \$a \$nr
    eval sV c\$l\$a \$args
 }

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

 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]]
    set pos [expr [gV vertical topOfThumb]+\$rel]
    XawScrollbarSetThumb vertical \$pos -1.0
    callCallbacks vertical jumpProc float \$pos
 }

 proc sP {pm} {
    set rel [expr 0\$pm\{17.0}/[gV f height]]
    set lines [expr [gV vp height]/17.0]
    set pos [expr [gV vertical topOfThumb]+\$rel*0.5*\$lines]
    XawScrollbarSetThumb vertical \$pos -1.0
    callCallbacks vertical jumpProc float \$pos
 }

 proc sA {pos} {
    XawScrollbarSetThumb 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 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 25");
    foreach $alt ("a","b","c","d","e") {
	&Xui(<<"__");
	Label cl$l$alt f fromVert $prev horizDistance 10 label {} width 35
	Label c$l$alt f label ? fromVert $prev horizDistance 55 borderWidth 1
__
	&nLabel("$text{$l,$alt}","a$l$alt","$textFont horizDistance 75");
	&Xui("setToggle $l $alt");
    }
}
&Xui("realize;deleteWindowProtocol quit");

$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 "$_\n";
}


