#!/usr/bin/perl 

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 @array;
my @gvar;
my %args;
my $proc = "";

sub isfunc {
    foreach my $key (@funcs) {
        return 1 if ($key eq $proc) ;
    }
    return 0;
}

&getDecl;
&procs;
my $nest = 0;

# get line without comment
sub getline {
    if (eof) {
        &proto;
        exit 1;
    }
    $_ = <>;
    s/\%.*//;
    s/\$([0-9A-Z]+)/0x\1/g;  # will replce inside of string
}

# 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 (/^ARRAY (.*)/) {
            @array = 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 $array = "";
            for my $var (@array) {
                $array .= "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>
#include "proto.h"

extern char GET(int);
$gvar;
$array;

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

#
# assumption
#     an expression has no space in it
#     space means a statement separation

our $cnest = 0;
our $st = 0;
sub statement {
    my ($skip) = @_;
    statement : while(1) {
        if ($skip) {
            $skip = 0;
        } else {
            &getline; chop;
        }
        while($_ ne "") {
            if (s/^\s+//)  {
                print "$&";
                if ($st) {
                    print ";"; $st = 0;
                }
            }
            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\"";
                           &output("write($d,$str,strlen($str));")
                       }
                    } elsif (s/^CRLF//) {
                        &output("write($d,\"\\n\",1);");
                    } elsif (s/^\w+//) {
                        &output("dprintf($d,\"%d\",$&);");
                    } elsif (s/.//) {
                    } elsif ($& eq ")")  {
                        last;
                    }
                }
            } elsif (s/^[[{]//) {
                &output("{"); $nest++; next;
            } elsif (s/^[]}]//) {
                &output("}"); $nest--; 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/^FOR\s+(\w+):=(\w+)\s+DOWNTO\s+(\w+)\s+DO\s*//) { 
                &output("for($1=$2;$1>$3;$1--)");
            } elsif (s/^CASE\s+(\w+)\s+OF\s+(\w+)//) { 
                local $cnest;
                &output("switch ($1) { \n case $1 : ");
                while (1) {
                  $cnest = $nest ; $nest = 0; &statement(1);
                  if (s/\s+ELSE\s+(\w+)\s+//) {
                      &output("\ndefault:\n");
                      &statement(1) ;
                      &output("}\n");
                      last;
                  } elsif (s/\s+(\w+)\s+//) {
                      &output("\ncase $1:\n");
                  }
                }
                $nest = $cnest ;
            } elsif (s/^IF\s*//) { 
                &output("if (");
            } elsif (s/^THEN\s*//) { 
                &output(") ");
            } elsif (s/^ELSE\s*//) { 
                &output(" else ");
            } elsif (s/^DO\s*//) { 
                &output("do { ");
            } elsif (s/^REPEAT\s*//) { 
                &output("do { ");
            } elsif (s/^WHILE\s+([^\s]*)\s+DO\s+//) { 
                &output("while ($1) "); 
            } elsif (s/^WHILE\s*//) { 
                &output("while "); 
            } elsif (s/^UNTIL\s+([^\s]*)\s+//) { 
                &output("} while ($1 == 0);"); 
            } elsif (s/^BEGIN\s*//)  {
                &output("{"); 
                $nest++;
            } elsif (s/^END\s*//)  {
                &output("}"); 
                $nest--;
                last statement if ($nest==0) ;
            } elsif (s/^RETURN\s*//) {
                &output("return");
            } elsif (s/^:=\s*//) {
                &output("=");
            } elsif (s/^=\s*//) {
                &output("==");
            } elsif (s/^(\w+)//)  {
                &output(" $1");
            } elsif (s/^.//) {
                &output($&);
            }
        }
        print "\n  ";
    }
}

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

sub procs {
    my @lvar;
    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/) {
            $nest = 1;
            &statement(0);
            print <<"EOFEOF";
}\n // end $proc
EOFEOF
        } elsif (/^(\w+)\([\w,]+\)/) {
            $proc = $1;
            $args{$proc} = $2; #  split(/,/,$2);
        } elsif (/^(\w+)/) {
            $proc = $1;
        }
    }
}

sub proto {
    open my $fd, ">","proto.h";
    foreach my $key ( @procs ) {
        print $fd "void ";
        print $fd $key,"(";
        if ($args{$key}) {
           print $fd "unsigned char ",join(",unsigned char ",split(/,/,$args{$key}));
        }
        print $fd ");\n";
    }
    foreach my $key ( @funcs ) {
        print $fd "int ";
        print $fd $key,"(";
        if ($args{$key}) {
           print $fd "unsigned char ",join(",unsigned char ",split(/,/,$args{$key}));
        }
        print $fd ");\n";
    }
    close $fd;
}

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

print "\n";