--- loncom/homework/functionplotresponse.pm 2011/11/21 02:34:58 1.80 +++ loncom/homework/functionplotresponse.pm 2011/11/21 19:48:52 1.81 @@ -1,7 +1,7 @@ # LearningOnline Network with CAPA # Functionplot responses # -# $Id: functionplotresponse.pm,v 1.80 2011/11/21 02:34:58 www Exp $ +# $Id: functionplotresponse.pm,v 1.81 2011/11/21 19:48:52 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -654,10 +654,6 @@ sub start_functionplotrule { } else { $label='R'.$label; } - if ($Apache::functionplotresponse::splineorder{$label}) { - &Apache::lonxml::error(&mt('Rule indices must be unique.')); - } - if ($target eq 'grade') { # Simply remember - in order - for later @@ -772,9 +768,6 @@ sub start_functionplotvectorrule { } else { $label='R'.$label; } - if ($Apache::functionplotresponse::splineorder{$label}) { - &Apache::lonxml::error(&mt('Rule indices must be unique.')); - } if ($target eq 'grade') { # Simply remember - in order - for later @@ -896,9 +889,6 @@ sub start_functionplotvectorsumrule { } else { $label='R'.$label; } - if ($Apache::functionplotresponse::splineorder{$label}) { - &Apache::lonxml::error(&mt('Rule indices must be unique.')); - } if ($target eq 'grade') { # Simply remember - in order - for later my $id=$Apache::inputtags::response[-1]; @@ -1382,6 +1372,22 @@ sub objectcoords { return ($env{'form.HWVAL_'.$id.'_'.$label.'_x'}, $env{'form.HWVAL_'.$id.'_'.$label.'_y'}); } + +sub attached { + my ($id,$vector,$object,$xmin,$xmax,$ymin,$ymax)=@_; + my ($xs,$xe,$ys,$ye)=&vectorcoords($id,$vector); + my ($xo,$yo)=&objectcoords($id,$object); + my $tolx=($xmax-$xmin)/100.; + my $toly=($ymax-$ymin)/100.; + my $tail=0; + my $tip=0; + &addlog("Proximity $vector ($xs,$xe,$ys,$ye) to $object ($xo,$yo)"); + if ((abs($xs-$xo)<$tolx) && (abs($ys-$yo)<$toly)) { $tail=1; } + if ((abs($xe-$xo)<$tolx) && (abs($ye-$yo)<$toly)) { $tip=1; } + &addlog("Result tail:$tail tip:$tip"); + return($tail,$tip); +} + sub vectorangle { my ($x,$y)=@_; @@ -1459,6 +1465,55 @@ sub vectorcheck { return 0; } } + if ($attachpoint ne '') { + &addlog("Checking attached: ".$attachpoint); + my ($tail,$tip)=&attached($id,$vector,$attachpoint,$xmin,$xmax,$ymin,$ymax); + unless ($tail || $tip) { + &setfailed($label); + return 0; + } + } + if ($notattachpoint ne '') { + &addlog("Checking not attached: ".$notattachpoint); + my ($tail,$tip)=&attached($id,$vector,$notattachpoint,$xmin,$xmax,$ymin,$ymax); + if ($tail || $tip) { + &setfailed($label); + return 0; + } + } + if ($tailpoint ne '') { + &addlog("Checking tail: ".$tailpoint); + my ($tail,$tip)=&attached($id,$vector,$tailpoint,$xmin,$xmax,$ymin,$ymax); + unless ($tail) { + &setfailed($label); + return 0; + } + } + if ($nottailpoint ne '') { + &addlog("Checking not tail: ".$nottailpoint); + my ($tail,$tip)=&attached($id,$vector,$nottailpoint,$xmin,$xmax,$ymin,$ymax); + if ($tail) { + &setfailed($label); + return 0; + } + } + if ($tippoint ne '') { + &addlog("Checking tip: ".$tippoint); + my ($tail,$tip)=&attached($id,$vector,$tippoint,$xmin,$xmax,$ymin,$ymax); + unless ($tip) { + &setfailed($label); + return 0; + } + } + if ($nottippoint ne '') { + &addlog("Checking not tip: ".$nottippoint); + my ($tail,$tip)=&attached($id,$vector,$nottippoint,$xmin,$xmax,$ymin,$ymax); + if ($tip) { + &setfailed($label); + return 0; + } + } + &addlog("Rule $label passed."); return 1; }