Annotation of loncom/homework/optionresponse.pm, revision 1.18

1.1       albertel    1: # The LearningOnline Network with CAPA
                      2: # option list style responses
1.4       albertel    3: # 2/21 Guy
1.1       albertel    4: package Apache::optionresponse;
                      5: use strict;
1.6       albertel    6: use Apache::response;
1.1       albertel    7: 
                      8: sub BEGIN {
                      9:   &Apache::lonxml::register('Apache::optionresponse',('optionresponse'));
                     10: }
                     11: 
                     12: sub start_optionresponse {
1.11      albertel   13:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.9       albertel   14:   my $result='';
1.1       albertel   15:   #when in a radiobutton response use these
1.2       albertel   16:   &Apache::lonxml::register('Apache::optionresponse',('foilgroup','foil','conceptgroup'));
1.7       albertel   17:   push (@Apache::lonxml::namespace,'optionresponse');
1.1       albertel   18:   my $id = &Apache::response::start_response($parstack,$safeeval);
1.9       albertel   19:   if ($target eq 'edit') {
1.14      albertel   20:     $result.=&Apache::edit::start_table($token)."<tr><td>Multiple Option Response Question</td>
1.9       albertel   21: <td>Delete:".
                     22:   &Apache::edit::deletelist($target,$token)
1.17      albertel   23:     ."</td><td>&nbsp;</td></tr><tr><td colspan=\"3\">\n";
                     24:     $result.=&Apache::edit::text_arg('Max Number Of Foils:','max',$token,'4')."</td></tr>";
                     25:     $result.="<tr><td colspan=\"3\">\n";
                     26:   }
                     27:   if ($target eq 'modified') {
                     28:     my $constructtag=&Apache::edit::get_new_args($token,$parstack,$safeeval,'max');
                     29:     if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
1.9       albertel   30:   }
                     31:   return $result;
1.1       albertel   32: }
                     33: 
                     34: sub end_optionresponse {
1.15      albertel   35:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.1       albertel   36:   &Apache::response::end_response;
1.7       albertel   37:   pop @Apache::lonxml::namespace;
1.15      albertel   38:   my $result;
                     39:   if ($target eq 'edit') { $result=&Apache::edit::end_table(); }
                     40:   return $result;
1.1       albertel   41: }
                     42: 
1.7       albertel   43: sub insert_optionresponse {
                     44:   return '
                     45: <optionresponse max="10">
                     46:     <foilgroup options=\"\">
                     47:     </foilgroup>
                     48: </optionresponse>';
                     49: }
                     50: 
1.1       albertel   51: %Apache::response::foilgroup={};
                     52: sub start_foilgroup {
1.13      albertel   53:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                     54: 
                     55:   my $result='';
1.1       albertel   56:   %Apache::response::foilgroup={};
1.9       albertel   57:   $Apache::optionresponse::conceptgroup=0;
1.6       albertel   58:   &Apache::response::setrandomnumber();
1.13      albertel   59:   if ($target eq 'edit') {
                     60:     my $optionlist="<option></option>\n";
                     61:     my $option;
                     62:     my @opt;
                     63:     eval '@opt ='. &Apache::lonxml::get_param('options',$parstack,$safeeval);
1.17      albertel   64:     my $count=1;
1.13      albertel   65:     foreach $option (@opt) {
1.14      albertel   66:       $optionlist.="<option value=\"$count\">$option</option>\n";
1.16      albertel   67:       $count++;
1.13      albertel   68:     }
                     69:     my $insertlist=&Apache::edit::insertlist($target,$token);
1.14      albertel   70:     $result.=&Apache::edit::start_table($token);
1.13      albertel   71:     $result.= (<<ENDTABLE);
                     72:       <tr><td>Select Options</td>
                     73:         <td>
                     74: 	  Add new Option: <input type="text" name="$Apache::lonxml::curdepth.options" />
                     75:         </td>
                     76:         <td>Delete an Option:
                     77: 	  <select name="$Apache::lonxml::curdepth.deleteopt">$optionlist</select>
                     78:         </td>
                     79:      </tr>
                     80:      <tr><td colspan="3">$insertlist<br />
                     81: ENDTABLE
                     82:   }
                     83:   if ($target eq 'modified') {
                     84:     my @options;
1.14      albertel   85:     my $optchanged=0;
1.13      albertel   86:     eval '@options ='.&Apache::lonxml::get_param('options',$parstack,$safeeval);
1.14      albertel   87:     if ($ENV{"form.$Apache::lonxml::curdepth.deleteopt"}) {
                     88:       my $delopt=$ENV{"form.$Apache::lonxml::curdepth.deleteopt"};
1.16      albertel   89:       &Apache::lonxml::debug("Deleting :$delopt:");
1.17      albertel   90:       splice(@options,$delopt-1,1);
1.14      albertel   91:       $optchanged=1;
                     92:     }
1.13      albertel   93:     if ($ENV{"form.$Apache::lonxml::curdepth.options"}) {
                     94:       my $newopt = $ENV{"form.$Apache::lonxml::curdepth.options"};
                     95:       if ($options[0]) {
1.14      albertel   96: 	push(@options,$newopt);
1.13      albertel   97:       } else {
1.14      albertel   98: 	$options[0]=$newopt;
1.13      albertel   99:       }
1.14      albertel  100:       $optchanged=1;
                    101:     }
                    102:     if ($optchanged) {
1.13      albertel  103:       $result = "<foilgroup options=\"(";
                    104:       foreach my $option (@options) {
1.14      albertel  105: 	$option=~s/\'/\\\'/;
1.13      albertel  106: 	&Apache::lonxml::debug("adding option :$option:");
                    107: 	$result .="'".$option."',";
                    108:       }
                    109:       chop $result;
                    110:       $result.=')">';
1.14      albertel  111:     } # else nothing changed so just use the default mechanism
1.13      albertel  112:   }
                    113:   return $result;
1.1       albertel  114: }
                    115: 
                    116: sub end_foilgroup {
1.11      albertel  117:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.1       albertel  118:   
                    119:   my $result;
1.15      albertel  120:   if ($target eq 'grade' || $target eq 'web') {
1.1       albertel  121:     my $name;
                    122:     my ($count,$max) = &getfoilcounts($parstack,$safeeval);
                    123:     if ($count>$max) { $count=$max } 
                    124:     &Apache::lonxml::debug("Count is $count from $max");
                    125:     my @opt;
1.13      albertel  126:     eval '@opt ='.&Apache::lonxml::get_param('options',$parstack,$safeeval);
                    127:     &Apache::lonxml::debug("Options are $#opt");
1.1       albertel  128:     if ($target eq 'web') {
                    129:       $result=&displayfoils($count,@opt);
                    130:     } elsif ( $target eq 'grade') {
                    131:       if ( defined $ENV{'form.submitted'}) {
                    132: 	my @whichopt = &whichfoils($count);
                    133: 	my $temp=1;my $name;
                    134: 	my $allresponse;
                    135: 	my $right=0;
                    136: 	my $wrong=0;
1.8       albertel  137: 	my $ignored=0;
1.1       albertel  138: 	foreach $name (@whichopt) {
                    139: 	  my $response = $ENV{'form.HWVAL_'.$Apache::inputtags::response['-1'].":$temp"};
                    140: 	  $allresponse.="$response:";
                    141: 	  if ( $response =~ /[^\s]/) {
1.3       albertel  142: 	    &Apache::lonxml::debug("submitted a $response<br />\n");
1.1       albertel  143: 	    my $value=$Apache::response::foilgroup{$name.'.value'};
                    144: 	    if ($value eq $response) {$right++;} else {$wrong++;}
1.8       albertel  145: 	  } else {
                    146: 	    $ignored++;
1.1       albertel  147: 	  }
                    148: 	  $temp++;
                    149: 	}
                    150: 	my $id = $Apache::inputtags::response['-1'];
                    151: 	$Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.submission"}=$allresponse;
1.8       albertel  152: 	&Apache::lonxml::debug("Got $right right and $wrong wrong, and $ignored were ignored");
                    153: 	if ($wrong==0 && $ignored==0) {
1.1       albertel  154: 	  $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}='EXACT_ANS';
                    155: 	} else {
                    156: 	  $Apache::lonhomework::results{"resource.$Apache::inputtags::part.$id.awarddetail"}='INCORRECT';
                    157: 	}
                    158:       }
                    159:     }
                    160:   }
1.15      albertel  161:   if ($target eq 'edit') {
                    162:     $result.=&Apache::edit::end_table();
                    163:   }
1.1       albertel  164:   return $result;
                    165: }
                    166: 
                    167: sub getfoilcounts {
                    168:   my ($parstack,$safeeval)=@_;
1.10      albertel  169:   my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2');
1.9       albertel  170:   # +1 since instructors will count from 1
                    171:   my $count = $#{ $Apache::response::foilgroup{'names'} }+1;
1.1       albertel  172:   return ($count,$max);
                    173: }
                    174: 
                    175: sub whichfoils {
                    176:   my ($max)=@_;
                    177:   my @names = @{ $Apache::response::foilgroup{'names'} };
                    178:   my @whichopt =();
1.9       albertel  179:   while ((($#whichopt+1) < $max) && ($#names > -1)) {
                    180:     &Apache::lonxml::debug("Have $#whichopt max is $max");
                    181:     my $aopt=int(rand($#names+1));
1.6       albertel  182:     &Apache::lonxml::debug("From $#whichopt $max $#names elms, picking $aopt");
1.1       albertel  183:     $aopt=splice(@names,$aopt,1);
                    184:     &Apache::lonxml::debug("Picked $aopt");
                    185:     push (@whichopt,$aopt);
                    186:   }
                    187:   return @whichopt;
                    188: }
                    189: 
                    190: sub displayfoils {
                    191:   my ($max,@opt)=@_;
                    192:   my @names = @{ $Apache::response::foilgroup{'names'} };
                    193:   my @truelist;
                    194:   my @falselist;
                    195:   my $result;
                    196:   my $name;
                    197:   my @whichopt = &whichfoils($max);
                    198:   my $optionlist="<option></option>\n";
                    199:   my $option;
                    200:   foreach $option (@opt) {
                    201:     $optionlist.="<option>$option</option>\n";
                    202:   }
                    203:   if ($Apache::lonhomework::history{"resource.$Apache::inputtags::part.solved"} =~ /^correct/ ) {
                    204:     foreach $name (@whichopt) {
                    205:       $result.="<br />".$Apache::response::foilgroup{$name.'.value'}.
                    206: 	":".$Apache::response::foilgroup{$name.'.text'}."\n";
                    207:     }
                    208:   } else {
                    209:     my $temp=1;
                    210:     foreach $name (@whichopt) {
                    211:       $result.="<br /><select name=\"HWVAL_$Apache::inputtags::response['-1']:$temp\">"
                    212: 	.$optionlist
                    213: 	  ."</select>\n".$Apache::response::foilgroup{$name.'.text'}."\n";
                    214:       $temp++;
                    215:     }
                    216:   }
                    217:   return $result."<br />";
                    218: }
                    219: 
1.5       albertel  220: 
1.2       albertel  221: sub start_conceptgroup {
1.15      albertel  222:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
                    223:   $Apache::optionresponse::conceptgroup=1;
1.5       albertel  224:   %Apache::response::conceptgroup={};
1.15      albertel  225:   my $result;
                    226:   if ($target eq 'edit') {
                    227:     $result.=&Apache::edit::tag_start($target,$token,"Concept Grouped Foils");
1.17      albertel  228:     $result.=&Apache::edit::text_arg('Concept:','concept',$token,'50')."</td></tr>";
                    229:     $result.="<tr><td colspan=\"3\">\n";
1.15      albertel  230:   }
1.16      albertel  231:   if ($target eq 'modified') {
                    232:     my $constructtag=&Apache::edit::get_new_args($token,$parstack,$safeeval,'concept');
                    233:     if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
                    234:   }
1.15      albertel  235:   return $result;
1.2       albertel  236: }
                    237: 
                    238: sub end_conceptgroup {
1.11      albertel  239:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.15      albertel  240:   $Apache::optionresponse::conceptgroup=0;
                    241:   my $result='';
1.5       albertel  242:   if ($target eq 'web' || $target eq 'grade') {
1.18    ! albertel  243:     #if not there aren't any foils to display and thus no question
        !           244:     if (defined(@{ $Apache::response::conceptgroup{'names'} })) {
        !           245:       my @names = @{ $Apache::response::conceptgroup{'names'} };
        !           246:       my $pick=int rand $#names+1;
        !           247:       my $name=$names[$pick];
        !           248:       push @{ $Apache::response::foilgroup{'names'} }, $name;
        !           249:       $Apache::response::foilgroup{"$name.value"} =  $Apache::response::conceptgroup{"$name.value"};
        !           250:       $Apache::response::foilgroup{"$name.text"} =  $Apache::response::conceptgroup{"$name.text"};
        !           251:       my $concept = &Apache::lonxml::get_param('concept',$parstack,$safeeval);
        !           252:       $Apache::response::foilgroup{"$name.concept"} = $concept;
        !           253:       &Apache::lonxml::debug("Selecting $name in $concept");
        !           254:     }
1.5       albertel  255:   }
1.15      albertel  256:   if ($target eq 'edit') {
                    257:     $result=&Apache::edit::end_table();
                    258:   }
                    259:   return $result;
1.2       albertel  260: }
                    261: 
1.16      albertel  262: sub insert_conceptgroup {
1.18    ! albertel  263:   my $result="\n\t\t<conceptgroup concept=\"\">".&insert_foil()."\n\t\t</conceptgroup>\n";
1.16      albertel  264:   return $result;
                    265: }
                    266: 
1.1       albertel  267: sub start_foil {
1.11      albertel  268:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.13      albertel  269:   my $result='';
1.4       albertel  270:   if ($target eq 'web') { &Apache::lonxml::startredirection; }
1.13      albertel  271:   if ($target eq 'edit') {
                    272:     $result=&Apache::edit::tag_start($target,$token,"Foil");
1.15      albertel  273:     my $level='-2';
                    274:     if ($$tagstack['-2'] eq 'conceptgroup') { $level = '-3'; }
1.13      albertel  275:     my @opt;
1.15      albertel  276:     eval '@opt ='.&Apache::lonxml::get_param('options',$parstack,$safeeval,$level);
1.17      albertel  277:     $result.=&Apache::edit::text_arg('Name:','name',$token).
                    278:       &Apache::edit::select_arg('Correct Option:','value',['unused',(@opt)],$token).
                    279:       '</td></tr><tr><td colspan="3">';
1.15      albertel  280:   }
                    281:   if ($target eq 'modified') {
1.16      albertel  282:     my $constructtag=&Apache::edit::get_new_args($token,$parstack,$safeeval,'value','name');
                    283:     if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); }
1.13      albertel  284:   }
                    285:   return $result;
1.1       albertel  286: }
                    287: 
                    288: sub end_foil {
1.11      albertel  289:   my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
1.4       albertel  290:   my $text ='';
1.13      albertel  291:   my $result = '';
1.4       albertel  292:   if ($target eq 'web') { $text=&Apache::lonxml::endredirection; }
1.1       albertel  293:   if ($target eq 'web' || $target eq 'grade') {
1.10      albertel  294:     my $value = &Apache::lonxml::get_param('value',$parstack,$safeeval);
1.1       albertel  295:     if ($value ne 'unused') {
1.10      albertel  296:       my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval);
1.18    ! albertel  297:       &Apache::lonxml::debug("Got a name of :$name:");
1.13      albertel  298:       if (!$name) { $name=$Apache::lonxml::curdepth; }
1.18    ! albertel  299:       &Apache::lonxml::debug("Using a name of :$name:");
1.5       albertel  300:       if ( $Apache::optionresponse::conceptgroup ) {
                    301: 	push @{ $Apache::response::conceptgroup{'names'} }, $name;
                    302: 	$Apache::response::conceptgroup{"$name.value"} = $value;
                    303: 	$Apache::response::conceptgroup{"$name.text"} = $text;	
                    304:       } else {
                    305: 	push @{ $Apache::response::foilgroup{'names'} }, $name;
                    306: 	$Apache::response::foilgroup{"$name.value"} = $value;
                    307: 	$Apache::response::foilgroup{"$name.text"} = $text;
                    308:       }
1.2       albertel  309:     }
1.6       albertel  310:   }
                    311:   if ($target eq 'edit') {
1.13      albertel  312:     $result.= &Apache::edit::tag_end($target,$token,'');
1.1       albertel  313:   }
1.13      albertel  314:   return $result;
1.1       albertel  315: }
                    316: 
1.7       albertel  317: sub insert_foil {
                    318:   return '
1.15      albertel  319: <foil name="" value="unused">
1.14      albertel  320: <startouttext />
                    321: <endouttext />
1.7       albertel  322: </foil>';
                    323: }
1.1       albertel  324: 1;
                    325: __END__
                    326:  

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>