[LON-CAPA-cvs] cvs: doc /loncapafiles loncapafiles.lpml loncom/homework edit.pm imagechoice.pm imageresponse.pm randomlylabel.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Fri, 09 Jan 2004 23:22:20 -0000
This is a MIME encoded message
--albertel1073690540
Content-Type: text/plain
albertel Fri Jan 9 18:22:20 2004 EDT
Added files:
/loncom/homework imagechoice.pm
Modified files:
/loncom/homework edit.pm imageresponse.pm randomlylabel.pm
/doc/loncapafiles loncapafiles.lpml
Log:
- polygonal correct areas in an image now allowed
- imagechoice.pl changed to imagechoice.pm (while I converted the code for handling the box and single point case I haven;'t tested them and I haven't yet converted the edit code to try to use it, maybe later tonight unless I do some woodworking instead)
- imagechoice now shows you were you have clicked on the image when doing polygonal selection,
--albertel1073690540
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20040109182220.txt"
Index: loncom/homework/edit.pm
diff -u loncom/homework/edit.pm:1.74 loncom/homework/edit.pm:1.75
--- loncom/homework/edit.pm:1.74 Thu Dec 18 14:59:24 2003
+++ loncom/homework/edit.pm Fri Jan 9 18:22:18 2004
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# edit mode helpers
#
-# $Id: edit.pm,v 1.74 2003/12/18 19:59:24 albertel Exp $
+# $Id: edit.pm,v 1.75 2004/01/09 23:22:18 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -764,6 +764,35 @@
<a href="/cgi-bin/imagechoice.pl?mode=pair&formname=$form&file=$bgfile$formheight$formwidth&formcoord=$element"
target="imagechoice">Click Coordinate Pair</a>
ENDBUTTON
+ return $result;
+}
+
+# coordinate polygon (x1,y1)-(x2,y2)...
+sub entercoordpolygon {
+ my ($id,$mode,$width,$height) = @_;
+ unless ($Apache::edit::bgimgsrc) { return ''; }
+ my $bgfile=&Apache::lonnet::escape($Apache::edit::bgimgsrc);
+ my $form = 'lonhomework';
+ my $element;
+ if (! defined($mode) || $mode eq 'attribute') {
+ $element = &Apache::lonnet::escape("$id\_$Apache::lonxml::curdepth");
+ } elsif ($mode eq 'textnode') { # for data between <tag> ... </tag>
+ $element = &Apache::lonnet::escape('homework_edit_'.
+ $Apache::lonxml::curdepth);
+ }
+ my $id=&Apache::loncommon::get_cgi_id();
+ my %data=("cgi.$id.mode" =>'polygon',
+ "cgi.$id.formname" =>$form,
+ "cgi.$id.file" =>$bgfile,
+ "cgi.$id.formcoord" =>$element);
+ if ($height) {
+ $data{"cgi.$id.formheight"}=$height.'_'.$Apache::edit::bgimgsrccurdepth;
+ }
+ if ($width) {
+ $data{"cgi.$id.formwidth"}=$width.'_'.$Apache::edit::bgimgsrccurdepth;
+ }
+ &Apache::lonnet::appenv(%data);
+ my $result='<a href="/adm/imagechoice?token='.$id.'" target="imagechoice">Create Polygon Data</a>';
return $result;
}
#----------------------------------------------------- browse
Index: loncom/homework/imageresponse.pm
diff -u loncom/homework/imageresponse.pm:1.42 loncom/homework/imageresponse.pm:1.43
--- loncom/homework/imageresponse.pm:1.42 Mon Nov 10 19:39:33 2003
+++ loncom/homework/imageresponse.pm Fri Jan 9 18:22:19 2004
@@ -1,7 +1,8 @@
+
# The LearningOnline Network with CAPA
# image click response style
#
-# $Id: imageresponse.pm,v 1.42 2003/11/11 00:39:33 albertel Exp $
+# $Id: imageresponse.pm,v 1.43 2004/01/09 23:22:19 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -42,7 +43,9 @@
my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
my $result;
#when in a radiobutton response use these
- &Apache::lonxml::register('Apache::imageresponse',('foilgroup','foil','text','image','rectangle','conceptgroup'));
+ &Apache::lonxml::register('Apache::imageresponse',
+ ('foilgroup','foil','text','image','rectangle',
+ 'polygon','conceptgroup'));
push (@Apache::lonxml::namespace,'imageresponse');
my $id = &Apache::response::start_response($parstack,$safeeval);
if ($target eq 'meta') {
@@ -136,13 +139,22 @@
my $extrawidth = 2;
my @areas = @{ $Apache::response::foilgroup{"$name.area"} };
foreach my $area (@areas) {
- my ($x1,$y1,$x2,$y2)=
- ($area=~m/rectangle:\(([0-9]+),([0-9]+)\)\-\(([0-9]+),([0-9]+)\)/);
- my $i=$x{"cgi.$id.BOXCOUNT"}++;
- $x{"cgi.$id.BOX$i"}=join(':',($x1,$y1,$x2,$y2,"FFFFFF",
- ($width+$extrawidth)));
- $i=$x{"cgi.$id.BOXCOUNT"}++;
- $x{"cgi.$id.BOX$i"}=join(':',($x1,$y1,$x2,$y2,"00FF00",$width));
+ if ($area=~/^rectangle:/) {
+ my ($x1,$y1,$x2,$y2)=
+ ($area=~m/rectangle:\(([0-9]+),([0-9]+)\)\-\(([0-9]+),([0-9]+)\)/);
+ my $i=$x{"cgi.$id.BOXCOUNT"}++;
+ $x{"cgi.$id.BOX$i"}=join(':',($x1,$y1,$x2,$y2,"FFFFFF",
+ ($width+$extrawidth)));
+ $i=$x{"cgi.$id.BOXCOUNT"}++;
+ $x{"cgi.$id.BOX$i"}=join(':',($x1,$y1,$x2,$y2,"00FF00",$width));
+ } elsif ($area=~/^polygon:(.*)/) {
+ my $i=$x{"cgi.$id.POLYCOUNT"}++;
+ $x{"cgi.$id.POLYOPT$i"}=join(':',("FFFFFF",($width+$extrawidth)));
+ $x{"cgi.$id.POLY$i"}=$1;
+ $i=$x{"cgi.$id.POLYCOUNT"}++;
+ $x{"cgi.$id.POLYOPT$i"}=join(':',("00FF00",$width));
+ $x{"cgi.$id.POLY$i"}=$1;
+ }
}
}
&Apache::lonnet::appenv(%x);
@@ -211,6 +223,8 @@
&Apache::lonxml::debug("Area of type $1");
if ($1 eq 'rectangle') {
$grade=&grade_rectangle($area,$x,$y);
+ } elsif ($1 eq 'polygon') {
+ $grade=&grade_polygon($area,$x,$y);
} else {
&Apache::lonxml::error("Unknown area style $area");
}
@@ -486,11 +500,7 @@
sub grade_rectangle {
my ($spec,$x,$y) = @_;
&Apache::lonxml::debug("Spec is $spec");
- $spec=~m/rectangle:\(([0-9]+),([0-9]+)\)\-\(([0-9]+),([0-9]+)\)/;
- my $x1=$1;
- my $y1=$2;
- my $x2=$3;
- my $y2=$4;
+ my ($x1,$y1,$x2,$y2)=($spec=~m/rectangle:\(([0-9]+),([0-9]+)\)\-\(([0-9]+),([0-9]+)\)/);
&Apache::lonxml::debug("Point $x1,$y1,$x2,$y2");
if ($x1 > $x2) { my $temp=$x1;$x1=$x2;$x2=$temp; }
if ($y1 > $y2) { my $temp=$y1;$y1=$y2;$y2=$temp; }
@@ -513,6 +523,85 @@
push @{ $Apache::response::conceptgroup{"$name.area"} },"rectangle:$area";
} else {
push @{ $Apache::response::foilgroup{"$name.area"} },"rectangle:$area";
+ }
+ } elsif ($target eq 'edit') {
+ $result=&Apache::edit::end_table();
+ }
+ return $result;
+}
+
+sub start_polygon {
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
+ my $result='';
+ if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' ||
+ $target eq 'analyze') {
+ &Apache::lonxml::startredirection;
+ } elsif ($target eq 'edit') {
+ my $coords=&Apache::lonxml::get_all_text('/polygon',$parser);
+ $result=&Apache::edit::tag_start($target,$token,'Polygon').
+ &Apache::edit::editline($token->[1],$coords,'Coordinate list',40).
+ &Apache::edit::entercoordpolygon(undef,'textnode').
+ &Apache::edit::end_row();
+ } elsif ($target eq "modified") {
+ $result=$token->[4].&Apache::edit::modifiedfield('/polygon',$parser);
+ }
+ return $result;
+}
+
+sub grade_polygon {
+ my ($spec,$x,$y) = @_;
+ &Apache::lonxml::debug("Spec is $spec");
+ $spec=~s/^polygon://;
+ my @polygon;
+ foreach my $coord (split('-',$spec)) {
+ my ($x,$y)=($coord=~m/\(([0-9]+),([0-9]+)\)/);
+ &Apache::lonxml::debug("x $x y $y");
+ push @polygon, {'x'=>$x,'y'=>$y};
+ }
+ #make end point start point
+ push @polygon, $polygon[0];
+ # cribbed from
+ # http://geometryalgorithms.com/Archive/algorithm_0103/algorithm_0103.htm
+ my $crossing = 0; # the crossing number counter
+
+ # loop through all edges of the polygon
+ for (my $i=0; $i<$#polygon; $i++) { # edge from V[i] to V[i+1]
+ if ((($polygon[$i]->{'y'} <= $y)
+ && ($polygon[$i+1]->{'y'} > $y)) # an upward crossing
+ ||
+ (($polygon[$i]->{'y'} > $y)
+ && ($polygon[$i+1]->{'y'} <= $y))) { # a downward crossing
+ # compute the actual edge-ray intersect x-coordinate
+ my $vt = ($y - $polygon[$i]->{'y'})
+ / ($polygon[$i+1]->{'y'} - $polygon[$i]->{'y'});
+ if ($x < $polygon[$i]->{'x'} + $vt *
+ ($polygon[$i+1]->{'x'} - $polygon[$i]->{'x'})) { # x<intersect
+ $crossing++; # a valid crossing of y=P.y right of P.x
+ }
+ }
+ }
+
+ # 0 if even (out), and 1 if odd (in)
+ if ($crossing%2) {
+ return 'APPROX_ANS';
+ } else {
+ return 'INCORRECT';
+ }
+}
+
+sub end_polygon {
+ my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style)=@_;
+ my $result;
+ if ($target eq 'web' || $target eq 'grade' || $target eq 'tex' ||
+ $target eq 'analyze') {
+ my $name = $Apache::imageresponse::curname;
+ my $area = &Apache::lonxml::endredirection;
+ &Apache::lonxml::debug("out is $area for $name");
+ if ( $Apache::imageresponse::conceptgroup
+ && !&Apache::response::showallfoils()) {
+ push @{ $Apache::response::conceptgroup{"$name.area"} },"polygon:$area";
+ } else {
+ push @{ $Apache::response::foilgroup{"$name.area"} },"polygon:$area";
}
} elsif ($target eq 'edit') {
$result=&Apache::edit::end_table();
Index: loncom/homework/randomlylabel.pm
diff -u loncom/homework/randomlylabel.pm:1.12 loncom/homework/randomlylabel.pm:1.13
--- loncom/homework/randomlylabel.pm:1.12 Mon Nov 10 19:39:33 2003
+++ loncom/homework/randomlylabel.pm Fri Jan 9 18:22:19 2004
@@ -2,7 +2,7 @@
# The LearningOnline Network with CAPA
# randomlabel.png: composite together text and images into 1 image
#
-# $Id: randomlylabel.pm,v 1.12 2003/11/11 00:39:33 albertel Exp $
+# $Id: randomlylabel.pm,v 1.13 2004/01/09 23:22:19 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -34,7 +34,8 @@
use Image::Magick;
use Apache::Constants qw(:common);
use Apache::loncommon();
-use GD;
+use GD();
+use GD::Polyline();
sub get_image {
my ($imgsrc,$set_trans)=@_;
@@ -84,7 +85,7 @@
}
my $height=GD::Font->Giant->height;
for(my $i=0;$i<$ENV{"cgi.$id.COUNT"};$i++) {
- $image->string(gdGiantFont,$ENV{"cgi.$id.X$i"},
+ $image->string(GD::gdGiantFont,$ENV{"cgi.$id.X$i"},
$ENV{"cgi.$id.Y$i"}-$height,
&Apache::lonnet::unescape($ENV{"cgi.$id.LB$i"}),$black);
}
@@ -111,6 +112,30 @@
}
$image->setThickness($width);
$image->rectangle($x1,$y1,$x2,$y2,$imcolor);
+ }
+ for(my $i=0;$i<$ENV{"cgi.$id.POLYCOUNT"};$i++) {
+ my ($color,$width,$open)=split(':',$ENV{"cgi.$id.POLYOPT$i"});
+ my (undef,$red,undef,$green,undef,$blue)=split(/(..)/,$color);
+ $red=hex($red);$green=hex($green);$blue=hex($blue);
+ my $imcolor;
+ if (!($imcolor = $image->colorResolve($red,$green,$blue))) {
+ $imcolor = $image->colorClosestHWB($red,$green,$blue);
+ }
+ my $polygon;
+ if ($open) {
+ $polygon = new GD::Polyline;
+ } else {
+ $polygon = new GD::Polygon;
+ }
+ foreach my $coord (split('-',$ENV{"cgi.$id.POLY$i"})) {
+ my ($x,$y)=($coord=~m/\(([0-9]+),([0-9]+)\)/);
+ $polygon->addPt($x,$y);
+ }
+ if ($open) {
+ $image->polydraw($polygon,$imcolor);
+ } else {
+ $image->polygon($polygon,$imcolor);
+ }
}
$image->setThickness(1);
$r->print($image->png);
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.317 doc/loncapafiles/loncapafiles.lpml:1.318
--- doc/loncapafiles/loncapafiles.lpml:1.317 Thu Jan 8 20:01:37 2004
+++ doc/loncapafiles/loncapafiles.lpml Fri Jan 9 18:22:19 2004
@@ -2,7 +2,7 @@
"http://lpml.sourceforge.net/DTD/lpml.dtd">
<!-- loncapafiles.lpml -->
-<!-- $Id: loncapafiles.lpml,v 1.317 2004/01/09 01:01:37 www Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.318 2004/01/09 23:22:19 albertel Exp $ -->
<!--
@@ -3367,6 +3367,14 @@
<categoryname>handler</categoryname>
<description>
Handler for compositing images, and text together.
+</description>
+</file>
+<file>
+<source>loncom/homework/imagechoice.pm</source>
+<target dist='default'>home/httpd/lib/perl/Apache/imagechoice.pm</target>
+<categoryname>handler</categoryname>
+<description>
+Handler for picking out locations on an image.
</description>
</file>
<file>
Index: loncom/homework/imagechoice.pm
+++ loncom/homework/imagechoice.pm
# $Id: imagechoice.pm,v 1.1 2004/01/09 23:22:19 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/cgi-bin/plot.gif
#
# http://www.lon-capa.org/
#
package Apache::imagechoice;
use strict;
use Apache::Constants qw(:common :http);
#
# Single coordinate, defined - store it
#
sub closewindow {
my ($r,$output,$filename)=@_;
$r->print(<<"ENDSUBM");
<html>
<script>
function submitthis() {
$output
self.close();
}
</script>
<body bgcolor="#FFFFFF" onLoad="submitthis()">
<h3>Position Selected</h3>
<img name="pickimg" src="$filename" />
</body>
</html>
ENDSUBM
}
sub storedata {
my ($r,$mode,$filename,$id)=@_;
my (undef,@coords)=split(':',$ENV{"cgi.$id.coords"});
my $output;
if ($ENV{"cgi.$id.formwidth"}) {
$output.='opener.document.forms.'.$ENV{"cgi.$id.formname"}.'.'.$ENV{"cgi.$id.formwidth"}.'.value=document.pickimg.width;';
}
if ($ENV{"cgi.$id.formheight"}) {
$output.='opener.document.forms.'.$ENV{"cgi.$id.formname"}.'.'.$ENV{"cgi.$id.formheight"}.'.value=document.pickimg.height;';
}
if ((defined($ENV{"cgi.$id.x"})) && (defined($ENV{"cgi.$id.y"})) &&
($mode ne 'pairtwo') && ($mode ne 'pairthree')) {
my $output='';
if ($ENV{"cgi.$id.formx"}) {
$output.='opener.document.forms.'.$ENV{"cgi.$id.formname"}.'.'.$ENV{"cgi.$id.formx"}.
'.value='.$ENV{"cgi.$id.x"}.';';
}
if ($ENV{"cgi.$id.formy"}) {
$output.='opener.document.forms.'.$ENV{"cgi.$id.formname"}.'.'.$ENV{"cgi.$id.formy"}.
'.value='.$ENV{"cgi.$id.y"}.';';
}
} elsif ($mode eq 'pairthree') {
my $output='';
my $outputpair='('.$ENV{"cgi.$id.selx"}.','.$ENV{"cgi.$id.sely"}.')-('.$ENV{"cgi.$id.x"}.','.$ENV{"cgi.$id.y"}.')';
if ($ENV{"cgi.$id.formcoord"}) {
$output.='opener.document.forms.'.$ENV{"cgi.$id.formname"}.'.'.$ENV{"cgi.$id.formcoord"}.
'.value="'.$outputpair.'";';
}
} elsif ($mode eq 'polygon') {
my $coordstr;
while (@coords) {
$coordstr.='('.shift(@coords).','.shift(@coords).')-';
}
chop($coordstr);
$output.='opener.document.forms.'.$ENV{"cgi.$id.formname"}.'.'.$ENV{"cgi.$id.formcoord"}.'.value="'.$coordstr.'";';
}
&closewindow($r,$output,$filename);
}
sub getcoord {
my ($r,$mode,$filename,$id)=@_;
my $heading='Position';
my $nextstage='';
if ($mode eq 'pair') {
$heading='First Coordinate';
$nextstage='<input type="hidden" name="mode" value="pairtwo" />';
} elsif ($mode eq 'pairtwo') {
$heading='Second Coordinate';
$nextstage='<input type="hidden" name="mode" value="pairthree" />';
} elsif ($mode eq 'polygon') {
$heading='Enter Coordinate or click finish to close Polygon';
$nextstage='<input type="submit" name="finish" value="Finish" />';
}
$r->print(<<"END");
<html>
<body bgcolor="#FFFFFF">
<h3>Select $heading on Image</h3>
<form method="POST" action="/adm/imagechoice?token=$id">
$nextstage
<input name="image" type="image" src="$filename" />
</form>
</body>
</html>
END
}
sub savecoord {
my ($id)=@_;
if (defined($ENV{"form.image.x"}) && defined($ENV{"form.image.y"})) {
my $data=join(':',($ENV{"cgi.$id.coords"},$ENV{"form.image.x"},
$ENV{"form.image.y"}));
&Apache::lonnet::appenv("cgi.$id.coords"=>$data);
}
}
sub drawX {
my ($imid,$x,$y)=@_;
my %x;
$x{"cgi.$imid.LINECOUNT"}=4;
my $length = 6;
my $width = 1;
my $extrawidth = 2;
$x{"cgi.$imid.LINE0"}=
join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
"FFFFFF",($width+$extrawidth)));
$x{"cgi.$imid.LINE1"}=
join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
"FFFFFF",($width+$extrawidth)));
$x{"cgi.$imid.LINE2"}=
join(':',(($x-$length),($y-$length),($x+$length),($y+$length),
"FF0000",($width)));
$x{"cgi.$imid.LINE3"}=
join(':',(($x-$length),($y+$length),($x+$length),($y-$length),
"FF0000",($width)));
return %x;
}
sub drawPolygon {
my ($id,$imid)=@_;
my (undef,@coords)=split(':',$ENV{"cgi.$id.coords"});
my $coordstr;
while (@coords) {
$coordstr.='('.shift(@coords).','.shift(@coords).')-';
}
chop($coordstr);
my %x;
my $width = 1;
my $extrawidth = 2;
my $i=$x{"cgi.$imid.POLYCOUNT"}++;
$x{"cgi.$imid.POLYOPT$i"}=join(':',("FFFFFF",($width+$extrawidth)),'1');
$x{"cgi.$imid.POLY$i"}=$coordstr;
$i=$x{"cgi.$imid.POLYCOUNT"}++;
$x{"cgi.$imid.POLYOPT$i"}=join(':',("00FF00",$width),'1');
$x{"cgi.$imid.POLY$i"}=$coordstr;
return %x;
}
sub drawimage {
my ($r,$mode,$filename,$id)=@_;
my $imid=&Apache::loncommon::get_cgi_id();
my (undef,@coords)=split(':',$ENV{"cgi.$id.coords"});
if (scalar(@coords) < 2) { return $filename; }
$filename=&Apache::lonnet::filelocation('',$filename);
my %data;
$data{"cgi.$imid.BGIMG"}=$filename;
my $x=@coords[-2];
my $y=@coords[-1];
%data=(%data,&drawX($imid,$x,$y));
if ($mode eq "polygon") { %data=(%data,&drawPolygon($id,$imid)); }
&Apache::lonnet::appenv(%data);
return "/adm/randomlabel.png?token=$imid"
}
sub handler {
my ($r)=@_;
$r->content_type('text/html');
my %data;
my (undef,$id) = split(/=/,$ENV{'QUERY_STRING'});
my $filename = $ENV{"cgi.$id.file"};
my $formname = $ENV{"cgi.$id.formname"};
my $mode=$ENV{"cgi.$id.mode"};
$filename=&Apache::lonnet::unescape($filename);
&savecoord($id);
my $imurl=&drawimage($r,$mode,$filename,$id);
if ($ENV{'form.finish'} eq 'Finish') {
&storedata($r,$mode,$imurl,$id);
}
&getcoord($r,$mode,$imurl,$id);
return OK;
}
1;
__END__
--albertel1073690540--