Index: openacs-4/packages/xowiki/tcl/form-field-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/form-field-procs.tcl,v diff -u -r1.284.2.49 -r1.284.2.50 --- openacs-4/packages/xowiki/tcl/form-field-procs.tcl 11 Nov 2019 12:49:45 -0000 1.284.2.49 +++ openacs-4/packages/xowiki/tcl/form-field-procs.tcl 12 Nov 2019 11:11:31 -0000 1.284.2.50 @@ -675,6 +675,17 @@ } FormField instproc answer_is_correct {} { + # + # Return correctness of the answer based on the instance variables + # ":correct_when" and ":answer". Possible results are + # + # - 1: correct + # - -1: incorrect + # - 0: can't say (or report back, that no evaluation should be + # provided for this field) + # + # This method is free from side-effects (no instance variables are updated). + # #:log "CORRECT? ${:name} ([:info class]): value=[:value], answer=[expr {[info exists :answer]?${:answer}:{NONE}}]" if {[info exists :correct_when]} { set op [lindex ${:correct_when} 0] @@ -703,16 +714,28 @@ } FormField instproc set_feedback {feedback_mode} { + # + # Set instance variables based on correctness of an answer. + # + # - :form_widget_CSSclass + # - :evaluated_answer_result + # - :value (highlights potentially partial results, e.g. "contains") + # - :help_text + # set correct [:answer_is_correct] #:log "${:name} [:info class]: correct? $correct" switch -- $correct { - 0 { return } + 0 { set result "unknown" } -1 { set result "incorrect"} 1 { set result "correct" } } :form_widget_CSSclass $result set :evaluated_answer_result $result + if {$correct == 0} { + return ${:evaluated_answer_result} + } + set feedback "" if {[info exists :feedback_answer_$result]} { set feedback [set :feedback_answer_$result] @@ -747,8 +770,73 @@ } #:log "==== ${:name} setting feedback $feedback" set :help_text $feedback + return ${:evaluated_answer_result} } + + FormField instproc make_correct {} { + # + # Set the form_field to a correct value, currently based on + # :correct_when. We could use here :answer when available. + # Modified instance variables + # + # - :help_text is cleared to avoid stray per-user-feedback, + # We could as well provide teacher-level feedback here. + # - :form_widget_CSSclass is altered to "correct" or "unknown". + # + #ns_log notice "FormField make_correct ${:name}: [info exists :answer] [info exists :correct_when]" + + set :form_widget_CSSclass unknown + if {[info exists :correct_when]} { + # + # Try to get a correct value from the correct_when spec + # + set predicate [lindex ${:correct_when} 0] + switch $predicate { + "eq" {set correct [lindex ${:correct_when} 1]} + "contains" {set correct "... [lindex ${:correct_when} 1] ..."} + } + if {[info exists correct]} { + :value $correct + set :form_widget_CSSclass correct + #ns_log notice "FormField make_correct ${:name}: value '${:value}'" + } else { + ns_log notice "FormField make_correct ${:name}: not handled: correct_when '${:correct_when}' " + } + } else { + ns_log notice "FormField make_correct ${:name}: not handled: answer? [info exists :answer]" + } + set :help_text "" ;# we could provide a teacher-level feedback here. + } + FormField instproc add_statistics {} { + dict incr :result_statistics count + if {[info exists :evaluated_answer_result] && ${:evaluated_answer_result} eq "correct"} { + dict incr :result_statistics correct + #ns_log notice "??? add_statistics ${:name}: ${:result_statistics}" + } + } + + FormField instproc render_result_statistics {} { + # + # In case, there are result_statistics, use a "progres bar" to + # visualize correct answers. + # + if {[info exists :result_statistics] && [dict exists ${:result_statistics} count]} { + set result_count [dict get ${:result_statistics} count] + #ns_log notice "??? render_result_statistics: ${:name}: ${:result_statistics}" + if {$result_count > 0} { + ::html::div -class "progress" { + set correctCount [expr {[dict exists ${:result_statistics} correct] ? [dict get ${:result_statistics} correct] : 0}] + set percentage [format %2.0f [expr {$correctCount * 100.0 / $result_count}]] + ::html::div -class "progress-bar progress-bar-success" -role "progressbar" \ + -aria-valuenow $percentage -aria-valuemin "0" -aria-valuemax "100" -style "width:$percentage%" { + ::html::t "$percentage %" + } + } + } + } + } + FormField instproc render_disabled_as_div {class} { set attributes [:get_attributes id] lappend attributes class $class @@ -1155,6 +1243,17 @@ ${:object} set_property -new 1 ${:name} [:get_compound_value] } + CompoundField instproc make_correct {} { + foreach c ${:components} { + $c make_correct + } + } + CompoundField instproc add_statistics {} { + foreach c ${:components} { + $c add_statistics + } + } + ########################################################### # # ::xowiki::formfield::submit_button @@ -2996,16 +3095,23 @@ # :answers. # #ns_log notice "SHUFFLE ${:name} <$shuffled> <$indices>" - set option2 {}; set answer2 {} + set option2 {}; set answer2 {}; set answer_value2 {} foreach i $shuffled { lappend option2 [lindex ${:options} $i] lappend answer2 [lindex ${:answer} $i] + if {${:multiple} && [info exists :answer_value]} { + lappend answer_value2 [lindex ${:answer_value} $i] + } } #ns_log notice "SHUFFLE ${:name} o2=$option2 answer2=$answer2" set :options $option2 set :answer $answer2 + if {${:multiple}} { + set :answer_value $answer_value2 + } } } + ShuffleField instproc initialize {} { next # @@ -3033,6 +3139,17 @@ if {[info exists :category_tree]} { :config_from_category_tree [:category_tree] } + if {[info exists :answer]} { + set count 1 + set :answer_value {} + foreach a ${:answer} { + if {$a} { + lappend :answer_value $count + } + incr count + } + #ns_log notice "???? answer ${:answer} -> ${:answer_value}" + } next # @@ -3068,7 +3185,8 @@ set :correction {} foreach o ${:options} a ${:answer} { lassign $o label v - if {$a ne ""} { + #:log "enumeration CORRECT? <$a> <$v in $value> -> [expr {$v in $value}]" + if {$a} { lappend :correction [expr {$v in $value}] #:log "enumeration CORRECT? <$a> <$v in $value> -> [expr {$v in $value}]" } else { @@ -3080,6 +3198,28 @@ } } + enumeration instproc make_correct {} { + set :value ${:answer_value} + #ns_log notice "???? make_correct sets value ${:answer_value}" + } + + enumeration instproc add_statistics {} { + #ns_log notice "???? add_statistics" + # + # Add generic statistics + # + next + # + # Enumeration specific statistics + # + foreach v ${:value} { + dict incr :result_statistics $v + } + ns_log notice "### answer ${:answer} value ${:value} correction ${:correction} " + #ns_log notice [:serialize] + } + + enumeration instproc pretty_value {v} { if {[info exists :category_label($v)]} { return [set :category_label($v)] @@ -3146,6 +3286,58 @@ # } } + enumeration instproc render_result_statistics {rep} { + # + # In case, there are result_statistics, use a "progres bar" to + # visualize correct answers. + # + if {[info exists :result_statistics] && [dict exists ${:result_statistics} count]} { + set result_count [dict get ${:result_statistics} count] + + if {$result_count > 0} { + ::html::div -class "progress" { + set correctCount [expr {[dict exists ${:result_statistics} $rep] ? [dict get ${:result_statistics} $rep] : 0}] + set percentage [format %2.0f [expr {$correctCount * 100.0 / $result_count}]] + ::html::div -class "progress-bar progress-bar-success" -role "progressbar" \ + -aria-valuenow $percentage -aria-valuemin "0" -aria-valuemax "100" -style "width:$percentage%" { + ::html::t "$percentage %" + } + } + } + } + } + + enumeration instproc render_label_classes {} { + # + # Determine the values of the CSS classes for correct/incorrect + # rendering. In statistics mode (when :result_statistics exists), + # use the correct value of the alternative. Otherwise, use + # the correction of the actual value in the form field. + # + if {[info exists :result_statistics]} { + set values ${:answer} + #ns_log notice "==== radio answer $answer aw ${:answer_value} results ${:result_statistics}" + } else { + set values [expr {[info exists :correction] ? ${:correction} : ""}] + } + return [lmap v $values {dict get {"" "" 1 correct 0 incorrect t correct f incorrect} $v}] + } + + enumeration instproc render_label_text {label} { + # + # Render a label text (typically of a checkbox or radio input) + # either as richtext or as plain label. + # + if {${:richtext}} { + ::html::div -class richtext-label { + ::html::t -disableOutputEscaping $label + } + } else { + ::html::t " $label " + } + } + + ########################################################### # # ::xowiki::formfield::radio @@ -3154,10 +3346,12 @@ Class create radio -superclass enumeration -parameter { {horizontal false} + {richtext:boolean false} {forced_name} } radio instproc initialize {} { set :widget_type text(radio) + set :multiple false next } radio instproc render_input {} { @@ -3168,18 +3362,19 @@ type radio \ name [expr {[info exists :forced_name] ? ${:forced_name} : ${:name}}] - foreach o ${:options} { + foreach o ${:options} label_class [:render_label_classes] { lassign $o label rep set id ${:id}:$rep set atts [list {*}$base_atts id $id value $rep] if {$value eq $rep} { lappend atts checked checked } - set label_class [expr {${:horizontal} ? "radio-inline" : ""}] + if {${:horizontal}} {append label_class " radio-inline"} ::html::label -for $id -class $label_class { ::html::input $atts {} - ::html::t " $label " + :render_label_text $label } + :render_result_statistics $rep if {!${:horizontal}} { html::br } @@ -3204,7 +3399,7 @@ checkbox instproc value_if_nothing_is_returned_from_form {default} { - # Here we have to distinguish between two cases to: + # Here we have to distinguish between two cases: # - edit mode: somebody has removed a mark from a check button; # this means: clear the field # - view mode: the fields were deactivated (made insensitive); @@ -3216,6 +3411,7 @@ return "" } } + checkbox instproc render_input {} { set value [:value] @@ -3224,28 +3420,20 @@ type checkbox \ name ${:name} - set answer [expr {[info exists :correction] ? ${:correction} : ""}] - set CSSclasses {"" "" 1 correct 0 incorrect} - - foreach o ${:options} a $answer { + foreach o ${:options} label_class [:render_label_classes] { lassign $o label rep set id ${:id}:$rep set atts [list {*}$base_atts id $id value $rep] if {$rep in $value} { lappend atts checked checked } - set label_class [dict get $CSSclasses $a] if {${:horizontal}} {append label_class " checkbox-inline"} ::html::label -for $id -class $label_class { ::html::input $atts {} - if {${:richtext}} { - ::html::div -class richtext-label { - ::html::t -disableOutputEscaping $label - } - } else { - ::html::t " $label " - } + :render_label_text $label } + :render_result_statistics $rep + if {!${:horizontal}} { html::br } @@ -3269,6 +3457,8 @@ } text_fields instproc initialize {} { + # The value of ":multiple" has to be true for shuffling. + set :multiple true next set disabled [:is_disabled] @@ -3283,15 +3473,34 @@ #:log "TEXT text_fields fields\n[join $fields \n]>" :create_components $fields #:log "TEXT text_fields components <${:components}>" - } + text_fields instproc set_feedback {feedback_mode} { + next + # + # Make result (fully) correct, only when all sub-questsions are as + # well correct. + # + set :evaluated_answer_result [expr {"0" in ${:correction} ? "incorrect" : "correct"}] + return ${:evaluated_answer_result} + } + text_fields instproc answer_is_correct {} { #:log "text_fields CORRECT? ${:name}" + + set feedback_mode [expr {[${:object} exists __feedback_mode] ? [${:object} set __feedback_mode] : 0}] + set results {} + set :correction {} foreach c ${:components} { - $c set_feedback [${:object} set __feedback_mode] + set correct [$c set_feedback $feedback_mode] + lappend results $correct + lappend :correction [expr {$correct eq "correct"}] } - #:log "text_fields CORRECT? ${:name} -> 0" + #:log "text_fields CORRECT? ${:name} results $results -> 0" + # + # Return "0" to avoid double feedback via the info text per + # subquestion and on the top-level. + # return 0 } @@ -3315,7 +3524,7 @@ html::li { html::t -disableOutputEscaping [:get_text_entry [$c name]] $c render - #:log [$c serialize] + $c render_result_statistics } } }