Index: openacs-4/packages/assessment/tcl/as-item-type-mc-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/assessment/tcl/as-item-type-mc-procs.tcl,v
diff -u -r1.6 -r1.7
--- openacs-4/packages/assessment/tcl/as-item-type-mc-procs.tcl	10 Dec 2004 20:21:50 -0000	1.6
+++ openacs-4/packages/assessment/tcl/as-item-type-mc-procs.tcl	11 Dec 2004 11:23:00 -0000	1.7
@@ -144,17 +144,9 @@
     set display_choices [list]
     set correct_choices [list]
     set wrong_choices [list]
-    set choices [db_list_of_lists get_choices {}]
-    set choices [db_list_of_lists foobar {
-	    select c.choice_id, r.title, c.correct_answer_p, c.selected_p
-	    from as_item_choices c, cr_revisions r
-	    where c.mc_id = :type_id
-	    and r.revision_id = c.choice_id
-	    order by c.sort_order
-    }]
-
-    foreach one_choice $choices {
-	util_unlist $one_choice choice_id title correct_answer_p selected_p
+    set total 0
+    db_foreach choices {} {
+	incr total
 	lappend display_choices [list $title $choice_id]
 	if {$selected_p == "t"} {
 	    lappend defaults $choice_id
@@ -166,7 +158,7 @@
 	}
     }
     
-    if {![empty_string_p $num_answers] && $num_answers < [llength $choices]} {
+    if {![empty_string_p $num_answers] && $num_answers < $total} {
 	# display fewer choices, select random
 	set correct_choices [util::randomize_list $correct_choices]
 	set wrong_choices [util::randomize_list $wrong_choices]
@@ -186,3 +178,78 @@
     
     return [list $defaults $display_choices]
 }
+
+ad_proc -public as::item_type_sa::process {
+    -type_id:required
+    -session_id:required
+    -as_item_id:required
+    -subject_id:required
+    {-staff_id ""}
+    {-response ""}
+    {-max_points 0}
+} {
+    @author Timo Hentschel (timo@timohentschel.de)
+    @creation-date 2004-12-11
+
+    Process a Response to a Multiple Choice Type
+} {
+    db_1row item_type_data {}
+
+    db_foreach check_choices {} {
+	if {$correct_answer_p == "t"} {
+	    set correct_choices($choice_id) $percent_score
+	} else {
+	    set wrong_choices($choice_id) $percent_score
+	}
+    }
+
+    if {$increasing_p == "t"} {
+	# if not all correct answers are given, award fraction of the points
+	set percent 0
+	if {[array exists correct_choices]} {
+	    set wrong_p 0
+	    foreach choice_id $response {
+		if {[exists_and_not_null correct_choices($choice_id)]} {
+		    incr percent $correct_choices($choice_id)
+		}
+		if {![info exists correct_choices($choice_id)] && $allow_negative_p != "t"} {
+		    set wrong_p 1
+		}
+	    }
+	    if {$wrong_p} {
+		# reset points to 0 if wrong answers given and no negative allowed
+		set percent 0
+	    }
+	    if {$allow_negative_p == "t" && [array exists wrong_choices]} {
+		foreach choice_id $response {
+		    if {[exists_and_not_null wrong_choices($choice_id)]} {
+			incr percent $wrong_choices($choice_id)
+		    }
+		}
+	    }
+	}
+    } else {
+	# award 100% points if all correct answers are given
+	if {[array exists correct_choices] && [lsort -integer $response] == [lsort -integer [array names correct_choices]]} {
+	    set percent 100
+	} else {
+	    if {$allow_negative_p == "t"} {
+		# wrong answers, calculate points by adding percentages for wrong answers
+		set percent 0
+		if {[array exists wrong_choices]} {
+		    foreach choice_id $response {
+			if {[exists_and_not_null wrong_choices($choice_id)]} {
+			    incr percent $wrong_choices($choice_id)
+			}
+		    }
+		}
+	    } else {
+		# wrong answers, no negative points allowed => 0 points
+		set percent 0
+	    }
+	}
+    }
+
+    set points [expr round($max_points * percent / 100)]
+    as::item_data::new -session_id $session_id -subject_id $subject_id -staff_id $staff_id -as_item_id $as_item_id -choice_answer $response -points $points
+}