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