#!/usr/bin/perl
use strict;
use File::Copy;
#
#
# "glamine" because you can find in it "image" and "lien"
#         and it sounds like "glamour" and "gamine",
#         two pleasant French words.
#
# by Jean-Baptiste DENIS
#
# (see _DATA_ section (and code) for details)
# 
# 

#
################### variate initialisations #################
#
my $ver = "glamine [0.10; December 16, 2002]";
my ($jour,$mois,$an) = (localtime)[3,4,5];
$mois++; $an = $an + 1900;
my $date = $an."/".$mois."/".$jour;
my $maintenant = localtime;
my $verif = 0;

#
################### defining valid keywords #################
#
my %kw = (image=>1,
          format=>1,
          size=>1,
          table=>1,
          xsplits=>1,
          ysplits=>1,
          fresult=>1,
          dresult=>1,
          url=>1,
         );
my %kwv = (image=>"",
          format=>"png",
          size=>"",
          table=>"3 2",
          xsplits=>"",
          ysplits=>"",
          fresult=>"",
          dresult=>""
         );

my ($urlnb,$fcomponent,@urli,@urlj);

### no parameters
if ($#ARGV < 0) { while (<DATA>) { print; } exit; }

### one or two parameter(s): the parameter file is the first
elsif (($#ARGV == 0) ||($#ARGV == 1)) {
    # decoding the parameters
    my $sep = "/";
    if ($#ARGV == 1) { $sep = $ARGV[1]; } if ($verif) { print "Séparateur = ",$sep,"\n";}
    my $pfile = $ARGV[0];
    my @url = (); my @xsplits = (); my @ysplits = ();
    open (ENTREE,"<$pfile") || die ("The parameter file ".$pfile." was not found!");
    while (<ENTREE>) { 
        if (/^<.+>/) {
	    my $kw = substr($_,1,index($_,">")-1);
            if (exists($kw{$kw})) {
               my $kwv = substr($_,index($_,">")+1);
               chop($kwv); $kwv = &ajuste($kwv);
               if ($kw eq "url") { push @url,$kwv;}
               else { $kwv{$kw} = $kwv;}
               if ($verif) { print $kw," : {",$kwv,"}\n";}
            }
	}
    }
    #
    ### tackling the stored parameters
    #
    # checking the original image
    if ($kwv{image} eq "") { die "you forgot the image file in your parameter file [$pfile]!";}
    open (ESSAI,"<$kwv{image}") || die ("The file ".$kwv{image}." doesn't exist!");
    close(ESSAI);
    # getting the fresult
    if ($kwv{fresult} eq "") {
        $kwv{fresult} = $kwv{image};
        if ($verif) { print $kwv{fresult},"\n";}
        $kwv{fresult} =~ s/.*\///;
        my $ou = rindex($kw{fresult},".");
        $kwv{fresult} = substr($kwv{fresult},0,$ou-3);
        if ($verif) { print $kwv{fresult},"\n";}
        }
    # getting the sizes of the final image
    if ($kwv{size} eq "") { die("For the moment, you must provide the image size!");}
    ($kwv{xsize}, $kwv{ysize}) = split(/ /,$kwv{size});
    if ($verif) { print $kwv{xsize}," & ",$kwv{ysize},"\n";}
    # getting the dimension of the table
    if ($kwv{table} eq "") {
        ($kwv{nrow}, $kwv{ncol}) = (3,2);
        }
    else {
        ($kwv{nrow}, $kwv{ncol}) = split(/ /,$kwv{table});
        }
    if ($verif) { print $kwv{ncol}," et ",$kwv{ncol},"\n";}
    # getting the cutting limits
    if ($kwv{xsplits} eq "") {
        foreach my $k (1..($kwv{ncol}-1)) { push @xsplits,100/$kwv{ncol}*$k; }
        }
    else {
        @xsplits = split(/ /,$kwv{xsplits});
        if (@xsplits != ($kwv{ncol}-1)) {die "bad number of \"xsplits\" with respect to $kwv{ncol}!";}
        }
    if ($kwv{ysplits} eq "") {
        foreach my $k (1..($kwv{nrow}-1)) { push @ysplits,100/$kwv{nrow}*$k; }
        }
    else {
        @ysplits = split(/ /,$kwv{ysplits});
        if (@ysplits != ($kwv{nrow}-1)) {die "bad number of \"ysplits\" with respect to $kwv{nrow}!";}
        }
    foreach (@xsplits,@ysplits) {
        if (($_ > 100) || ($_ < 0)) {die "glamine found a bad percentage separator: ".$_;}
        }
    @xsplits = (0,@xsplits,100);
    @ysplits = (0,@ysplits,100);
    foreach (1..$#xsplits) {$xsplits[$_] = $xsplits[$_]*$kwv{xsize}/100};
    foreach (1..$#ysplits) {$ysplits[$_] = $ysplits[$_]*$kwv{ysize}/100};
    # getting the resulting path + name
    $fcomponent = $kwv{dresult}.$kwv{fresult};
    # working with url's
    $urlnb = 0;
    @urli = (); @urlj = ();
    my @urlu = ();
    my @urlt = ();
    my @urla = ();
    foreach (0..$#url) {
        my $n = $#url - $_;
        my $chai = $url[$n];
        my ($i,$j,$u,$t,$a);
        $a = substr($chai,index($chai,"\"")+1);
        $chai = substr($chai,0,index($chai,"\"")-1);
        $a =~ s/".*$//;
        ($i,$j,$u,$t) = split(/ /,$chai);
        if ($t eq "") { $t = "y";}
        if ($verif) { print join("#",$i,$j,$u,"<",$t,">",$a,$chai),"\n";}
        if ($verif) { print $url[$n],"\n";}
        # must this url be added or not?
        my $oui = &oui($i,$j);
        if ($oui < 0) {
            $urlnb++;
            push @urli,$i;
            push @urlj,$j;
            push @urlu,$u;
            push @urlt,$t;
            push @urla,$a;
            }
        }
    foreach my $s (0..($urlnb - 1)) {
        if ($verif) { print "<",$urli[$s],",",$urlj[$s],"> : ",$urlu[$s],"\n";}
        }
    # must ImageMagick be used?
#    my $im; 
#    if ($#ARGV == 0) { $im = 1; require ImageMagick; } 
#    else             { $im = 0;}
    print "<<< In this version the internal use of ImageMagick is not yet implemented! >>>\n";

    #
    ### preparing the file for outside use of ImageMagick
    #
    open(FAIT,">fait.bat") || die("cannot open file \"fait.bat\"\n");
    # loop for rows
    if ($verif) { print "\@xsplits: ",join(" ~ ",@xsplits),"\n";}
    if ($verif) { print "\@ysplits: ",join(" ~ ",@ysplits),"\n";}
    my ($yos,$ywi,$xos,$xwi);
    foreach my $nrow (1..$kwv{nrow}) {
        $ywi = ($ysplits[$nrow]-$ysplits[$nrow-1]);
        $yos = $ysplits[$nrow-1];
        # loop for columns
        foreach my $ncol (1..$kwv{ncol}) {
            $xwi = ($xsplits[$ncol]-$xsplits[$ncol-1]);
            $xos = $xsplits[$ncol-1];
            my $nom = "$fcomponent\.$nrow\.$ncol\.$kwv{format}";
            my $mon = "$fcomponent\.$nrow\.$ncol\.i\.$kwv{format}";
            my $crunch = $xwi."x".$ywi."+".$xos."+".$yos;
            print FAIT "convert -crop $crunch $kwv{image} $nom\n";
            if (&oui($nrow,$ncol) >= 0) {print FAIT "convert -negate $nom $mon\n";}
            }
        }
    close(FAIT);

    #
    ### constructing the html page
    #
    open(HTML,">$fcomponent.html") || die ("cannot open $fcomponent.html!");
    open(HTMM,">$fcomponent.d.html") || die ("cannot open $fcomponent.d.html!");
my $tet1 = "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\"
    \"http://www.w3.org/TR/html4/loose.dtd\">
<html>
<head>
  <meta http-equiv=\"Content-Type\" content=\"text/html\">
  <title>-- $ver --</title>
<script LANGUAGE=\"Javascript\"> 
       <!--;
       var bouton=\"\";
       var fichier=0;
	function initialisation()
       {
         img=new Array();
";
my $tet2 = "	}
       function actif(bouton,fichier){document.images[bouton].src=img[fichier].src}
       //-->;
</script></head><body OnLoad=\"initialisation();\">
<p>&lt;&gt; $fcomponent &lt;&gt;  $date &lt;&gt; $date </p>
<table border=\"";
my $tet3 = "\" cellspacing=\"O\" cellpadding=\"0\">
  <tbody>
";
my $queu = "</table></tbody></body></html>\n";
    &ecrit($tet1);
    foreach my $jd (0..($urlnb-1)) {
        my ($img0,$img1);
        ($img0,$img1) = &fimage($urli[$jd],$urlj[$jd]);
        &ecrit("img[".2*$jd."]=new Image(); img[".2*$jd."].src=\"");
        &ecrit($img0);
        &ecrit("\";\nimg[".(2*$jd+1)."]=new Image(); img[".(2*$jd+1)."].src=\"");
        &ecrit($img1."\";\n");
        }
    &ecrit($tet2);
    print HTML 0;
    print HTMM 1;
    &ecrit($tet3);
    # loop for rows
    foreach my $nrow (1..$kwv{nrow}) {
        print HTML "<tr>\n"; print HTMM "<tr>\n";
        # loop for columns
        foreach my $ncol (1..$kwv{ncol}) {
            &ecrit("<td>");
            my $oui = &oui($nrow,$ncol);
            my ($fmg0,$fmg1);
            ($fmg0,$fmg1) = &fimage($nrow,$ncol);
            if ($oui >= 0) {
                &ecrit("<a href=\"$urlu[$oui]\"");
                &ecrit(" OnMouseOver=\"actif('m$oui',".(1+2*$oui).");\"");
                &ecrit("  OnMouseOut=\"actif('m$oui',".(2*$oui).");\">");
                &ecrit("<img alt=\"$urla[$oui]\"");
                &ecrit(" src=\"$fmg0\" border=0 name=\"m$oui\">");
                &ecrit("</a>");
                }
            else {
                &ecrit("<img alt=\"$fmg0\"");
                &ecrit(" src=\"$fmg0\">");
                }
            &ecrit("</td>\n");
            }
        &ecrit("</tr>\n");
        }
    &ecrit($queu);
    close(HTML); close(HTMM);

    # and that's all
    print " ---- >>> glamine 's finished \n";
    }
### taking them from the command line
else {
    print "glamine ",$ver," must have no or one or two parameter(s):\n";
    print "          no parameter for the help\n";
    print "          first parameter: the parameter file\n";
    }


#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
sub ajuste
{
#DESCRIPTION
# removes spaces at the beginning and end of the string,
# then removes all multiple spaces in one
#KEYWORDS character string
#ARGUMENTS the string to transform
#VALUE the transformed string
#MORE_DETAILS
#SEE_ALSO
#COMMENTS
#FURTHER_PLANS
#AUTHOR J.-B. Denis
#CREATED 2003/12/14
#LAST MODIFIED 2003/12/14
    my $res = $_[0];
    $res =~ s/^ *//;
    $res =~ s/ *$//;
    $res =~ s/ +/ /;
    $res;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>


#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
sub ecrit
{
#DESCRIPTION
# internal function to generate at the same time
# the two files
#KEYWORDS glamine
#ARGUMENTS
#VALUE
#MORE_DETAILS
#SEE_ALSO
#COMMENTS
#FURTHER_PLANS
#AUTHOR J.-B. Denis
#CREATED 2003/12/16
#LAST MODIFIED 2003/12/16
    print HTML $_[0];
    print HTMM $_[0];
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>


#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
sub oui
{
#DESCRIPTION
# general words about the use of the function
#KEYWORDS matrix
#ARGUMENTS
#VALUE
#MORE_DETAILS
#SEE_ALSO
#COMMENTS
#FURTHER_PLANS
#AUTHOR J.-B. Denis
#CREATED 2003/11/11
#LAST MODIFIED
    my $oui = -1;
    foreach my $s (0..($urlnb - 1)) {
        if (($urli[$s] == $_[0]) & ($urlj[$s] == $_[1])) {$oui = $s;}
        }
    $oui;
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

#<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
sub fimage
{
#DESCRIPTION
# returns the two image files for a given cell
#KEYWORDS glamine
#ARGUMENTS
#VALUE
#MORE_DETAILS
#SEE_ALSO
#COMMENTS
#FURTHER_PLANS
#AUTHOR J.-B. Denis
#CREATED 2002/12/16
#LAST MODIFIED 2002/12/16
    my $res0 = $fcomponent.".".$_[0].".".$_[1].".".$kwv{format};
    my $res1 = $fcomponent.".".$_[0].".".$_[1].".i.".$kwv{format};
($res0,$res1);
}
#>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>



__DATA__


                --<<( PROJET "glamine" )>>--

<<<< Introduction >>>>

glamine partitions an image into rectangular pieces obtained by
horizontal and vertical simutaneous splittings, then it reconstitutes
the image through the table of a html page introducing indicated links
to some of them.

<<<< Arguments >>>>

 The number of arguments is important :
 Zero: this introduction is displayed.
 One: it is supposed to be the path of the parameter file and
      ImageMagick is internally used. 
 Two: the first one is supposed to be the path of the parameter file
      and a file named "fait.bat" containing the necessary commands 
      for an outside use of ImageMagick is generated. This intricacy
      was introduced for those who don't have the Perl ImageMagick
      module (for instance myself on my laptop). In that case, the
      second parameter must be the directory separator to be used
      "/" in unix like systems and "\" in dos systems.

 For the moment, the internal use of ImageMagick is not done, so when
 there is one argument, it is equivalent to the case of two arguments
 with the unix directory separator "/"

<<<< Parameter File >>>>

An ascii file. Each line is considered as a free comment except if it
*do begins* with a keyword between "<" and ">". Introducing a space in
the first position turns the line as comment.

The list of keywords is:

<image> ../images/photos.jpg : gives the file name including a
possible path (use "/" separators even under dos. Compulsory.

<format> $img
: suffix indicating the format of the resulting images. Default:
"png", it is not checked. All format dealt by ImageMagick must be valid.

<size> $xsize $ysize
: gives the sizes (in pixels) to be used for the final dimensions of the
image. Default is the values of the image when the ImageMagick Perl module
is used if not it is compulsory... so it is compulsory for the moment.

<table> $nrow $nbcol
: gives the number of rows and columns for the two splitting of the
image. Default is 3 and 2 unless implicitely given by <xsplits> AND
 <ysplits>.

<xsplits> $xs[0] $xs[1] ... $xs[$ncol-2]
: gives by percentages the vertical limits delimiting the $nbcol
columns of the partition. If doesn't exist they are taken with identical
size (default). These values must be comprised between 0 and 100. If
this is not the case or if their number doesn't agree with $ncol, a
error message is displayed and the program stops.

<ysplits> $ys[0] $ys[1] ... $ys[$nrow-2]
: idem that <x.splits> for the $nrow rows

<fresult> $name
:the name of the created files. Default is the first components of the
image file name (photos.jpg -> photos; photo.1.png -> photo.1).

<dresult> $path
: the path where to introduce the resulting file. It must include the
last separating character. For instance $name="resu" and
"$path="../site/" will produce the compound "../site/resu.html" for
the main result file.

<url> $row $col $url [y|n] $comment
: described with an example
<url> 3 2 http://www.w3.org y "Un site très recommandable !"
means that the portion of the image included into the cell of the 3rd
row and 2d column must be linked to "http://www.w3.org" with the
alternate comment "A very commendable site!"
As many <url> as desired can be given. Of course not all cell need
such a link (even no one is possible).
The "y" fifth word is optional, it means that "yes" this portion of
image must be inversed when the mouse is upon it (yes is the default,
put "n" (no) if you don't want it. In fact the "n" is not yet implemented
another type of advertising will be (in future release) any image (to be
croped at the right size...

When a keyword is given redundantly, the last definition is used
without any warning

<<<< resulting files >>>>

$name.html = the main html page
$name.d.html = like the previous but with a slight separation between the
         cell to see the result
$name.$row.$col.$img = the small images composing the big image
$name.$row.$col.i.$img = the same but inversed...

<<<< future >>>>

 Incorporate the ImageMagick Perl module (one argument use of glamine)
 Offer any kind of image instead of inverting the active area

<<<< and >>>>

Toutes suggestions, réactions, commentaires seront appréciés, merci de
les envoyer à "jbdenis@jouy.inra.fr".