#!/usr/bin/perl

#lgallery.cgi -Save a L system iterated image to the gallery.
#
#---------------------------
#This program 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.
#
#This program 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 this program; if not, write to the Free Software
#Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
#---------------------------
#
#Version: 0.100
#
#Last modified:  1/10
#Written by Jim Lund, jlund256 at gmail dot com
#
#Web site: http://jimlund.org
#---------------------------

use CGI qw(:standard);

#
#Subroutines
#
sub LS_LINK;
sub DRAW_LSYSTEM;


#
#Global variables.
#
my $gallery_dir = '/data/http/html/jiml/lsystem/gallery/';
my $gallery_dir_html = 'gallery/';
my $gallery_html_file = '../jiml/lsystem/gallery.html';
my $rand_seed = 0;
my $ls_width = 150;
my $ls_height = 150;
my $lg_size_multiple = 10/3;
my $gallery_rows = 5;
my $img_type = 'png';
my $tmp_dir = '../temp/';
if ($ENV{'MOD_PERL'}) {
  my ($base_dir) = $ENV{'SCRIPT_FILENAME'} =~ /^(.+\/)[^\/]+$/;
  $tmp_dir = $base_dir.$tmp_dir;
  $gallery_html_file = $base_dir.$gallery_html_file;
}
my $max_color = 33;


my (@comment,$i,$line1,$rest,@page,$new_ls_html,$ok,$gallery_row);


#-------------------------
my $ps_file = <<EOM;
%!PS-Adobe-3.0
%%BoundingBox: 0 0 #ls_width# #ls_height#
%%HiResBoundingBox: 0 0 #ls_width# #ls_height#
%%LanguageLevel: 2
%%Orientation: Portrait
%%Pages: 1

%/Width 144 def /Height 144 def 
%/Xcenter Width 2.0 div def
%/Ycenter Height 2.0 div def

/ColorDict 13 dict def
	ColorDict begin
		(red) [ 1.0 0.0 0.0 0.3 ] def
		(pink) [ 1.0 0.6 0.6 1.0 ] def
		(orange) [ 1.0 0.6 0.0 0.8 ] def
		(yellow) [ 1.0 1.0 0.0 1.0 ] def
		(green) [ 0.0 1.0 0.0 0.5 ] def
		(blue) [ 0.0 0.0 1.0 0.2 ] def
		(cyan) [ 0.0 1.0 1.0 0.7 ] def
		(purple) [ 0.7 0.0 1.0 0.4 ] def
		(white) [ 1.0 1.0 1.0 1.0 ] def
		(gray) [ 0.8 0.8 0.8 0.8 ] def
		(black) [ 0.0 0.0 0.0 0.0 ] def
		(brown) [ 0.35 0.2 0.0 0.2 ] def
		(green2) [ 0.20 0.49 0.176 0.5 ] def
	end

 
%Perl to gernerate color wheel.
%perl -e '@c=(1,0,2);$top=2;@rgb=(0,0,1);$step=0.20;while(@c){printf"\t\t%d [ %2.2f %2.2f %2.2f ] def",++$x,@rgb;if($rgb[$c[0]]<1){$rgb[$c[0]]+=$step;}elsif(int($rgb[$top]*10)){$rgb[$top]-=$step;}else{$top=shift @c;}}'
%
/ColorSet 33 dict def
        ColorSet begin
                0 [ 0.00 0.00 0.00 ] def
                1 [ 0.00 0.00 1.00 ] def
                2 [ 0.00 0.20 1.00 ] def
                3 [ 0.00 0.40 1.00 ] def
                4 [ 0.00 0.60 1.00 ] def
                5 [ 0.00 0.80 1.00 ] def
                6 [ 0.00 1.00 1.00 ] def
                7 [ 0.00 1.00 0.80 ] def
                8 [ 0.00 1.00 0.60 ] def
                9 [ 0.00 1.00 0.40 ] def
                10 [ 0.00 1.00 0.20 ] def
                11 [ 0.00 1.00 0.00 ] def
                12 [ 0.00 1.00 0.00 ] def
                13 [ 0.20 1.00 0.00 ] def
                14 [ 0.40 1.00 0.00 ] def
                15 [ 0.60 1.00 0.00 ] def
                16 [ 0.80 1.00 0.00 ] def
                17 [ 1.00 1.00 0.00 ] def
                18 [ 1.00 0.80 0.00 ] def
                19 [ 1.00 0.60 0.00 ] def
                20 [ 1.00 0.40 0.00 ] def
                21 [ 1.00 0.20 0.00 ] def
                22 [ 1.00 0.00 0.00 ] def
                23 [ 1.00 0.00 0.00 ] def
                24 [ 1.00 0.00 0.20 ] def
                25 [ 1.00 0.00 0.40 ] def
                26 [ 1.00 0.00 0.60 ] def
                27 [ 1.00 0.00 0.80 ] def
                28 [ 1.00 0.00 1.00 ] def
                29 [ 0.80 0.00 1.00 ] def
                30 [ 0.60 0.00 1.00 ] def
                31 [ 0.40 0.00 1.00 ] def
                32 [ 0.20 0.00 1.00 ] def
        end

/SetColor { ColorSet exch get aload pop setrgbcolor } def
               
%Functions to set the color
/CurrentColor 0 def 
/. { max_path currentpoint stroke moveto ColorSet length 1 sub CurrentColor eq { 0 } { CurrentColor 1 add } ifelse /CurrentColor exch store CurrentColor ColorSet exch get aload pop setrgbcolor } def
               
/: { max_path currentpoint stroke moveto 0 CurrentColor eq { ColorSet length 1 sub } { CurrentColor 1 sub } ifelse /CurrentColor exch store CurrentColor ColorSet exch get aload pop setrgbcolor } def
               
               
/- { R_angle neg rotate } bind def 

/+ { R_angle rotate } bind def

/_ { 180 rotate } bind def


%Starter function:
%R_angle order (axiom) Axiom
/Axiom_recurse false def
/Bscale 0 def
/Axiom {
%Axiom_recurse { } if 
	/Axiom_proc exch def
	/order exch store
	/R_angle exch store
        /StartColor exch def
        /CurrentColor StartColor store
	/Yy exch def
	/Xx exch def
        gsave
	Xx Yy moveto
	1 setlinejoin
	1 setlinecap
        CurrentColor SetColor
	0.05 setlinewidth
	Bscale 0 ne 
	{ Xx 2 mul Bscale div abs 0.95 mul Ascale mul dup scale }
	{ 2 order { 2 sqrt div } repeat dup dup scale /Ascale exch def } ifelse
	order Axiom_proc 
	Axiom_recurse 
	{ stroke /Axiom_recurse false store grestore } 
	{ /Axiom_recurse true store
	  
	  max_path grestore
          erasepage Backdrop

	  Xx ll_x ur_x add 2 div sub 
	  Yy ll_y ur_y add 2 div sub 

	  ur_x ll_x sub dup ur_y ll_y sub dup 3 -1 roll 
	  le { pop } { exch pop } ifelse 
          dup 0 eq { pop 1 } if /Bscale exch store 
	  Xx 2 mul Bscale div abs 0.95 mul dup 4 -1 roll mul 3 1 roll mul
	  translate

	  newpath Xx Yy StartColor R_angle order /Axiom_proc load Axiom
	}
	ifelse 
} def


%Store the maximum combined extent of the current path and any 
%previously stored path.
/ur_y false def
/ur_x false def
/ll_y false def
/ll_x false def
/max_path {
  gsave initmatrix pathbbox grestore

  ur_y false eq { /ur_y exch store } { dup ur_y gt { /ur_y exch store } { pop } ifelse } ifelse
  ur_x false eq { /ur_x exch store } { dup ur_x gt { /ur_x exch store } { pop } ifelse } ifelse
  ll_y false eq { /ll_y exch store } { dup ll_y lt { /ll_y exch store } { pop } ifelse } ifelse
  ll_x false eq { /ll_x exch store } { dup ll_x lt { /ll_x exch store } { pop } ifelse } ifelse
} def


/F {} def
/Make_F {
  /F_dup exch def
  /F_proc exch def

  F_dup 0 ne
  {
    /F {
      dup 0 ne
      { 1 sub F_dup {dup} repeat F_proc }
      { 2 0 rlineto }
      ifelse pop
    } store
  }
  {
    /F { 2 0 rlineto } store
  } ifelse
} bind def


/G {} def
/Make_G {
  /G_dup exch def
  /G_proc exch def

  G_dup 0 ne
  {
    /G {
      dup 0 ne
      { 1 sub G_dup {dup} repeat G_proc }
      { 2 0 rlineto }
      ifelse pop
    } store
  }
  {
    /G { 2 0 rlineto } store
  } ifelse
} bind def


/MakeBare_F {
  /F { 2 0 rlineto } store
} bind def


/X {} def
/Make_X {
  /X_dup exch def
  /X_proc exch def
  /X {
  dup 0 ne
  {1 sub X_dup {dup} repeat X_proc }
%  { 2 0 rlineto }
%  ifelse pop
  if pop
  } store
} bind def


/Y {} def
/Make_Y {
  /Y_dup exch def
  /Y_proc exch def
  /Y {
  dup 0 ne
  {1 sub Y_dup {dup} repeat Y_proc }
%  { 2 0 rlineto }
%  ifelse pop
  if pop
  } store
} bind def

/L { gsave gsave max_path stroke grestore } def

/J { grestore } def

%x y size DrawX
/DrawX {
/S exch def
/Y exch def
/Xx exch def
newpath Xx S 2 div sub Y moveto S 0 rlineto stroke
newpath Xx Y S 2 div sub moveto 0 S rlineto stroke
} bind def

/Backdrop {
  Backdrop_color ColorDict exch get aload pop pop setrgbcolor
  0 0 moveto #ls_width# 0 rlineto 0 #ls_height# rlineto #ls_width# -1 mul 0 rlineto closepath fill
} def
EOM
#-------------------------


#
#Send out output without delay.
#
$|=1;

############################################################################
#Main section.
#

#
#Read in form values.
#
my $page_result = new CGI;

$axiom = $page_result->param("a");
 $axiom =~ s/ /+/g;
$f = $page_result->param("f");
 $f =~ s/ /+/g;
$g = $page_result->param("g");
 $g =~ s/ /+/g;
$x = $page_result->param("x");
 $x =~ s/ /+/g;
$y = $page_result->param("y");
 $y =~ s/ /+/g;
$start_color = $page_result->param("z");
$angle = $page_result->param("p");
$recurse = $page_result->param("r");

$iteration = $page_result->param("n");

$history_id = $page_result->param("h");
$history_id =~ s/[^\d]+//g;


#
#Prep comment. Remove trailing whitespace.
#
my $comment = $page_result->param("comment");
$comment=~ s/[\s\n\r]+$//s;
$comment=~ s/\015\012|\012|\015/\n/gs;
$comment=~ s/<.+?>//gs;
chomp $comment;


#
#Load in the existing gallery html.
#
open(FILE,'<'.$gallery_html_file) or warn "Can't open file $gallery_html_file: $!\n";
@page = <FILE>;
close FILE or warn "Warning, error closing $gallery_html_file: $!\n";


#
#Copy the history image to the gallery.
#
system("cp $tmp_dir$history_id.$img_type $gallery_dir$history_id.$img_type");

#Make a strip thumbnail for the history image.
my $strip_width = $ls_width * $gallery_rows;
my $strip_file = $history_id."_thumb.$img_type";
system("convert $gallery_dir$history_id.$img_type -crop ${strip_width}x$ls_width+0+0 -resize ${ls_width}x30! $gallery_dir$strip_file");

#
#Clean input.
#
$iteration=~ s/[^\d]+//g;
$start_color =~ s/[^\d]+//g;
if ($start_color >= $max_color) { $start_color = 0; }

#
#Make up result HTML.
#
my @current_ls = ($axiom, $f, $g, $x, $y, $angle, $recurse, $start_color);
for ($i=0;$i <= $#current_ls;$i++) {$current_ls=~ s/[^\-\d+FGXYLJ\._:]+//g;}


#
#Make the images of the final stage, and save it to the gallery directory.
#
&DRAW_LSYSTEM(\@current_ls,$lg_size_multiple); 
my $final_ls_file = &DRAW_LSYSTEM(\@current_ls);
#print STDERR "file: $final_ls_file\n";


my ($popup_id) = $final_ls_file =~ /^(.+)\..+/;
$new_ls_html="<IMG SRC='$gallery_dir_html$final_ls_file' id='$popup_id' HEIGHT=$ls_height WIDTH=$ls_width BORDER=0>";
$new_ls_html.="<A HREF='$gallery_dir_html$history_id.$img_type'><IMG SRC='$gallery_dir_html$strip_file' HEIGHT=$strip_height WIDTH=$ls_width BORDER=0></A>";
$new_ls_html.="<DIV id='${popup_id}_div'><BR>$comment";

#HTML describing the L system that generates this image.
my $axiom_long = join(" ",split(//,$axiom));
my $f_long = join(" ",split(//,$f));
my $g_long = join(" ",split(//,$g));
my $x_long = join(" ",split(//,$x));
my $y_long = join(" ",split(//,$y));
$new_ls_html.="<BR><DIV class='font2'>Axiom: $axiom_long";
if ($f) { $new_ls_html.="<BR>F -&gt; $f_long"; }
if ($g) { $new_ls_html.="<BR>G -&gt; $g_long"; }
if ($x) { $new_ls_html.="<BR>X -&gt; $x_long"; }
if ($y) { $new_ls_html.="<BR>Y -&gt; $y_long"; }
$new_ls_html.="<BR>Angle: $angle Depth: $recurse</DIV></DIV>";



#
#Add the new image to the gallery.
#Add it in the current row, but if this fails, make a new row and 
#then add it.
#
for ($i=0;$i<=$#page;$i++) {
    if ($page[$i]=~/<TD>&nbsp;<\/TD>/i) {
	$ok=1;
	last;
	}
    }

#
#Add a new row.
#
if (!$ok) {
    $gallery_row='<TR>';
    for ($i=0;$i < $gallery_rows;$i++) {$gallery_row.='<TD>&nbsp;</TD>';}
    $gallery_row.='</TR>';

    for ($i=0;$i<=$#page;$i++) {
	if ($page[$i]=~/<\!-- #row# -->/i) {
	    $page[$i]=~s/(<\!-- #row# -->)/$1\n$gallery_row\n/i;
	    last;
	    }
	}
    }

#
#Add in the new lsystem.
#
for ($i=0;$i<=$#page;$i++) {
    if ($page[$i]=~/<TD>&nbsp;<\/TD>/i) {
	$page[$i]=~s/<TD>&nbsp;<\/TD>/<TD CLASS="font1" ALIGN="center" VALIGN="top">$new_ls_html<\/TD>/i;
	last;
	}
    }


#
#Write out the updated gallery html.
#
open(FILE,'>'.$gallery_html_file) or warn "Can't open file $gallery_html_file: $!\n";
print FILE @page;
close FILE or warn "Warning, error closing $gallery_html_file: $!\n";



#
#Hand off operations to the home page script.
#
my ($current_ls_img_link,$skip)=&LS_LINK($iteration,$history_id,@current_ls);
$current_ls_img_link=~s/draw_ls.cgi/lsystems.cgi/;

print $page_result->redirect($current_ls_img_link);

exit;
#
#End of main section.
#


############################################################################
#Subroutines.
#


############################################################################
#Called by: main
#Calls: none
#
#Generate link that calls the Biomorph drawing script.
#
sub LS_LINK {
my ($iteration,$history_id,@ls) = @_;

($axiom, $f, $g, $x, $y, $angle, $recurse, $start_color) = @ls;

my $new_ls_link="lsystems.cgi?a=$axiom&f=$f&g=$g&x=$x&y=$y&p=$angle&r=$recurse&z=$start_color&n=$iteration&h=$history_id";
$new_ls_link =~ s/&[fgxyz]=(&|$)/$1/g;

my $new_ls_img_link="draw_ls.cgi?a=$axiom&f=$f&g=$g&x=$x&y=$y&p=$angle&r=$recurse&z=$start_color";
$new_ls_img_link =~ s/&[fgxyz]=(&|$)/$1/g;

return($new_ls_link,$new_ls_img_link);
}



############################################################################
#Called by: main
#Calls: none
#
#Draws the L System image.  
#
sub DRAW_LSYSTEM {
my ($ls_ref) = @_;

($axiom, $f, $g, $x, $y, $angle, $recurse, $start_color) = @$ls_ref;

my $ls_width = $ls_width;
my $ls_height = $ls_height;


#
#Background color.
#
my $color = 'white';

#File name describes image.
my $file = "a${axiom}f${f}g${g}x${x}y${y}p${angle}r${recurse}z$start_color.".$img_type;
$file =~ s/z\././;

if ($lg_size_multiple) {
  $file = 'lg_'.$file;
  $ls_width *= $lg_size_multiple;
  $ls_height *= $lg_size_multiple;
}


#If this image already exists return directly.
if (-e $gallery_dir.$file) { return $file; }

my $start_color_ps = $start_color ? $start_color : 0;

$ps_file =~ s/#ls_width#/$ls_width/gs;
$ps_file =~ s/#ls_height#/$ls_height/gs;

$start_x=int($ls_width/2);
$start_y=int($ls_height/2);

my $f_long = join(" ",split(//,$f));
my $g_long = join(" ",split(//,$g));
my $x_long = join(" ",split(//,$x));
my $y_long = join(" ",split(//,$y));
my $f_iter = $f =~ s/([FGXY])/$1/g || 0;
my $g_iter = $g =~ s/([FGXY])/$1/g || 0;
my $x_iter;
my $y_iter;
if ($f) {
  $x_iter = $x =~ s/([XYFG])/$1/g || 0;
  $y_iter = $y =~ s/([XYFG])/$1/g || 0;
}else{
  $x_iter = $x =~ s/([XY])/$1/g || 0;
  $y_iter = $y =~ s/([XY])/$1/g || 0;
}

my $axiom_long = join(" ",split(//,$axiom));

my $axiom_dup;
if ($x) {
  if ($f) { $axiom_dup = $axiom =~ s/([FGXY])/$1/g - 1; }
  else { $axiom_dup = $axiom =~ s/([XY])/$1/g - 1; }
  $axiom_dup = "$axiom_dup {dup} repeat";
}else{
  $axiom_dup = $axiom =~ s/([FG])/$1/g - 1;
  $axiom_dup = "$axiom_dup {dup} repeat";
}


#The image generated in postscript and then the ImageMagick convert program is used to
#convert it to binary image.  The crop option cuts the image from the full page the
#postscript image is embedded in.

#print STDERR "tmp:$file\n";
open (PS,"| convert -crop ${ls_width}x$ls_height+0+0 - '$gallery_dir$file'");
#open (PS,">foo");

#Prints out the postscript for drawing this L system.
print PS <<EOM;
$ps_file

/Backdrop_color ($color) def

{$f_long} $f_iter Make_F
{$g_long} $g_iter Make_G
{$x_long} $x_iter Make_X
{$y_long} $y_iter Make_Y
newpath $start_x $start_y $start_color_ps $angle $recurse {$axiom_dup $axiom_long} Axiom
showpage
EOM

close PS or warn "Can't close PS pipe: $!\n";

#open(PNG,'<'.$tmp_dir.$tmp) or warn "Can't open png image file $tmp: $!\n";
#my @ls_image = <PNG>;
#close PNG or warn "Can't close png image file: $!\n";

#return join('',@ls_image);
return $file;
}


#
#End of program.