1#!../../src/xotclsh 2# $Id: MC.xotcl,v 1.1 2004/05/23 22:50:39 neumann Exp $ 3# 4# A simple multiple choice test application 5# 6array set opts {-pkgdir .}; array set opts $argv 7lappend auto_path $opts(-pkgdir) 8 9package require XOTcl 1; namespace import -force xotcl::* 10#package require xotcl::package; package verbose 1 11package require xotcl::actiweb::htmlPlace 12package require xotcl::actiweb::pageTemplate 13 14HtmlPlace ::receiver -port 8092 -allowExit exit 15 16# Define a pool of questions: Question and their alternatives 17# are defined as classes and all questions are stored in the pool 18# 19Class Pool 20Class Pool::Question -parameter {text {altcounter 1}} 21Class Pool::Question::Alternative -parameter {text correct} 22 23Pool::Question instproc alternatives {pairs} { 24 my instvar altcounter 25 foreach {alt correct} $pairs { 26 incr altcounter 27 [self class]::Alternative [self]::$altcounter \ 28 -text $alt -correct $correct 29 } 30} 31 32 33# 34# An Exam has a name and is a selection of questions from a pool. 35# "requiredCorrect" defines the minimal number of correct answers 36# to pass the test. 37 38Class Exam -parameter {name requiredCorrect pool questions} 39 40 41# 42# For every candidate we create an individual exam. We scramble 43# the questions and alternatives and use the studentID as a seed. 44# 45 46Class IndividualExam -superclass Agent -parameter {ID exam} 47 48IndividualExam instproc random modulo { ;### random number generator 49 my instvar seed 50 set seed [expr {($seed*12731+34197) % 21473}] 51 return [expr {$seed % $modulo}] 52} 53IndividualExam instproc permute {list} { ;### permute random permutation 54 set permuted {} 55 for {set nr [llength $list]} {$nr>0} {incr nr -1} { 56 set select [my random $nr] 57 lappend permuted [lindex $list $select] 58 set list [lreplace $list $select $select] 59 } 60 return $permuted 61} 62IndividualExam instproc init args { 63 my instvar seed ID exam individualTest alternatives 64 set questions [$exam set questions] 65 set seed $ID 66 ### compute order of individual tests and alternatives 67 foreach index [my permute [$exam set questions]] { 68 set questionObj [$exam set pool]::$index 69 lappend individualTest $index 70 set alts [my permute [lsort [$questionObj info children]]] 71 lappend alternatives $alts 72 } 73 #puts stderr "Individual test [self] has $individualTest" 74} 75 76# 77# Define a web facade using a page template 78# "testObject" is the individual test that is shielded by the web facade 79# 80Class WebExam -superclass WebObject \ 81 -instmixin PageTemplateHtml -parameter {testObject} 82WebExam instproc default {} { ;### This method creates the HTML Test 83 my instvar testObject ;### import var that stores shielded test object 84 ### import vars from the test 85 $testObject instvar individualTest alternatives exam 86 set action [my selfAction result] 87 ### create Test page 88 set htmlText "<FORM action='$action' METHOD='POST'>\n<OL>\n" 89 ### iterate over the set of questions/alternatives 90 ### and add them to the HTML text 91 foreach question $individualTest alts $alternatives { 92 append htmlText "<LI> [[$exam pool]::$question text]\n<UL>\n" 93 foreach a $alts { 94 append htmlText "<LI> <INPUT TYPE='checkbox' NAME='$a' VALUE='$a'> \ 95 [$a text] ([$a correct])\n" 96 } 97 append htmlText "</UL><p>\n" 98 } 99 ### we have to add a hidden form field, otherwise we get no result, 100 ### if nothing is tagged 101 append htmlText "<INPUT TYPE='hidden' NAME='__h' VALUE='__h'>" 102 ### the submit button lets us send the result back 103 append htmlText "</OL><INPUT TYPE='submit' VALUE='Submit'></FORM>\n" 104 ### create simple HTML Page 105 my simplePage [$exam name] \ 106 "Exam [$exam name] for [string trimleft $testObject :] \ 107 (Exam: $exam)" $htmlText 108} 109WebExam instproc result {} { ;# This method analyses the results of the test 110 my instvar testObject ;### import var that stores shielded test 111 set exam [$testObject exam] 112 $testObject instvar individualTest alternatives 113 foreach question $individualTest alts $alternatives { 114 foreach a $alts {set ca($a) 0} 115 } 116 foreach a [my getFormData] {set ca([$a set content]) 1} 117 set htmlText "You have answered:<UL>" 118 array set answerText {0 " -- answered no\n" 1 " -- answered yes\n"} 119 array set correctText {0 "\n -- Wrong.<br>\n" 1 "\n -- Correct.<br>\n"} 120 set correctAnswers 0 121 foreach q $individualTest { 122 set correct 1 123 append htmlText "<LI> <em>[[$exam pool]::$q text]</em>: <br>\n" 124 foreach alternative [[$exam pool]::$q info children] { 125 set altCorrect [expr {$ca($alternative) == [$alternative correct]}] 126 append htmlText [$alternative text]\n \ 127 $answerText($ca($alternative)) \ 128 $correctText($altCorrect) 129 set correct [expr {$correct && $altCorrect}] 130 } 131 if {$correct} {incr correctAnswers} 132 } 133 append htmlText </UL>\n 134 if {$correctAnswers < [$exam requiredCorrect]} { 135 my simplePage [self] "Sorry" "$htmlText\ 136 Only $correctAnswers question were answered correctly. You have not succeeded :(" 137 } else { 138 my simplePage [self] "Congratulations" "$htmlText\ 139 $correctAnswers questions were answered correctly. You have succeeded :-)" 140 } 141} 142WebExam instproc init args { 143 next 144 [my place] exportObjs [self] ;# export object 145 my exportProcs result ;# export methods 146} 147 148 149 150 151 152# Create a Pool P with 6 example questions with 3 alternatives for each. 153 154Pool p 155Pool::Question p::1 \ 156 -text "When was the first XOTcl Version released?" -alternatives { 157 "1998" 0 158 "1999" 1 159 "2000" 0 160 } 161Pool::Question p::2 -text "Who is author of XOTcl?" -alternatives { 162 "Gustaf Neumann" 1 163 "Mika Haekinnen" 0 164 "Uwe Zdun" 1 165} 166Pool::Question p::3 -text "Which of the systems are other OO extensions of Tcl?" \ 167 -alternatives { 168 "XTCL" 0 169 "ITCL" 1 170 "OTCL" 1 171 } 172Pool::Question p::4 \ 173 -text "Which methods are provided by the Object class?" -alternatives { 174 "set" 1 175 "instvar" 0 176 "filter" 1 177 } 178Pool::Question p::5 \ 179 -text "Which methods are provided by the Object class?" -alternatives { 180 "unset" 1 181 "instproc" 0 182 "mixin" 1 183 } 184Pool::Question p::6 \ 185 -text "Which methods are provided by the Class class?" -alternatives { 186 "proc" 0 187 "instproc" 1 188 "mixin" 0 189 } 190 191### Define an exam 192 193Exam xotclTest \ 194 -pool p \ 195 -name "XOTcl Test" \ 196 -questions {1 2 3 4 5} \ 197 -requiredCorrect 4 198 199 200### Define two Student tests with the XOTcl Test 201 202foreach {Student ID} { 203 Uwe 7850247 204 Gustaf 7850248 205} { 206 ## Define the individual exams 207 IndividualExam $Student -exam xotclTest -ID $ID 208 ### Define a web facade for each student 209 WebExam $Student.html -testObject $Student 210 211} 212receiver startEventLoop 213