#!/usr/bin/perl -w
#V4.5

$columns     = 3;
@imgcut      = (800,600); $imgqual   = 50;
@imgtncut    = (300,200); $imgtnqual = 30;

$outfile     = "index.html";
$descrfile   = "descript.ion";
$indextpl    = "index.tpl";
#$frametpl    = "frame.tpl"; # comment out this line if you don't want html frames

$thumbprefix = "_";       # comment out this line if you don't want thumbnails

$lcname      = "file";      # how to mangle mixed-case filenames:
                            # none - no mangling; href - reference only; file - rename file too

$tempfile    = "tempfile.tmp";
$errfile     = "errpipe.tmp";
#$shortname   = "shortnam.tmp";

$cmd_gif     = "C:\\UTIL\\IMAGE\\alchlong.exe \"%src%\" -+ -Xd%X% -Yd%Y% -g %dst% -o";
$cmd_jpg     = "C:\\UTIL\\IMAGE\\alchlong.exe \"%src%\" -+ -Xd%X% -Yd%Y% -jh%comp% \"%dst%\" -o ";

#----------------------------

&read_descr();
&read_templ();

open(OUT,">$outfile") or die "\nCan't open '$outfile' for output\n";

if ( defined $thumbprefix)
{ if ( ($thumbprefix =~ /\/$/) and (not -d $`) )
           { mkdir($`,0644) or die "\nCan't create '$`' directory\n"; }
}

&put_code(@html_head);

@list0=( glob("*.jpg"), glob("*.gif") );

if ( defined $thumbprefix)
{ @list=();
  foreach (@list0) {  if ( not /^$thumbprefix/ ) { push @list,$_; } }
} else { @list=@list0; }

if    ($lcname eq "none") { ; }
elsif ($lcname eq "href" or $lcname eq "file" )
{
  foreach (@list)
  {
    $jpg=lc($_);
    if ($lcname eq "file")
    {
      rename($_,$tempfile) or die "\nCan't rename '$_'->'$tempfile'\n";
      rename($tempfile,$jpg) or die "\nCan't rename '$tempfile'->'$jpg'\n";
    }
    $_=$jpg;
  }
}
else { die "\nUnknown value of 'lcname' parameter\n"; }

$ncol=0; $nrow=0;

for ($i=0; $i<=$#list; $i++)
{
  $jpg=$list[$i];
  $prev=($i>0)?$list[$i-1]:$undef;
  $next=($i<$#list)?$list[$i+1]:$undef;

  print "Processing file '$jpg': ";

  if (exists $descr{lc($jpg)}) { $dsc = $descr{lc($jpg)}; $fn_dsc=$dsc; }
  else                         { $dsc = " ";              $fn_dsc=$jpg; }
  $fname=$jpg;

  if($ncol>=$columns) { &put_code(@html_rowe); $ncol=0; }
  if($ncol==0)        { &put_code(@html_rowb); $nrow++; }
  $ncol++;

  &cut_image($jpg);
  &cut_thumb($jpg) if (defined $thumbprefix);

  $href=$jpg;
  ($X,$Y,$Typ)=get_imgsize($jpg);
  die "Unknown file type" if ($Typ eq Unknown);

  &put_frame();   # It can change $href

  if (defined $thumbprefix)
  {
    $img = $thumbprefix . $jpg;
    ($Xtn,$Ytn) = get_imgsize($img);
  }
  else
  {
    $img = $jpg;
    $Xrat = $X/$imgtncut[0];
    $Yrat = $Y/$imgtncut[1];
    if ($Xrat>$Yrat) { $XYrat=$Xrat; } else { $XYrat=$Yrat; }
    if ($XYrat<1) { $XYrat=1; }
    $Xtn=$X/$XYrat; $Ytn=$Y/$XYrat;
  }

  &put_code(@html_cell);
  print " Ok\n";
}

if ($ncol) { for (;$ncol<$columns;$ncol++) { &put_code(@html_free); } }

&put_code(@html_rowe);

&put_code(@html_foot);

close(OUT);
exit(0);

#----------------------------

sub cut_image
{
  local ($fn) = (@_);
  local ($cmd, $x,$y,$t, $stat,@rc);

  if ( $fn=~/\.gif$/ ) { $cmd=$cmd_gif; } else { $cmd=$cmd_jpg; }

  ($x,$y,$t)=get_imgsize($fn);
  printf("%s[%dx%d]",$t,$x,$y);
  if ($x>$imgcut[0] or $y>$imgcut[1])
  {
    print " cutting";

    $cmd =~ s/%src%/$fn/g;
    $cmd =~ s/%dst%/$tempfile/g;
    $cmd =~ s/%X%/$imgcut[0]/g;
    $cmd =~ s/%Y%/$imgcut[1]/g;
    $cmd =~ s/%comp%/$imgqual/g;
    @rc=execcmd($cmd);

    $stat=0;
    foreach (@rc)
    {
      $stat=1 if ($stat==0 and /^(Coding|Saving) image/);
      $stat=2 if ($stat==1 and /^Success/);
    }
    if ($stat==2)
    {
      unlink($fn) or die "\nCan't remove source file '$fn'\n";
      rename($tempfile,$fn) or die "\nCan't rename 'tempfile'->'$fn'\n";
    }
    else
    {
      print "\nCan't parse Alchemy output:\n";
      foreach (@rc) { print; }
      die;
    }
  }
}


sub cut_thumb
{
  local ($fn) = (@_);
  local ($cmd, $tn, $stat,@rc);
  $tn= $thumbprefix.$fn;

  if (not -e $tn)
  {
    print " thumbing";

    if ( $fn=~/\.gif$/ ) { $cmd=$cmd_gif; } else { $cmd=$cmd_jpg; }

    $cmd =~ s/%src%/$fn/g;
    $cmd =~ s/%dst%/$tempfile/g;
    $cmd =~ s/%X%/$imgtncut[0]/g;
    $cmd =~ s/%Y%/$imgtncut[1]/g;
    $cmd =~ s/%comp%/$imgtnqual/g;
    @rc=&execcmd($cmd);

    $stat=0;
    foreach (@rc)
    {
      $stat=1 if ($stat==0 and /^(Coding|Saving) image/);
      $stat=2 if ($stat==1 and /^Success/);
    }
    if ($stat==2)
    {
      rename($tempfile,$tn) or die "\nCan't rename 'tempfile'->'$tn'\n";
    }
    else
    {
      print "\nCan't parse Alchemy output:\n";
      foreach (@rc) { print; }
      die;
    }
  }
}

#----------------------------

sub read_descr
{
  local ($fn,$dsc);
  if (open(DSC,"$descrfile"))
  {
    foreach (<DSC>)
    {
      chomp; s/\cM//;
      ($fn,$dsc)=split(/ +/,$_,2);
      $dsc =~ tr/������񦧨�����������������������������������������������������/�������������������������������������Ũ��������������������������/;
      $descr{lc($fn)}=$dsc;
    }
    close(DSC);
  }
}


sub read_templ
{
  local ($stat);
  if (defined $frametpl && open(TPL,"$frametpl")) { @frametpl=<TPL>; close(TPL);  }
  open(TPL,"$indextpl") or die "\nCan't open '$indextpl'\n";

  $stat=0;
  foreach (<TPL>)
  {
    if ($stat==0)
    { if (/^%head%/) { $stat=1; next; }
      push @html_head,$_;
    }
    elsif ($stat==1)
    { if    (/^%foot%/) { $stat=2; next; }
      elsif (/^%rowb%/) { push @html_rowb,$'; }
      elsif (/^%rowe%/) { push @html_rowe,$'; }
      elsif (/^%cell%/) { push @html_cell,$'; }
      elsif (/^%free%/) { push @html_free,$'; }
      elsif (/^\s*\cM?\n$/) {  }
      else  { die "\nCan't understand string '$_' of '$indextpl'\n"; }
    }
    elsif   ($stat==2)  { push @html_foot,$_; }
    else
    { die "\nBad stat in read_templ\n"; }
  }
  close(TPL);
}

#----------------------------

sub put_code
{
  local(@txt)=@_;

  foreach (@txt)
  {
    s/%href%/$href/g;
    s/%img%/$img/g;
    s/%dsc%/$dsc/g;
    s/%fname%/$fname/g;
    s/%fn_dsc%/$fn_dsc/g;
    s/%width%/$X/g;
    s/%height%/$Y/g;
    s/%width_tn%/$Xtn/g;
    s/%height_tn%/$Ytn/g;
  }
  foreach (@txt) { print OUT $_; }
}

#----------------------------

sub put_frame
{
  return if (not defined @frametpl);
  local(@txt)=@frametpl;
  local ($pr,$nx);
  local ($regexp)="\.(jpe?g|gif)\$";

  print " frame";

  $href=~s/$regexp/\.html/i;

  if (defined $prev) { $pr=$prev; $pr  =~s/$regexp/\.html/i; } else { $pr="#"; }
  if (defined $next) { $nx=$next; $nx  =~s/$regexp/\.html/i; } else { $nx="#"; }

  foreach (@txt)
  {
    s/%img%/$jpg/g;
    s/%dsc%/$dsc/g;
    s/%fname%/$fname/g;
    s/%fn_dsc%/$fn_dsc/g;
    s/%prev%/$pr/g;
    s/%next%/$nx/g;
    s/%width%/$X/g;
    s/%height%/$Y/g;
  }
  open (HTM,">$href") or die "\nCan't open '$href' file for output\n";
  foreach (@txt) { print HTM $_; }
  close(HTM);
}

#----------------------------

# sub cp
# {
#   local ($fn1,$fn2) = (@_);
#   local ($blk,$s)=("");
#   open (CPIN,"$fn1")   or die "\nCan't copy '$fn1'->'$fn2' (read)\n";
#   open (CPOUT,">$fn2") or die "\nCan't copy '$fn1'->'$fn2' (write)\n";
#   binmode(CPIN);  binmode(CPOUT);
#   for ($s=1; $s>0; )
#   { $s=sysread(CPIN,$blk,4096);
#     syswrite(CPOUT,$blk,$s);
#   }
#   close(CPIN);  close(CPOUT);
# }

#--------------------------------------------------------------------

sub execcmd
{
  local ($cmd) = @_;
  local (@rc);
  open(SAVEERR,">&STDERR");
  open(STDERR,">$errfile");
  open(IN,"$cmd |") or die "\nCan't fork $cmd\n";
  @rc=<IN>;
  close(IN); close(STDERR);
  open(STDERR,">&SAVEERR"); close(SAVEERR);
  open(IN,"$errfile") or die "\nCan't read $errfile\n";
  @rc=(<IN>,@rc); close(IN);
  unlink($errfile);
  return(@rc);
}

#--------------------------------------------------------------------

sub get_imgsize
{
  local ($fn) = @_;
  local ($type,$w,$h);

  local (@sig_gif87) = (0x47,0x49,0x46,0x38,0x37,0x61);
  local (@sig_gif89) = (0x47,0x49,0x46,0x38,0x39,0x61);
  local (@sig_jpeg)  = (0xFF,0xD8,0xFF,0xE0,0x00,0x10,0x4A,0x46,0x49,0x46);
  local (@sig_exif)  = (0xFF,0xD8,0xFF,0xE1,"XX","XX",0x45,0x78,0x69,0x66);
  local (@sig_jjjj)  = (0xFF,0xD8,0xFF);

  open (IN,$fn) or return(-1,-1);
  binmode(IN);

  @inp=&rdarr(16);
  if    ( &cmpa(@sig_gif87) ) { ($type,$w,$h)=("Gif87",&getsizegif()); }
  elsif ( &cmpa(@sig_gif89) ) { ($type,$w,$h)=("Gif89",&getsizegif()); }
  elsif ( &cmpa(@sig_jpeg) )  { ($type,$w,$h)=("JPeg",&getsizejpg());  }
  elsif ( &cmpa(@sig_exif) )  { ($type,$w,$h)=("Exif",&getsizejpg());  }
  elsif ( &cmpa(@sig_jjjj) )  { ($type,$w,$h)=("?JPeg?",&getsizejpg());  }
  else                        { ($type,$w,$h)=("Unknown",-1,-1);       }

  close(IN);
  return($w,$h,$type);
}

#---
sub getsizegif
{
  local (@ar,$w,$h);
  seek IN,6,0;
  @ar=&rdarr(4);
  $w=$ar[1]*256+$ar[0];
  $h=$ar[3]*256+$ar[2];
  return($w,$h);
}

#---
sub getsizejpg
{
  local (@ar,$w,$h);
  # local ($pos);
  seek IN,2,0;
  for(;;)
  {
    @ar=&rdarr(4);
    # $pos=tell(IN); printf "pos=%X ar[]=%2X %2X %2X %2X\n", $pos, $ar[0], $ar[1], $ar[2], $ar[3];
    return(-1,-1)  if ($ar[0] != 0xFF);
    last           if ($ar[1] == 0xC0);
    last           if ($ar[1] == 0xC2);
    seek IN,$ar[2]*256+$ar[3]-2,1;
  }
  @ar=&rdarr(5);
  $w=$ar[3]*256+$ar[4];
  $h=$ar[1]*256+$ar[2];
  return($w,$h);
}

#---
sub cmpa
{
  local $i;
  for($i=0; $i<=$#_; $i++) { if ( $_[$i] ne "XX" && $_[$i] != $inp[$i] ) { return(0) }; }
  return(1);
}

#---
sub rdarr
{
  local($n)=@_;
  local($i,@rez,$d);
  $d="aaa";
  for($i=0; $i<$n; $i++)
  {
    read IN,$d,1;
    $rez[$i]=ord($d);
  }
  return @rez;
}

#--------------------------------------------------------------------