#!/usr/bin/perl
#
# fichier : lsystem.pl
#
# Jean-Michel Sarlat -- 12 février 2003
#  
# http://melusine.eu.org/syracuse/metapost/


# -- Initialisation
$PAR{'ratio'} = 1;
$PAR{'iter'}  = 1;


# --- Lecture du fichier
open(F,$ARGV[0]) || die "Impossible de trouver $ARGV[0] ";
@lignes = <F>;
close(F);



# --- Préfixe
my $f = "\L$ARGV[0]";
my @ef = split(/\./,$f);
$f = $ef[0];

# --- Ouverture du fichier MetaPost
open(F,">$f.mp");

# --- On place le contenu initial
print F "\% lsystem $ARGV[0] -- ", `date`;
print F "\%% Fichier de paramètres : $ARGV[0]\n";
foreach $l (@lignes) {
    print F "\% $l";
}
print F "\%% FIN du fichier\n";
print F"\ninput tortue;\n\n";

# --- Traitement des lignes
foreach $l (@lignes) {
    $l =~ s/\s+$//g;    # suppression des blancs terminaux
    unless ($l eq "" || $l =~ /^\#/) {
        $l =~ s/^([a-z]+)//;
        $cle = $1;
        $l =~ s/\s+//g;
        if ($cle eq "move") {
            $MOVE{$l} = 1;
        } elsif ($cle eq "ignore") {
            $IGNORE{$l} = 1;
        } elsif ($cle eq "rule") {
            @r = split(/->/,$l);
            $RULE{$r[0]} = $r[1];
        } elsif ($cle eq "seed") {
            $RULE{'axiome'} = $l;
        } else {                
            $PAR{$cle} = $l; 
        }
    }
}

# --- Ecriture des procédures de tracé
if (exists $PAR{'green'}) {
    print F << "eop";
vardef trace(expr a,b) =
    draw a--b withpen pencircle scaled 1pt 
              withcolor ($PAR{red},$PAR{green},$PAR{blue});
enddef;

eop
}

print F << "eop";
vardef deplace(expr a,b) =
enddef;

eop

# --- Ecriture des règles (+ l'axiome)
foreach $k (keys %RULE) {
    $m  = $k eq 'axiome' ? 'm' : 'm-1';
    $if = $k eq 'axiome' ? "\n"  : "\n   if m>0:\n";
    $fi = $k eq 'axiome' ? "enddef;\n" : "   fi\nenddef;\n";
    print F "vardef $k(expr n,m) =$if";
    $id = 0;
    $n  = "n";
    # décomposition de la règle
    @R = split(//,$RULE{$k});
    foreach $e (@R) {
        if ($e eq "+") {
            print F "        tourne($n,$PAR{delta});\n";
        } elsif ($e eq "-") {
            print F "        tourne($n,-$PAR{delta});\n";
        } elsif ($e eq "[") {
            $id++;
            $no = $n;
            $n = $id == 0 ? "n" : "n+$id";
            print F "        blop($no,$n);\n";
        } elsif ($e eq "]") {
            $id--;
            $n = $id == 0 ? "n" : "n+$id";
        } else {
            print F "        $e($n,$m);\n";
        }
    }
    # fin d'itération ...
    if (exists $MOVE{$k}) {
        print F << "eop";
   else:
        avance(n,longueur,deplace);
$fi
eop
    } elsif (exists $IGNORE{$k} || $k eq 'axiome') {
        print F "$fi\n";
    } else {
        print F << "eop";
   else:
        avance(n,longueur,trace);
$fi
eop
    }
}

# --- Fin d'écriture du fichier MetaPost
print F << "eop";
beginfig(1);
    longueur = $PAR{leng} / ( $PAR{ratio} ** $PAR{iter} );
    tortue(1,$PAR{x},$PAR{y},$PAR{theta},1);
    axiome(1,$PAR{iter});
endfig;
end
eop
close(F);

1;