proc about {} {
global fontname fontsize tgver
.display configure -state normal -font "$fontname $fontsize"
.display delete 1.0 end
.display insert end "Test Guru\n" center
.display insert end "by John Almirante\n" center
.display insert end "Copyright 2001\n" center
.display insert end "\nTest Guru is free educational and training software.\n" center
.display insert end "\nTest Guru was created using free software tools:\n" center
.display insert end "\nTCL/TK by John Ousterhout,\nScriptics Corporation, and the TCL/TK community\n" center
.display insert end "\nFreewrap by Dennis R. LaBelle\n" center
.display insert end "\n\nTest Guru\nversion $tgver\n" center
.display insert end "Build July 26, 2001" center
.display tag configure center -justify center
.display configure -state disabled
}

proc showtext {hint} {
global qstate score ansitem qitem item questions rnditem qans answered fontname fontsize choices answers comments correct rnditemx yours result rating ranked
.display configure -state normal
.display delete 1.0 end
.display configure -font "$fontname $fontsize" -tabs  [expr $fontsize*2+24]p
set qi $rnditem($qitem)
if [string equal $qstate review] then {
.display insert end "Score $score out of $ansitem ([if $ansitem>0 then {expr ($score*100)/$ansitem}]%)" score
}

.display insert end "\nQuestion $qitem of $item     "
.display insert end "Taken $result($qi,2) times with a success rate of [if $result($qi,2)>0 then {expr $result($qi,1)*100/$result($qi,2)} else {expr 0}]%    Value: $ranked($qi)    \#$qi\n"
set return 0
for {set a 1} {$a<=$questions($qi)} {incr a} {
set temp $questions($qi,$a)
if [regexp {^[A-Z·-]} $temp] then {set return 1}
if $a==1 then {set return 1}
if $return==1 then {.display insert end "\n"} else {.display insert end " "}
set return 0
.display insert end "$temp" john
if [regexp {[:.-]$} $temp] then {set return 1}
}
.display insert end "\n\n"

.display tag configure john -lmargin1 [expr $fontsize*3]p -spacing3 7

foreach x [string range "1 2 3 4 5 6 7 8" 0 [expr $choices($qi)*2-1]] {
if $answers($qi)<2 then {
radiobutton .display.$x -text "[string range " ABCDEFGHI" $x $x].  " -value $x -variable qans($qi) -activebackground white -background white -justify left -relief sunken -borderwidth 0 -font "$fontname $fontsize bold" -width 2 -command {
set answered($qitem) 1}
}

if $answers($qi)>1 then {
checkbutton .display.$x -text "[string range " ABCDEFGHI" $x $x].  " -variable qans($qi,$x) -activebackground white -background white -justify left -relief sunken -borderwidth 0 -font "$fontname $fontsize bold" -width 2 -command {
set answered($qitem) 1}
}

.display window create end -window .display.$x
.display insert end "\t$choices($qi,$rnditem($qitem,$x))\n" demo$x

.display tag configure demo$x -spacing3 7 -lmargin2 [expr $fontsize*2+24]p -font "$fontname $fontsize"

if [string equal $qstate review] then {
for {set a 1} {$a<=$answers($qi)} {incr a} {
if $x==$rnditemx($qitem,$answers($qi,$a)) then {
.display tag configure demo$x -font "$fontname $fontsize bold"
}
}
.display tag configure score -justify center -font "$fontname $fontsize bold"
}
if [string equal $qstate review] then {
.display.$x configure -state disabled
}
}

if [string equal $qstate review] then {
if $answered($qitem)==0 then {
.display insert end "\nNo Answer\n"
} elseif [string equal $yours($qitem) $correct($qitem)] then {
} else {
.display insert end "\nAnswer:  $yours($qitem)   "
.display insert end "Wrong\n" bold
}
}


if [expr [string equal $qstate review] || $hint==1] then {
.display insert end "\nCorrect Answer:  "
.display insert end "$correct($qitem)" bold

if $comments($qi)>0 then {

for {set a 1} {$a<=$comments($qi)} {incr a} {
set edited $comments($qi,$a)

set loop 1
while {$loop==1} {
set temp [string first "&&" $edited]
if $temp==-1 then {
set loop 0
} else {
set fnd [string range $edited $temp [expr $temp+1]]
set be [string range $edited [expr $temp+1] [expr $temp+1]]
set idx [lsearch "A B C D E F G H I J" $be]
set tmp $rnditemx($qitem,[expr $idx+1])
set repl [string range "ABCDEFGHIJ" [expr $tmp-1] [expr $tmp-1]]
set edited [string replace $edited $temp [expr $temp+1] $repl]
}
}

.display insert end "\n\n$edited"
}

}
}

.display tag configure bold -font "$fontname $fontsize bold"

.display configure -state disabled
wm minsize . 450 150
}


proc mix {a} {
global rnditem choices rnditemx rnditemy rnditemz answered answers correct qans
for {set b 1} {$b<=$choices($rnditem($a))} {incr b} {
set rnditem($a,$b) 0
set r 0
while {$r==0} { 
set r [expr int(rand()*$choices($rnditem($a))*0.999+1)]
for {set c 1} {$c<$b} {incr c} {
if {$r==$rnditem($a,$c)} then {set r 0}
}
}


set rnditem($a,$b) $r
set rnditemx($a,$r) $b
set rnditemy($rnditem($a),$b) $r
set rnditemz($rnditem($a),$r) $b
}
set answered($a) 0

set qi $rnditem($a)
if $answers($qi)>1 then {
set correct($a) " "
for {set d 1} {$d<=$choices($qi)} {incr d} {
set qans($qi,$d) 0
for {set c 1} {$c<=$answers($qi)} {incr c} {
if $d==$rnditemx($a,$answers($qi,$c)) then {
set temp [expr $rnditemx($a,$answers($qi,$c))-1]
set correct($a) [string trimleft $correct($a)[string range "ABCDEFGHIJ" $temp $temp]]
}
}
}
} else {
set qans($qi) 0
set temp [expr $rnditemx($a,$answers($qi,1))-1]
set correct($a) [string range "ABCDEFGHIJ" $temp $temp]
}
}

proc pick {} {
global allitems item rnditem rnditemx result rating ranked mixmode
set b 0
for {set a 1} {$a<=$allitems} {incr a} {
if $result($a,2)>$b then {set b $result($a,2)}
}
if $b==0 then {set b 1}
set before 0
for {set a 1} {$a<=$allitems} {incr a} {
set c $result($a,2)
if $c==0 then {set c 0.000001}
set ranked($a) [expr int(100-($c*60/$b)-($result($a,1)*40/$c)+.5)]
set rateme($a) [expr $before+$ranked($a)*$ranked($a)]
set before $rateme($a)
}
for {set a 1} {$a<=$allitems} {incr a} {
set rating($a) [expr $rateme($a)*1000/$before]
}
set rating($allitems) 1000
set rating(0) 0
set b 1
for {set a 1} {$a<=1000} {incr a} {
if $a<=$rating($b) then {set dist($a) $b} else {
incr b
set dist($a) $b
}
}
set dist(0) 1

for {set a 1} {$a<=$allitems} {incr a} {
set rankitem($a) $a
}
for {set a 1} {$a<=$item} {incr a} {

set rnditem($a) 0
set r 0

if [string equal $mixmode Random] then {
while {$r==0} { 
set r $dist([expr int(rand()*1000)])

for {set c 1} {$c<=$a-1} {incr c} {
if {$r==$rnditem($c)} then {set r 0}
}
}
} else {
for {set c [expr $a+1]} {$c<=$allitems} {incr c} {
set d $rankitem($a)
set e $rankitem($c)
set f $ranked($d)
set g $ranked($e)
set r $d
if $g>$f then {
set r $e
set rankitem($a) $e
set rankitem($c) $d
}
}

}
puts $r
set rnditem($a) $r
set rnditemx($r) $a
mix $a
}

}


proc load {} {
global filename item questions choices answers comments setitem allitems rnditem savefile result rnditemx
set item 0
set question 0
set choice 0
set comment 0
set chanid [open $filename r]

set linetype " "
set previous $linetype
set dumpline 0
set start 0
set invalid 0
while {[gets $chanid dumpline]>-1 && [string equal $dumpline END]==0} {
if [string equal $dumpline START] then {
set start 1
set dumpline ""
}
set start 1
if $start==0 then {set dumpline ""}
set dumpline [string trim $dumpline]
regsub -all {[\x091]} $dumpline "'" dumpline
regsub -all {[\x092]} $dumpline "'" dumpline
regsub -all {[\x093]} $dumpline {"} dumpline
regsub -all {[\x094]} $dumpline {"} dumpline
set header 0
set linetype $previous
set question [expr $question+1]
if [string equal $previous ANSWER] then {set linetype COMMENT}
set head [string range $dumpline 0 10]
if {[regexp -nocase  {[a-z0-9]} $head]==0} then {
set previous $linetype
set linetype BLANK
set question [expr $question-1]
set header 1
} elseif [regexp -nocase  {^[(]*ans[a-z]*[ ]*[):.=-]} $head] then {
set linetype ANSWER
set previous $linetype
set question 0
set choice 0
set comment 0
set header 1
regsub -nocase {^[(]*ans[a-z]*[ ]*[.:)=-][ ]*} $dumpline "" dumpline
regsub -nocase -all {[ ]*} $dumpline "" dumpline
regsub -nocase -all {[,.:)(-]} $dumpline "" dumpline
} elseif [regexp -nocase  {^[(]*[a-z][:.)-]} $head] then {
set linetype CHOICE
set previous $linetype
set choice [expr $choice+1]
set question 0
set comment 0
set header 1
regsub -nocase {^[(]*[a-z][.:)-][ ]*} $dumpline "" dumpline
} elseif [regexp -nocase  {^[(]*[0-9]*[:.)]} $head] then {
if $question==1 then {
if $invalid!=0 then {incr item -1}
set linetype QUESTION
set previous $linetype
incr item
set question 1
set choice 0
set comment 0
set invalid 2
set comments($item) 0
set rnditemx($item) 0
set result($item,1) 0
set result($item,2) 0
set header 1
regsub -nocase {^[(]*[0-9]*[.:)][ ]*} $dumpline "" dumpline
}
}
if [string equal $linetype ANSWER] then {
incr invalid -1
set answers($item,0) $dumpline
set answers($item) [string length $dumpline]
if $answers($item)==0 then {set invalid 1}
for {set answer 1} {$answer<=$answers($item)} {incr answer} {
set temp [expr [string first [string toupper [string index $answers($item,0) [expr $answer-1]]] "ABCDEFGHIJKLMNOP"]+1]
set answers($item,$answer) $temp
if $invalid==0 then {
if $temp>$choices($item) then {set invalid 1}
}
if $temp<1 then {set invalid 1}
}
}
if [string equal $linetype QUESTION] then {
set questions($item,$question) $dumpline
set questions($item) $question
}
if [string equal $linetype CHOICE] then {
set invalid 1
if $header==1 then {
set choices($item,$choice) $dumpline
} else {set choices($item,$choice) "$choices($item,$choice) $dumpline"}
set choices($item) $choice
}
if [string equal $linetype COMMENT] then {
set comment [expr $comment+1]
set comments($item,$comment) $dumpline
set comments($item) $comment
set question 0
set choice 0
}
#puts stdout "$item $question $part $comment $linetype $dumpline"
}
close $chanid
if $invalid!=0 then {incr item -1}
set allitems $item
set item $setitem


}

proc gethist {} {
global savefile exams getitems lastitem exam result getitems
if [file exists $savefile] then {
set chanid [open $savefile r]
gets $chanid exams
gets $chanid getitems
gets $chanid lastitem
for {set a 1} {$a<=$exams} {incr a} {
gets $chanid exam($a)
}
for {set a 1} {$a<=$getitems} {incr a} {
gets $chanid temp
set result($a,1) [lindex $temp 0]
set result($a,2) [lindex $temp 1]
}
close $chanid
}
}

proc hist {} {
global save savefile exams getitems exam result fontname fontsize
if [string equal [.side.list curselection] ""] then {} elseif [file exists $savefile] then {
gethist
.display configure -state normal
.display delete 1.0 end
.display insert end "$save  " bold
.display insert end "Tests taken: "
.display insert end "$exams  " bold
.display insert end "Number of items: "
.display insert end "$getitems\n\n" bold
for {set a 1} {$a<=[if $exams<20 then {expr $exams} else {expr 20}]} {incr a} {
set b [lindex $exam($a) 0]
set c [lindex $exam($a) 1]
.display insert end "$b/$c "
if $c>0 then {.display insert end "[expr $b*100/$c]%\t" bold}
}
.display insert end "\n\n"
for {set a 1} {$a<=$getitems} {incr a} {
.display insert end "$a)\t"
.display insert end "$result($a,1) / "
.display insert end "$result($a,2)\t"
if $result($a,2)>0 then {.display insert end "[expr $result($a,1)*100/$result($a,2)]%"}
.display insert end "\n"
}
.display tag configure bold -font "$fontname $fontsize bold"
.display configure -state disabled
} else {
.display configure -state normal
.display delete 1.0 end
.display insert end "$save\n"
.display insert end "No exam history"
.display configure -state disabled
}
}

proc filehist {} {
global dir
.side.dir configure -text $dir
.side.list delete 0 end
foreach i [exec command /c dir /b [string trim $dir]*.tgu] {
.side.list insert end $i
}
}

proc drawbar {} {
global qstate setitem fontname fontsize dir filename qitem geom score item rnditem answered correct ansitem yours answers qans choices savefile exams exam result getitems mixmode tgver
switch $qstate {
choose {
set fontsize 10
wm title . "Test Guru $tgver"
destroy .bar
frame .bar
button .bar.history -text "History" -width 10 -command {
set file [selection get -displayof .side.list]
regsub -nocase {[.][a-z0-9]*$} $file "" save
set savefile [file join $dir $save].tgs
hist
}
set bitem [tk_optionMenu .bar.item setitem 40 35 30 25 20 15 12 10 8 6 5]
for {set a 0} {$a<=[$bitem index last]} {incr a} {
$bitem entryconfigure $a -command {
}
}
.bar.item configure -direction above
set bmix [tk_optionMenu .bar.mix mixmode  Ranked Random]
for {set a 0} {$a<=[$bmix index last]} {incr a} {
$bmix entryconfigure $a -command {
}
}
button .bar.load -text "Load" -width 10 -command {
if [string equal [.side.list curselection] ""] then {} else {
set geome [wm geometry .]
set file [selection get -displayof .side.list]
set filename [file join $dir $file]
regsub -nocase {[.][a-z0-9]*$} $file "" save
set savefile [file join $dir $save].tgs

button .bar.prev
button .bar.next
button .bar.middle
button .bar.end

set chfont [tk_optionMenu .bar.font fontsize 12 10 8]
for {set y 0} {$y<=[$chfont index last]} {incr y} {
$chfont entryconfigure $y -command {
set geom [wm geometry .]
if [string equal $qstate review] then {showtext 0} else {
.display tag configure john -lmargin1 [expr $fontsize*3]p -spacing3 7
.display configure -font "$fontname $fontsize" -tabs  [expr $fontsize*2+24]p
for {set x 1} {$x<=$choices($rnditem($qitem))} {incr x} {
.display.$x configure -font "$fontname $fontsize bold"
.display tag configure demo$x -spacing3 7 -lmargin2 [expr $fontsize*2+24]p -font "$fontname $fontsize"
}
}
if [expr [string equal [wm state .] zoomed]==0] then {wm geometry . $geom}
}
}

load
gethist
if $item>$allitems then {set item $allitems}
if $exams==0 then {set mixmode Random}
pick
set qstate quiz
drawbar

pack .bar.prev -expand 1 -side left
pack .bar.middle -expand 1 -side left
pack .bar.next -expand 1 -side left
pack .bar.font -expand 1 -side left
pack .bar.end -expand 1 -side left
wm title . "Test Guru $tgver - $save"
if [expr [string equal [wm state .] zoomed]==0] then {wm geometry . $geome}
}
}
pack .side -side right -fill y

pack .bar.history -expand 1 -side left
pack .bar.item -expand 1 -side left
pack .bar.mix -expand 1 -side left
pack .bar.load -expand 1 -side left
pack .bar -fill x -pady 1m -side bottom

filehist

}
quiz {
pack forget .side
destroy .bar.history
destroy .bar.item
destroy .bar.mix
destroy .bar.load
.bar.prev configure -text "<< Previous" -width 10 -command {
set temp [expr $qitem-1]
if $temp<1 then {} else {
set qitem $temp
showtext 0
}
}
.bar.next configure -text "Next >>" -width 10 -command {
set temp [expr $qitem+1]
if $temp>$item then {} else {
set qitem $temp
showtext 0
}
}
.bar.middle configure -text "Show Answer" -width 10 -command {showtext 1}
.bar.end configure -text "End Test" -width 10 -command {
set qstate review
drawbar
}

set qitem 1
showtext 0
}
review {
set score 0
set ansitem $item
for {set a 1} {$a<=$item} {incr a} {
set yours($a) " "
set qi $rnditem($a)
if $answered($a)==1 then {
if $answers($qi)>1 then {
for {set b 1} {$b<=$choices($qi)} {incr b} {
if $qans($qi,$b)==1 then {
set temp [expr $b-1]
set yours($a) [string trimleft $yours($a)[string range "ABCDEFGHIJ" $temp $temp]]
}
}
} else {
set temp [expr $qans($qi)-1]
set yours($a) [string trimleft $yours($a)[string range "ABCDEFGHIJ" $temp $temp]]
}
incr result($rnditem($a),2)
} else {
incr ansitem -1
}
if [string equal $yours($a) $correct($a)] then {
incr score
incr result($rnditem($a),1)
}

}

set qitem 1
.bar.middle configure -text Retake -command {
set qitem 1
for {set a 1} {$a<=$item} {incr a} {
mix $a
}
set qstate quiz
drawbar
}
.bar.end configure -text Exit -command {
if $ansitem==0 then {
set qstate choose
pack forget .display
pack forget .scroll
drawbar
pack .scroll -side right -fill y
pack .display -side top -expand y -fill both
about
} else {
.display configure -state normal
.display delete 1.0 end
.display insert end "Exam $save   Total Items: $allitems\nYou scored $score out of $ansitem for [expr $score*100/$ansitem]%.\n"
.display insert end "You have taken this exam $exams times before.\n\n"
for {set a 1} {$a<=$item} {incr a} {
set qi $rnditem($a)
set b $result($qi,1)
set c $result($qi,2)
.display insert end "$qi)\t$b / $c\t[expr $b*100/[if $c>0 then {expr $c} else {expr 1}]]%\n"
}
.display configure -state disabled
destroy .bar.prev
destroy .bar.next
destroy .bar.middle
destroy .bar.font
destroy .bar.end
button .bar.quit -text "Exit Now" -width 15 -command {
set qstate choose
pack forget .display
pack forget .scroll
drawbar
pack .scroll -side right -fill y
pack .display -side top -expand y -fill both
about
}
button .bar.save -text "Save and Exit" -width 15 -command {
set chanid [open $savefile w]
puts $chanid [expr $exams+1]
puts $chanid $allitems
puts $chanid $item
puts $chanid "$score $ansitem"
for {set a 1} {$a<=$exams} {incr a} {
puts $chanid $exam($a)
}
for {set a 1} {$a<=$allitems} {incr a} {
puts $chanid "$result($a,1) $result($a,2)"
}
close $chanid
set qstate choose
pack forget .display
pack forget .scroll
drawbar
pack .scroll -side right -fill y
pack .display -side top -expand y -fill both
about
}
pack .bar.quit -expand 1 -side left
pack .bar.save -expand 1 -side left
}
}
showtext 1
}
}
}

wm minsize . 450 150
set tgver 0.3
set dir .\\
set fontname "Helv"
set setitem 6
set qstate choose
set exams 0
frame .side
label .side.dir -text $dir
button .side.cd -text Refresh -width 10 -command {
filehist
}
pack .side.cd -side bottom -pady 1m
pack .side.dir -side top
scrollbar .side.scroll -command ".side.list yview"
pack .side.scroll -side right -fill y
listbox .side.list -yscroll ".side.scroll set" -relief sunken -width 20 -height 20 -background lightyellow
pack .side.list -side left -fill both -expand yes

drawbar

text .display -wrap word -height 20 -width 50 -padx 20 -pady 20 -takefocus 0 -cursor arrow -yscrollcommand ".scroll set" -font "$fontname $fontsize" -tabs  [expr $fontsize*2+24]p
about
scrollbar .scroll -command ".display yview"
pack .scroll -side right -fill y
pack .display -side top -expand y -fill both