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

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

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