#!/usr/bin/perl -w
use strict;

#   % ** SPRITE TEST PROGRAM **
#   PROC WAIT,TIME
#   %--- MAIN ---
#   VAR I
#   BEGIN
#     WRITE(1:"Do ")
#     FOR I:=1 TO 10 DO [
#       WRITE(1:I,CRLF)
#       TIME
#       ]
#     WAIT
#   END
#   %-- PROCEDURE WAIT --
#   WAIT
#   VAR I,J,K
#   BEGIN
#     FOR I:=0 TO 1 DO [
#       FOR J:=0 TO 255 DO [
#         FOR K:=0 TO 255 DO []]]
#   END
#   %-- PROCEDURE TIME --
#   TIME
#   VAR I,J
#   BEGIN
#     FOR I:=0 TO 10 DO [
#       FOR J:=0 TO 150 DO []]
#   END

# proc
# func
# var
# main
# proc list

my @procs;
my @funcs;
my @gvar;

&getDecl;
&procs;

# get line without comment
sub getline {
    exit 1 if (eof) ;
    $_ = <>;
    s/^\%.*//;
}

# get declaration
sub getDecl {
    decl : while(1) {
        &getline;
        if (/^PROC (.*)/) {
            @procs = split(/,/,$1);
            # print "proc @proc\n";
            next;
        }
        if (/^FUNC (.*)/) {
            @funcs = split(/,/,$1);
            # print "func @func\n";
            next;
        }
        if (/^VAR (.*)/) {
            @gvar = split(/,/,$1);
            # print "gvar @gvar\n";
            next;
        }
        if (/^BEGIN/) {
            my $gvar = "";
            for my $var (@gvar) {
                $gvar .= "unsigned char $var;\n";
            }
            my $procs =  "";
            for my $var (@procs) {
                $procs .= "void $var();\n";
            }
            my $funcs =  "";
            for my $var (@funcs) {
                $procs .= "int $var();\n";
            }
            print <<"EOFEOF";
#include <stdio.h>
#include <string.h>
#include <unistd.h>

$gvar;
$procs;
$funcs;

int main(int ac, char *av[]) {
EOFEOF
            &statement;
            print <<"EOFEOF";
   return 0;
}
EOFEOF
            last ;
        }
    }
}

sub statement {
    my $nest = 1 ;
    statement : while(1) {
        &getline; chop;
        while($_ ne "") {
            if (s/^WRITE\((\d+)://)  {
                my $d = $1;
                while($_ ne "") {
                    if (s/^\"//) {
                       my $str = "";
                       while(s/.//) {
                           last if ($& eq '"') ;
                           if ($& eq '\\') {
                               if (s/.//) {
                                   if ($& eq "\"") { $str .= "\\\"" ;
                                   } else { $str .= "\\$&" ; }
                               }
                           } else {
                               $str .= $&;
                           }
                       }
                       if ($str ne "") {
                           $str = "\"$str\"";
                           print "write($d,$str,strlen($str));"
                       }
                    } elsif (s/^CRLF//) {
                        print "write($d,\"\\n\",1);";
                    } elsif (s/^\w+//) {
                        print "dprintf($d,\"%d\",$&);";
                    } elsif (s/.//) {
                    } elsif ($& eq ")")  {
                        last;
                    }
                }
            } elsif (s/^[[({]//) {
                &output("{"); next;
            } elsif (s/^[])}]//) {
                &output("}"); next;
            #     FOR I:=1 TO 10 DO [
            } elsif (s/^FOR\s+(\w+):=(\w+)\s+TO\s+(\w+)\s+DO\s*//) { 
                &output("for($1=$2;$1<$3;$1++)");
            } elsif (s/^BEGIN//)  {
                $nest++;
            } elsif (s/^END//)  {
                $nest--;
                last statement if ($nest==0) ;
            } elsif (s/^(\w+)//)  {
                &output(" $1();");
            } elsif (s/^.//) {
            }
        }
        print "\n  ";
    }
}

sub body {
    while (&getline) {} ;
}

sub procs {
    my @lvar;
    my $proc = "";
    while(1) {
        &getline;
        if (/^VAR (.*)/) {
            @lvar = split(/,/,$1);
            print "\n\n";
            my $type = "void ";
            my $args = "";
            my $lvar = "";
            for my $var (@lvar) {
                $lvar .= "unsigned char $var;\n";
            }
            print <<"EOFEOF";
$type$proc($args) {
$lvar;
EOFEOF
        } elsif (/^BEGIN/) {
            &statement;
            print <<"EOFEOF";
} // end $proc
EOFEOF
        } elsif (/^(\w+)/) {
            $proc = $1;
        }
    }
}

sub output { 
    my ($o) = @_;
    print $o;
}

print "\n";