#!/usr/bin/perl -T

#This program allows users to render SVG renditions of L-systems.
#It produces either an HTML interface to allow the user to set
#the axiom, rules, and parameters of the L-system or renders
#the corresponding SVG, depending on the user agent's request.
#
#This code is at a pre-alpha stage of development.
#
#David Faden
#dfaden@cs.iastate.edu
#March 11, 2004
#
#This code is released under the Creative Commons Attribution 1.0
#license: http://creativecommons.org/licenses/by/1.0/

#use warnings;
#use strict;

use CGI;

$CGI::POST_MAX = 2048;
$CGI::DISABLE_UPLOADS = 1;

my $pi = 3.1415926535897931;
my $max_number_of_segments = 2000;
my $max_expansion_length = 10000;

my $cgi = new CGI;
if ($cgi->param('svg')) {
   print_svg();
}
else {
   print_html();
}

sub print_html {
print $cgi->header('text/html');
print $cgi->start_html('Render L-system'),
      $cgi->h1('Render L-system'),
      "<form method='get'>",
#For some reason, when the form's method was set to GET,
#CGI.pm was escaping the quotes around the value of the
#action, screwing up the form. Or perhaps it was Internet
#Explorer doing the escaping? Anyway, the problem was very
#mysterious and irritating. The above is a temporary work
#around.
#      $cgi->start_form('GET'),
      'Axiom:',
      $cgi->br,
      $cgi->textfield(-name=>'axiom', -default=>'F'),
      $cgi->br,
      'Rules:',
      $cgi->br,
      $cgi->textarea(-name=>'rules', -default=>'F=F[+F]F[-F]F',
                        -rows=>4,-cols=>50),
      $cgi->br,
      'Angle delta (in degrees): ',
      $cgi->textfield(-name=>'angle_delta', -default=>25.7),
      $cgi->br,
      'Segment length (in pixels): ',
      $cgi->textfield(-name=>'segment_length', -default=>10),
      $cgi->br,
      'Number of iterations: ',
      $cgi->popup_menu(-name=>'n', -values=>[1..7], -default=>3),
      $cgi->br,
      $cgi->submit('submit', 'Render'),
      $cgi->end_form;

if ($cgi->param('axiom') && $cgi->param('rules')) {
       my $script = $cgi->script_name();
       $script =~ s!^/!!; #strip a leading slash if present
       my $query = $cgi->query_string();
       print<<END_EMBED;
<embed src="$script?$query&svg=1" width="400" height="250" type="image/svg+xml">
</embed>
END_EMBED
   }
   print '<br>';
   print $cgi->end_html;
}

sub print_svg {
    my $axiom;
    my %rules;

    my $tainted_axiom = $cgi->param('axiom') || 0;
    my $tainted_rules = $cgi->param('rules') || 0;

    if ($tainted_axiom =~ /^([A-Za-z\-\+\[\]]+)$/) {
	$axiom = $1;
    }
    else {
	svg_exit_with_error("Invalid axiom");
    }

    if ($tainted_rules =~ /^((([A-Za-z]\s?=\s?[A-Za-z\-\+\[\]]+)(\s+|\Z))+)$/) {
	my $rules = $1;
	$rules =~ s/\s?=\s?/=/g;
        $rules =~ s/\s+$//;
        %rules = split(/[\s=]/, $rules);
        $rules{$_} = [split //, $rules{$_}] for keys %rules;
    }
    else {
	svg_exit_with_error("Invalid rules");
    }

    print_svg_header();
    print '<g style="fill:none; stroke:green">';
    
    my $x = 200;
    my $y = 250;
    
    my $angle = -1.5707963267948966; #-90 degrees
    
    my $angle_delta = get_real_param_with_default('angle_delta', 25.7);
    $angle_delta = to_radians($angle_delta);
    
    my $segment_length = get_real_param_with_default('segment_length', 10);
    
    my @state_stack;
    
    my $number_of_iterations = 3;
    my $tainted_n = $cgi->param('n') || 'NaN';
    if ($tainted_n =~ /^(1|2|3|4|5|6|7)$/) {
    	$number_of_iterations = $1;
    }
    
    my @expanded = expand_axiom($axiom, \%rules, $number_of_iterations);
    my $number_of_segments = 0;
    for my $c (@expanded) {
        if ($c eq 'f' || $c eq 'F') {
          my $newx = $segment_length * cos($angle) + $x;
          my $newy = $segment_length * sin($angle) + $y;
          if ($c eq 'F') {
             print "<line x1=\"$x\" y1=\"$y\" x2=\"$newx\" y2=\"$newy\" />";
             $number_of_segments++;
             last if $number_of_segments > $max_number_of_segments;
          }
          $x = $newx;
          $y = $newy;
        }
        elsif ($c eq '-') {
          $angle -= $angle_delta;
        }
        elsif ($c eq '+') {
          $angle += $angle_delta;
        }
        elsif ($c eq '[') {
          push @state_stack, {x=>$x, y=>$y, angle=>$angle};
        }
        elsif ($c eq ']') {
          my $state = pop @state_stack;
          if (defined $state) {
            $x = $state->{'x'};
            $y = $state->{'y'};
            $angle = $state->{'angle'};
          }
        }
    }
    print '</g>';
    print '</svg>';
}

sub get_real_param_with_default {
	my ($name, $default) = @_;
	my $tainted_param = $cgi->param($name) || 'NaN';
	#Taken from the perlretut man page:
	if ($tainted_param =~ /^([+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?)$/) {
		return $1;
	}
	else {
		return $default;
	}
}

sub to_radians {
	my $degrees = shift @_;
	return $pi * $degrees / 180.0;
}

sub expand_axiom {
  my ($axiom, $rules, $number_of_iterations) = @_;
  my @result = split //, $axiom;
  for (1..$number_of_iterations) {
	  @result = map({(defined $rules->{$_}) ? @{$rules->{$_}} : $_} @result);
	  last if $#result > $max_expansion_length;
  }
  $#result = $max_expansion_length if $#result > $max_expansion_length;
  return @result;
}

sub print_svg_header {
    print $cgi->header('image/svg');
    print<<SVG_HEADER;
<?xml version="1.0" standalone="no"?>
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN" 
  "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
<svg width="400px" height="250px"
      xmlns="http://www.w3.org/2000/svg" version="1.1">
SVG_HEADER
}

sub svg_exit_with_error {
    print_svg_header();
    print '<text x="50px" y="50px">';
    print shift @_;
    print '</text>';
    print '</svg>';
    exit 1;
}