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

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

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