loncom/homework/imageresponse.pm - view

File: [LON-CAPA] / loncom / homework / imageresponse.pm
Revision 1.103: download - view: text, annotated - select for diffs
Mon Nov 14 03:08:01 2011 UTC (12 years, 6 months ago) by raeburn
Branches: MAIN
CVS tags: language_hyphenation_merge, language_hyphenation, HEAD, BZ4492-merge, BZ4492-feature_horizontal_radioresponse, BZ4492-feature_Support_horizontal_radioresponse, BZ4492-Support_horizontal_radioresponse

Using bubblesheets to record grades for handgraded exams
  -- choose what filled last bubble represents (either a zero or max,
     i.e., 5 for 5 bubbles per line, 10 for 10 bubbles per line etc.)
grades.pm
  - New routine: &hand_bubble_option() determines if sequence to be graded
    contains response types which are handgraded, and offers radio buttons to
    choose score for last bubble.
response.pm
  - &repetition() routine can be called in scalar context of in array context.
    scalar: returns number of lines to encode weight
    array: returns (number of lines to encode weight, bubbles/line).
chemresponse.pm imageresponse.pm caparesponse/caparesponse.pm
  - &response::repetition() now explicitly called in scalar context.
Work in progress.
  (Corresponding option needed in lonprintout.pm to set
   correct number of bubble rows for handgraded questions with
   weight >= bubbles per row).

1: # 2: # The LearningOnline Network with CAPA 3: # image click response style 4: # 5: # $Id: imageresponse.pm,v 1.103 2011/11/14 03:08:01 raeburn Exp $ 6: # 7: # Copyright Michigan State University Board of Trustees 8: # 9: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 10: # 11: # LON-CAPA is free software; you can redistribute it and/or modify 12: # it under the terms of the GNU General Public License as published by 13: # the Free Software Foundation; either version 2 of the License, or 14: # (at your option) any later version. 15: # 16: # LON-CAPA is distributed in the hope that it will be useful, 17: # but WITHOUT ANY WARRANTY; without even the implied warranty of 18: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19: # GNU General Public License for more details. 20: # 21: # You should have received a copy of the GNU General Public License 22: # along with LON-CAPA; if not, write to the Free Software 23: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 24: # 25: # /home/httpd/html/adm/gpl.txt 26: # 27: # http://www.lon-capa.org/ 28: # 29: #FIXME LATER assumes multiple possible submissions but only one is possible 30: #currently 31: 32: 33: =head1 NAME 34: 35: Apache::imageresponse 36: 37: =head1 SYNOPSIS 38: 39: Coordinates the response to clicking an image. 40: 41: This is part of the LearningOnline Network with CAPA project 42: described at http://www.lon-capa.org. 43: 44: =head1 SUBROUTINES 45: 46: =over 47: 48: =item start_imageresponse() 49: 50: =item end_imageresponse() 51: 52: =item start_foilgroup() 53: 54: =item getfoilcounts() 55: 56: =item whichfoils() 57: 58: =item prep_image() 59: 60: =item draw_image() 61: 62: =item displayfoils() 63: 64: =item format_prior_response() 65: 66: =item display_answers() 67: 68: =item clean_up_image() 69: 70: =item gradefoils() 71: 72: =item stringify_submission() 73: 74: =item get_submission() 75: 76: =item end_foilgroup() 77: 78: =item start_conceptgroup() 79: 80: =item end_conceptgroup() 81: 82: =item insert_foil() 83: 84: =item start_foil() 85: 86: =item end_foil() 87: 88: =item start_text() 89: 90: =item end_text() 91: 92: =item start_image() 93: 94: =item end_image() 95: 96: =item start_rectangle() 97: 98: =item grade_rectangle() 99: 100: =item end_rectangle() 101: 102: =item start_polygon() 103: 104: =item grade_polygon() 105: 106: =item end_polygon() 107: 108: =back 109: 110: =cut 111: 112: 113: package Apache::imageresponse; 114: use strict; 115: use Image::Magick(); 116: use Apache::randomlylabel(); 117: use Apache::londefdef(); 118: use Apache::Constants qw(:common :http); 119: use Apache::lonlocal; 120: use Apache::lonnet; 121: use lib '/home/httpd/lib/perl/'; 122: use LONCAPA; 123: 124: 125: BEGIN { 126: &Apache::lonxml::register('Apache::imageresponse',('imageresponse')); 127: } 128: 129: sub start_imageresponse { 130: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 131: my $result; 132: #when in a radiobutton response use these 133: &Apache::lonxml::register('Apache::imageresponse', 134: ('foilgroup','foil','text','image','rectangle', 135: 'polygon','conceptgroup')); 136: push (@Apache::lonxml::namespace,'imageresponse'); 137: my $id = &Apache::response::start_response($parstack,$safeeval); 138: undef(%Apache::response::foilnames); 139: if ($target eq 'meta') { 140: $result=&Apache::response::meta_package_write('imageresponse'); 141: } elsif ($target eq 'analyze') { 142: my $part_id="$Apache::inputtags::part.$id"; 143: $Apache::lonhomework::analyze{"$part_id.type"} = 'imageresponse'; 144: push (@{ $Apache::lonhomework::analyze{"parts"} },$part_id); 145: push (@{ $Apache::lonhomework::analyze{"$part_id.bubble_lines"} }, 146: 1); 147: } elsif ( $target eq 'edit' ) { 148: $result .= &Apache::edit::tag_start($target,$token). 149: &Apache::edit::text_arg('Max Number Of Shown Foils:', 150: 'max',$token,'4'). 151: &Apache::edit::end_row(). 152: &Apache::edit::start_spanning_row(); 153: } elsif ( $target eq 'modified' ) { 154: my $constructtag= 155: &Apache::edit::get_new_args($token,$parstack,$safeeval,'max'); 156: if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } 157: } 158: return $result; 159: } 160: 161: sub end_imageresponse { 162: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 163: 164: my $part_id = $Apache::inputtags::part; 165: my $response_id = $Apache::inputtags::response[-1]; 166: 167: pop(@Apache::lonxml::namespace); 168: &Apache::lonxml::deregister('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup')); 169: 170: my $result; 171: if ($target eq 'edit') { 172: $result=&Apache::edit::end_table(); 173: } elsif ($target eq 'tex' 174: && $Apache::lonhomework::type eq 'exam') { 175: $result=&Apache::inputtags::exam_score_line($target); 176: } 177: 178: undef(%Apache::response::foilnames); 179: 180: if ($target eq 'grade' || $target eq 'web' || $target eq 'answer' || 181: $target eq 'tex' || $target eq 'analyze') { 182: my $repetition = &Apache::response::repetition(); 183: &Apache::lonxml::increment_counter($repetition, 184: "$part_id.$response_id"); 185: if ($target eq 'analyze') { 186: &Apache::lonhomework::set_bubble_lines(); 187: } 188: 189: } 190: &Apache::response::end_response(); 191: return $result; 192: } 193: 194: %Apache::response::foilgroup=(); 195: sub start_foilgroup { 196: my ($target) = @_; 197: %Apache::response::foilgroup=(); 198: $Apache::imageresponse::conceptgroup=0; 199: &Apache::response::pushrandomnumber(undef,$target); 200: return ''; 201: } 202: 203: sub getfoilcounts { 204: my ($parstack,$safeeval)=@_; 205: 206: my $max = &Apache::lonxml::get_param('max',$parstack,$safeeval,'-2'); 207: # +1 since instructors will count from 1 208: my $count = $#{ $Apache::response::foilgroup{'names'} }+1; 209: if (&Apache::response::showallfoils()) { $max=$count; } 210: return ($count,$max); 211: } 212: 213: sub whichfoils { 214: my ($max)=@_; 215: return if (!defined(@{ $Apache::response::foilgroup{'names'} })); 216: my @names = @{ $Apache::response::foilgroup{'names'} }; 217: my @whichopt; 218: while ((($#whichopt+1) < $max) && ($#names > -1)) { 219: &Apache::lonxml::debug("Have $#whichopt max is $max"); 220: my $aopt; 221: if (&Apache::response::showallfoils()) { 222: $aopt=0; 223: } else { 224: $aopt=int(&Math::Random::random_uniform() * ($#names+1)); 225: } 226: &Apache::lonxml::debug("From $#names elms, picking $aopt"); 227: $aopt=splice(@names,$aopt,1); 228: &Apache::lonxml::debug("Picked $aopt"); 229: push(@whichopt,$aopt); 230: } 231: return @whichopt; 232: } 233: 234: sub prep_image { 235: my ($image,$mode,$name)=@_; 236: 237: my ($x,$y)= &get_submission($name); 238: &Apache::lonxml::debug("for $name drawing click at $x and $y"); 239: &draw_image($mode,$image,$x,$y,$Apache::response::foilgroup{"$name.area"}); 240: } 241: 242: sub draw_image { 243: my ($mode,$image,$x,$y,$areas) = @_; 244: 245: my $id=&Apache::loncommon::get_cgi_id(); 246: 247: my (%x,$i); 248: $x{"cgi.$id.BGIMG"}=&escape($image); 249: 250: #draws 2 xs on the image at the clicked location 251: #one in white and then one in red on top of the one in white 252: 253: if (defined($x) && $x =~/\S/ 254: && defined($y) && $y =~/\S/ 255: && ($mode eq 'submission' || !&Apache::response::show_answer()) 256: && $mode ne 'answeronly') { 257: my $length = 6; 258: my $width = 1; 259: my $extrawidth = 2; 260: my $xmin=($x-$length); 261: my $xmax=($x+$length); 262: my $ymin=($y-$length); 263: my $ymax=($y+$length); 264: 265: $x{"cgi.$id.OBJTYPE"}.='LINE:'; 266: $i=$x{"cgi.$id.OBJCOUNT"}++; 267: $x{"cgi.$id.OBJ$i"}=join(':',(($xmin),($ymin),($xmax),($ymax), 268: "FFFFFF",($width+$extrawidth))); 269: $x{"cgi.$id.OBJTYPE"}.='LINE:'; 270: $i=$x{"cgi.$id.OBJCOUNT"}++; 271: $x{"cgi.$id.OBJ$i"}=join(':',(($xmin),($ymax),($xmax),($ymin), 272: "FFFFFF",($width+$extrawidth))); 273: $x{"cgi.$id.OBJTYPE"}.='LINE:'; 274: $i=$x{"cgi.$id.OBJCOUNT"}++; 275: $x{"cgi.$id.OBJ$i"}=join(':',(($xmin),($ymin),($xmax),($ymax), 276: "FF0000",($width))); 277: $x{"cgi.$id.OBJTYPE"}.='LINE:'; 278: $i=$x{"cgi.$id.OBJCOUNT"}++; 279: $x{"cgi.$id.OBJ$i"}=join(':',(($xmin),($ymax),($xmax),($ymin), 280: "FF0000",($width))); 281: } 282: if ($mode eq 'answer' || $mode eq 'answeronly') { 283: my $width = 1; 284: my $extrawidth = 2; 285: foreach my $area (@{ $areas }) { 286: if ($area=~/^rectangle:/) { 287: $x{"cgi.$id.OBJTYPE"}.='RECTANGLE:'; 288: $i=$x{"cgi.$id.OBJCOUNT"}++; 289: my ($x1,$y1,$x2,$y2)= 290: ($area=~m/rectangle:$([0-9]+),([0-9]+)$\-$([0-9]+),([0-9]+)$/); 291: $x{"cgi.$id.OBJ$i"}=join(':',($x1,$y1,$x2,$y2,"FFFFFF", 292: ($width+$extrawidth))); 293: $x{"cgi.$id.OBJTYPE"}.='RECTANGLE:'; 294: $i=$x{"cgi.$id.OBJCOUNT"}++; 295: $x{"cgi.$id.OBJ$i"}=join(':',($x1,$y1,$x2,$y2,"00FF00",$width)); 296: } elsif ($area=~/^polygon:(.*)/) { 297: $x{"cgi.$id.OBJTYPE"}.='POLYGON:'; 298: $i=$x{"cgi.$id.OBJCOUNT"}++; 299: $x{"cgi.$id.OBJ$i"}=join(':',("FFFFFF",($width+$extrawidth))); 300: $x{"cgi.$id.OBJEXTRA$i"}=$1; 301: $x{"cgi.$id.OBJTYPE"}.='POLYGON:'; 302: $i=$x{"cgi.$id.OBJCOUNT"}++; 303: $x{"cgi.$id.OBJ$i"}=join(':',("00FF00",$width)); 304: $x{"cgi.$id.OBJEXTRA$i"}=$1; 305: } 306: } 307: } 308: &Apache::lonnet::appenv(\%x); 309: return $id; 310: } 311: 312: sub displayfoils { 313: my ($target,@whichopt) = @_; 314: my $result =''; 315: my $temp=1; 316: my @images; 317: foreach my $name (@whichopt) { 318: $result.=$Apache::response::foilgroup{"$name.text"}; 319: &Apache::lonxml::debug("Text is $result"); 320: if ($target eq 'tex') {$result.="\\vskip 0 mm \n";} else {$result.="<br />\n";} 321: my $image=$Apache::response::foilgroup{"$name.image"}; 322: &Apache::lonxml::debug("image is $image"); 323: if ( ($target eq 'web' || $target eq 'answer') 324: && $image !~ /^https?\:/ ) { 325: $image=&clean_up_image($image); 326: } 327: push(@images,$image); 328: &Apache::lonxml::debug("image is $image"); 329: if ( &Apache::response::show_answer() ) { 330: if ($target eq 'tex') { 331: $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n"; 332: } else { 333: my $token=&prep_image($image,'answer',$name); 334: $result.="<img src=\"/adm/randomlabel.png?token=$token\" /><br />\n"; 335: } 336: } else { 337: if ($target eq 'tex') { 338: $result.=$Apache::response::foilgroup{"$name.image"}."\\vskip 0 mm \n"; 339: } else { 340: my $respid=$Apache::inputtags::response['-1']; 341: my $token=&prep_image($image,'submission',$name); 342: my $input_id = "HWVAL_$respid:$temp"; 343: my $id = $env{'form.request.prefix'}.$input_id; 344: $result.='<img onclick="image_response_click(\''.$id.'\',event);" 345: src="/adm/randomlabel.png?token='.$token.'" 346: id="'.$id.'_imageresponse" 347: />'. 348: '<br />'. 349: '<input type="hidden" name="'.$input_id.'_token" value="'.$token.'" />'. 350: '<input type="hidden" name="'.$input_id.'" value="'. 351: join(':',&get_submission($name)).'" />'; 352: } 353: } 354: $temp++; 355: } 356: if ($target eq 'web') { 357: &get_prior_options(\@images,\@whichopt); 358: } 359: return $result; 360: } 361: 362: sub get_prior_options { 363: my ($currimages,$curropt) = @_; 364: return unless((ref($curropt) eq 'ARRAY') && 365: (ref($currimages) eq 'ARRAY')); 366: my $part = $Apache::inputtags::part; 367: my $respid = $Apache::inputtags::response[-1]; 368: foreach my $i (1..$Apache::lonhomework::history{'version'}) { 369: my $partprefix = "$i:resource.$part"; 370: my $sub_key = "$partprefix.$respid.submission"; 371: next if (!exists($Apache::lonhomework::history{$sub_key})); 372: my $type_key = "$partprefix.type"; 373: my @whichopt = (); 374: my @images = (); 375: if ($Apache::lonhomework::history{$type_key} eq 'randomizetry') { 376: my $order_key = "$partprefix.$respid.foilorder"; 377: @whichopt = &Apache::lonnet::str2array($Apache::lonhomework::history{$order_key}); 378: if (@whichopt > 0) { 379: foreach my $name (@whichopt) { 380: my $image=$Apache::response::foilgroup{"$name.image"}; 381: if ($image !~ /^https?\:/ ) { 382: $image=&clean_up_image($image); 383: } 384: push(@images,$image); 385: } 386: } 387: } else { 388: @whichopt = @{$curropt}; 389: @images = @{$currimages}; 390: } 391: my $submission = $Apache::lonhomework::history{$sub_key}; 392: my $output = &format_prior_response('grade',$submission, 393: [\@images,\@whichopt]); 394: if (defined($output)) { 395: $Apache::inputtags::submission_display{$sub_key} = $output; 396: } 397: } 398: } 399: 400: sub format_prior_response { 401: my ($mode,$answer,$other_data) = @_; 402: 403: my $result; 404: 405: # make a copy of the data in the refs 406: my @images = @{ $other_data->[0] }; 407: my @foils = @{ $other_data->[1] }; 408: foreach my $name (@foils) { 409: my $image = pop(@images); 410: my ($x,$y) = &get_submission($name,$answer); 411: my $token = &draw_image('submission',$image,$x,$y); 412: $result .= 413: '<img class="LC_prior_image" 414: src="/adm/randomlabel.png?token='.$token.'" /><br />'; 415: } 416: return $result; 417: } 418: 419: sub display_answers { 420: my ($target,$whichopt)=@_; 421: 422: my $result=&Apache::response::answer_header('imageresponse'); 423: foreach my $name (@$whichopt) { 424: my $image=$Apache::response::foilgroup{"$name.image"}; 425: &Apache::lonxml::debug("image is $image"); 426: if ( ($target eq 'web' || $target eq 'answer') 427: && $image !~ /^https?\:/ ) { 428: $image = &clean_up_image($image); 429: } 430: my $token=&prep_image($image,'answeronly',$name); 431: 432: $result.=&Apache::response::answer_part('imageresponse',"<img src=\"/adm/randomlabel.png?token=$token\" /><br />\n"); 433: } 434: $result.=&Apache::response::answer_footer('imageresponse'); 435: return $result; 436: } 437: 438: sub clean_up_image { 439: my ($image)=@_; 440: if ($image =~ /\s*<img\s*/) { 441: ($image) = ($image =~ /src\s*=\s*[\"\']([^\"\']+)[\"\']/i); 442: if ($image !~ /^https?\:/) { 443: $image=&Apache::lonnet::hreflocation('',$image); 444: } 445: if (!$image) { 446: $image='/home/httpd/html/adm/lonKaputt/lonlogo_broken.gif'; 447: } 448: } else { 449: $image=&Apache::lonnet::filelocation($Apache::lonxml::pwd[-1],$image); 450: &Apache::lonxml::debug("repcopying: $image"); 451: if (&Apache::lonnet::repcopy($image) ne 'ok') { 452: $image='/home/httpd/html/adm/lonKaputt/lonlogo_broken.gif'; 453: } 454: } 455: return $image; 456: } 457: 458: sub gradefoils { 459: my (@whichopt) = @_; 460: 461: my $partid = $Apache::inputtags::part; 462: my $id = $Apache::inputtags::response['-1']; 463: 464: if ($Apache::lonhomework::type eq 'exam') { 465: &Apache::response::scored_response($partid,$id); 466: return; 467: } 468: 469: my @results; 470: my $temp=1; 471: my %response; 472: foreach my $name (@whichopt) { 473: my ($x,$y) = split(':',$env{"form.HWVAL_$id:$temp"}); 474: $response{$name} = $env{"form.HWVAL_$id:$temp"}; 475: &Apache::lonxml::debug("Got a x of $x and a y of $y for $name"); 476: if (defined($x) && defined($y) && 477: defined(@{ $Apache::response::foilgroup{"$name.area"} })) { 478: my @areas = @{ $Apache::response::foilgroup{"$name.area"} }; 479: my $grade="INCORRECT"; 480: foreach my $area (@areas) { 481: &Apache::lonxml::debug("Area is $area for $name"); 482: $area =~ m/([a-z]*):/; 483: &Apache::lonxml::debug("Area of type $1"); 484: if ($1 eq 'rectangle') { 485: $grade=&grade_rectangle($area,$x,$y); 486: } elsif ($1 eq 'polygon') { 487: $grade=&grade_polygon($area,$x,$y); 488: } else { 489: &Apache::lonxml::error(&mt('Unknown area style [_1]',$area)); 490: } 491: &Apache::lonxml::debug("Area said $grade"); 492: if ($grade eq 'APPROX_ANS') { last; } 493: } 494: &Apache::lonxml::debug("Foil was $grade"); 495: push(@results, $grade) 496: } else { 497: push(@results, 'MISSING_ANSWER') 498: } 499: $temp++; 500: } 501: if ($Apache::lonhomework::type eq 'randomizetry') { 502: $Apache::lonhomework::results{"resource.$partid.$id.foilorder"} = &Apache::lonnet::array2str(@whichopt); 503: } 504: my ($result) = &Apache::inputtags::finalizeawards(\@results,[]); 505: &Apache::lonxml::debug("Question is $result"); 506: 507: my $part=$Apache::inputtags::part; 508: my %previous= 509: &Apache::response::check_for_previous(&stringify_submission(\%response), 510: $part,$id); 511: if ($result) { 512: if ($Apache::lonhomework::type eq 'survey') { 513: $result='SUBMITTED'; 514: } elsif ($Apache::lonhomework::type eq 'surveycred') { 515: $result='SUBMITTED_CREDIT'; 516: } elsif ($Apache::lonhomework::type eq 'anonsurvey') { 517: $result='ANONYMOUS'; 518: } elsif ($Apache::lonhomework::type eq 'anonsurveycred') { 519: $result='ANONYMOUS_CREDIT'; 520: } 521: } 522: 523: &Apache::response::handle_previous(\%previous,$result); 524: $Apache::lonhomework::results{"resource.$part.$id.submission"}= 525: &stringify_submission(\%response); 526: $Apache::lonhomework::results{"resource.$part.$id.awarddetail"}=$result; 527: return; 528: } 529: 530: sub stringify_submission { 531: my ($response) = @_; 532: return &Apache::lonnet::hash2str(%{ $response }); 533: } 534: 535: sub get_submission { 536: my ($name,$string) = @_; 537: 538: if (!defined($string)) { 539: my $part=$Apache::inputtags::part; 540: my $respid=$Apache::inputtags::response['-1']; 541: $string = 542: $Apache::lonhomework::history{"resource.$part.$respid.submission"}; 543: } 544: 545: if ($string !~ /=/) { 546: return split(':',$string); 547: } else { 548: my %response = &Apache::lonnet::str2hash($string); 549: return split(':',$response{$name}); 550: } 551: } 552: 553: sub end_foilgroup { 554: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 555: my $result=''; 556: my @whichopt; 557: 558: if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' || 559: $target eq 'analyze' || $target eq 'answer') { 560: 561: my ($count,$max) = &getfoilcounts($parstack,$safeeval); 562: if ($count>$max) { $count=$max } 563: &Apache::lonxml::debug("Count is $count from $max"); 564: 565: @whichopt = &whichfoils($max); 566: 567: if ($target eq 'web' || $target eq 'tex') { 568: $result=&displayfoils($target,@whichopt); 569: if ($Apache::lonhomework::type eq 'randomizetry') { 570: if ($target eq 'web') { 571: &get_prior_options($target,@whichopt); 572: } 573: } 574: $Apache::lonxml::post_evaluate=0; 575: } elsif ($target eq 'grade') { 576: if ( defined $env{'form.submitted'}) { &gradefoils(@whichopt); } 577: } elsif ( $target eq 'analyze') { 578: &Apache::response::analyze_store_foilgroup(\@whichopt, 579: ['text','image','area']); 580: } elsif ($target eq 'answer' 581: && $env{'form.answer_output_mode'} ne 'tex') { 582: $result=&display_answers($target,\@whichopt); 583: } 584: 585: } elsif ($target eq 'edit') { 586: $result=&Apache::edit::end_table(); 587: } 588: &Apache::response::poprandomnumber(); 589: return $result; 590: } 591: 592: sub start_conceptgroup { 593: $Apache::imageresponse::conceptgroup=1; 594: %Apache::response::conceptgroup=(); 595: return ''; 596: } 597: 598: sub end_conceptgroup { 599: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 600: $Apache::imageresponse::conceptgroup=0; 601: my $result; 602: if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' || 603: $target eq 'analyze') { 604: &Apache::response::pick_foil_for_concept($target, 605: ['area','text','image'], 606: \%Apache::hint::image, 607: $parstack,$safeeval); 608: } elsif ($target eq 'edit') { 609: $result=&Apache::edit::end_table(); 610: } 611: return $result; 612: } 613: 614: sub insert_foil { 615: return ' 616: <foil> 617: <image></image> 618: <text></text> 619: <rectangle></rectangle> 620: </foil> 621: '; 622: } 623: 624: $Apache::imageresponse::curname=''; 625: sub start_foil { 626: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 627: my $result; 628: if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' || 629: $target eq 'analyze' || $target eq 'answer') { 630: my $name = &Apache::lonxml::get_param('name',$parstack,$safeeval); 631: if ($name eq "") { 632: &Apache::lonxml::warning(&mt('Foils without names exist. This can cause problems to malfunction.')); 633: $name=$Apache::lonxml::curdepth; 634: } 635: if (defined($Apache::response::foilnames{$name})) { 636: &Apache::lonxml::error(&mt("Foil name [_1] appears more than once. Foil names need to be unique." 637: ,'<b><tt>'.$name.'</tt></b>')); 638: } 639: $Apache::response::foilnames{$name}++; 640: if ( $Apache::imageresponse::conceptgroup 641: && !&Apache::response::showallfoils() 642: ) { 643: push(@{ $Apache::response::conceptgroup{'names'} }, $name); 644: } else { 645: push(@{ $Apache::response::foilgroup{'names'} }, $name); 646: } 647: $Apache::imageresponse::curname=$name; 648: } elsif ($target eq 'edit') { 649: $result = &Apache::edit::tag_start($target,$token); 650: $result .= &Apache::edit::text_arg('Name:','name',$token); 651: $result .= &Apache::edit::end_row(). 652: &Apache::edit::start_spanning_row(); 653: } elsif ($target eq 'modified') { 654: my $constructtag=&Apache::edit::get_new_args($token,$parstack, 655: $safeeval,'name'); 656: if ($constructtag) { $result = &Apache::edit::rebuild_tag($token); } 657: } 658: return $result;; 659: } 660: 661: sub end_foil { 662: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 663: my $result; 664: if ($target eq 'edit') { 665: $result=&Apache::edit::end_table(); 666: } 667: return $result; 668: } 669: 670: sub start_text { 671: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 672: my $result=''; 673: if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze' 674: || $target eq 'answer') { 675: &Apache::lonxml::startredirection; 676: } elsif ($target eq 'edit') { 677: my $descr=&Apache::lonxml::get_all_text('/text',$parser,$style); 678: $result=&Apache::edit::tag_start($target,$token,'Task Description'). 679: &Apache::edit::editfield($token->[1],$descr,'Text',60,2). 680: &Apache::edit::end_row(); 681: } elsif ($target eq "modified") { 682: $result=$token->[4].&Apache::edit::modifiedfield('/text',$parser); 683: } 684: return $result; 685: } 686: 687: sub end_text { 688: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 689: my $result; 690: if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze' 691: || $target eq 'answer') { 692: my $name = $Apache::imageresponse::curname; 693: if ( $Apache::imageresponse::conceptgroup 694: && !&Apache::response::showallfoils() 695: ) { 696: $Apache::response::conceptgroup{"$name.text"} = &Apache::lonxml::endredirection; 697: } else { 698: $Apache::response::foilgroup{"$name.text"} = &Apache::lonxml::endredirection; 699: } 700: } elsif ($target eq 'edit') { 701: $result=&Apache::edit::end_table(); 702: } 703: return $result; 704: } 705: 706: sub start_image { 707: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 708: my $result=''; 709: my $only = join(',',&Apache::loncommon::filecategorytypes('Pictures')); 710: if ($target eq 'web' || $target eq 'tex' || $target eq 'analyze' 711: || $target eq 'answer') { 712: &Apache::lonxml::startredirection; 713: } elsif ($target eq 'edit') { 714: my $bgimg=&Apache::lonxml::get_all_text('/image',$parser,$style); 715: $Apache::edit::bgimgsrc=$bgimg; 716: $Apache::edit::bgimgsrcdepth=$Apache::lonxml::curdepth; 717: 718: $result=&Apache::edit::tag_start($target,$token,'Clickable Image'). 719: &Apache::edit::editline($token->[1],$bgimg,'Image Source File',40); 720: $result.=&Apache::edit::browse(undef,'textnode',undef,$only).' '; 721: $result.=&Apache::edit::search(undef,'textnode'). 722: &Apache::edit::end_row(); 723: } elsif ($target eq "modified") { 724: $result=$token->[4].&Apache::edit::modifiedfield('/image',$parser); 725: } 726: return $result; 727: } 728: 729: sub end_image { 730: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 731: my $result; 732: my $name = $Apache::imageresponse::curname; 733: if ($target eq 'web' || $target eq 'answer') { 734: my $image = &Apache::lonxml::endredirection(); 735: &Apache::lonxml::debug("original image is $image"); 736: if ( $Apache::imageresponse::conceptgroup 737: && !&Apache::response::showallfoils() 738: ) { 739: $Apache::response::conceptgroup{"$name.image"} = $image; 740: } else { 741: $Apache::response::foilgroup{"$name.image"} = $image; 742: } 743: } elsif ($target eq 'analyze') { 744: my $image = &Apache::lonxml::endredirection(); 745: if ( $Apache::imageresponse::conceptgroup 746: && !&Apache::response::showallfoils() 747: ) { 748: $Apache::response::conceptgroup{"$name.image"} = $image; 749: } else { 750: $Apache::response::foilgroup{"$name.image"} = $image; 751: } 752: } elsif ($target eq 'edit') { 753: $result=&Apache::edit::end_table(); 754: } elsif ($target eq 'tex') { 755: my $src = &Apache::lonxml::endredirection(); 756: 757: # There may be all sorts of whitespace on fore and aft: 758: 759: $src =~ s/\s+$//s; 760: $src =~ s/^\s+//s; 761: 762: # 763: # Gnuplot e.g. just generates the latex to put inplace. 764: # 765: my $graphinclude; 766: if ($src =~ /^%DYNAMICIMAGE/) { 767: # This is needed because the newline is not always passed -> tex. 768: # At present we don't care about the sizing info. 769: 770: my ($commentline, $restofstuff) = split(/\n/, $src); 771: $graphinclude = $src; 772: $graphinclude =~ s/^$commentline//; 773: } elsif (!($src =~ /\\/)) { 774: my ($path,$file) = &Apache::londefdef::get_eps_image($src); 775: my ($height_param,$width_param)= 776: &Apache::londefdef::image_size($src,0.3,$parstack,$safeeval); 777: $graphinclude = '\graphicspath{{'.$path.'}}\includegraphics[width='.$width_param.' mm]{'.$file.'}'; 778: } else { 779: $graphinclude = $src; # Already fully formed. 780: } 781: $Apache::response::foilgroup{"$name.image"} ='\vskip 0 mm \noindent '.$graphinclude; 782: } 783: return $result; 784: } 785: 786: sub start_rectangle { 787: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 788: my $result=''; 789: if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' || 790: $target eq 'analyze' || $target eq 'answer') { 791: &Apache::lonxml::startredirection; 792: } elsif ($target eq 'edit') { 793: my $coords=&Apache::lonxml::get_all_text('/rectangle',$parser,$style); 794: $result=&Apache::edit::tag_start($target,$token,'Rectangle'). 795: &Apache::edit::editline($token->[1],$coords,'Coordinate Pairs',40). 796: &Apache::edit::entercoord(undef,'textnode',undef,undef,'box'). 797: &Apache::edit::end_row(); 798: } elsif ($target eq "modified") { 799: &Apache::edit::deletecoorddata(); 800: $result=$token->[4].&Apache::edit::modifiedfield('/rectangle',$parser); 801: } 802: return $result; 803: } 804: 805: sub grade_rectangle { 806: my ($spec,$x,$y) = @_; 807: &Apache::lonxml::debug("Spec is $spec"); 808: my ($x1,$y1,$x2,$y2)=($spec=~m/rectangle:$([0-9]+),([0-9]+)$\-$([0-9]+),([0-9]+)$/); 809: &Apache::lonxml::debug("Point $x1,$y1,$x2,$y2"); 810: if ($x1 > $x2) { my $temp=$x1;$x1=$x2;$x2=$temp; } 811: if ($y1 > $y2) { my $temp=$y1;$y1=$y2;$y2=$temp; } 812: if (($x >= $x1) && ($x <= $x2) && ($y >= $y1) && ($y <= $y2)) { 813: return 'APPROX_ANS'; 814: } 815: return 'INCORRECT'; 816: } 817: 818: sub end_rectangle { 819: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 820: my $result; 821: if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' || 822: $target eq 'analyze' || $target eq 'answer') { 823: my $name = $Apache::imageresponse::curname; 824: my $area = &Apache::lonxml::endredirection; 825: $area=~s/\s//g; 826: &Apache::lonxml::debug("out is $area for $name"); 827: if ( $Apache::imageresponse::conceptgroup 828: && !&Apache::response::showallfoils() 829: ) { 830: push @{ $Apache::response::conceptgroup{"$name.area"} },"rectangle:$area"; 831: } else { 832: push @{ $Apache::response::foilgroup{"$name.area"} },"rectangle:$area"; 833: } 834: } elsif ($target eq 'edit') { 835: $result=&Apache::edit::end_table(); 836: } 837: return $result; 838: } 839: 840: sub start_polygon { 841: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 842: my $result=''; 843: if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' || 844: $target eq 'analyze' || $target eq 'answer') { 845: &Apache::lonxml::startredirection; 846: } elsif ($target eq 'edit') { 847: my $coords=&Apache::lonxml::get_all_text('/polygon',$parser,$style); 848: $result=&Apache::edit::tag_start($target,$token,'Polygon'). 849: &Apache::edit::editline($token->[1],$coords,'Coordinate list',40). 850: &Apache::edit::entercoord(undef,'textnode',undef,undef,'polygon'). 851: &Apache::edit::end_row(); 852: } elsif ($target eq "modified") { 853: $result=$token->[4].&Apache::edit::modifiedfield('/polygon',$parser); 854: } 855: return $result; 856: } 857: 858: sub grade_polygon { 859: my ($spec,$x,$y) = @_; 860: &Apache::lonxml::debug("Spec is $spec"); 861: $spec=~s/^polygon://; 862: my @polygon; 863: foreach my $coord (split('-',$spec)) { 864: my ($x,$y)=($coord=~m/$([0-9]+),([0-9]+)$/); 865: &Apache::lonxml::debug("x $x y $y"); 866: push @polygon, {'x'=>$x,'y'=>$y}; 867: } 868: #make end point start point 869: push @polygon, $polygon[0]; 870: # cribbed from 871: # http://geometryalgorithms.com/Archive/algorithm_0103/algorithm_0103.htm 872: my $crossing = 0; # the crossing number counter 873: 874: # loop through all edges of the polygon 875: for (my $i=0; $i<$#polygon; $i++) { # edge from V[i] to V[i+1] 876: if ((($polygon[$i]->{'y'} <= $y) 877: && ($polygon[$i+1]->{'y'} > $y)) # an upward crossing 878: || 879: (($polygon[$i]->{'y'} > $y) 880: && ($polygon[$i+1]->{'y'} <= $y))) { # a downward crossing 881: # compute the actual edge-ray intersect x-coordinate 882: my $vt = ($y - $polygon[$i]->{'y'}) 883: / ($polygon[$i+1]->{'y'} - $polygon[$i]->{'y'}); 884: if ($x < $polygon[$i]->{'x'} + $vt * 885: ($polygon[$i+1]->{'x'} - $polygon[$i]->{'x'})) { # x<intersect 886: $crossing++; # a valid crossing of y=P.y right of P.x 887: } 888: } 889: } 890: 891: # 0 if even (out), and 1 if odd (in) 892: if ($crossing%2) { 893: return 'APPROX_ANS'; 894: } else { 895: return 'INCORRECT'; 896: } 897: } 898: 899: sub end_polygon { 900: my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_; 901: my $result; 902: if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' || 903: $target eq 'analyze' || $target eq 'answer') { 904: my $name = $Apache::imageresponse::curname; 905: my $area = &Apache::lonxml::endredirection; 906: $area=~s/\s*//g; 907: &Apache::lonxml::debug("out is $area for $name"); 908: if ( $Apache::imageresponse::conceptgroup 909: && !&Apache::response::showallfoils() 910: ) { 911: push @{ $Apache::response::conceptgroup{"$name.area"} },"polygon:$area"; 912: } else { 913: push @{ $Apache::response::foilgroup{"$name.area"} },"polygon:$area"; 914: } 915: } elsif ($target eq 'edit') { 916: $result=&Apache::edit::end_table(); 917: } 918: return $result; 919: } 920: 1; 921: __END__ 922: