#!/usr/bin/perl
#
# Convert NetHack 3.6 level description files to lua
#

use strict;
use warnings;
use File::Basename;

my $NH = "des.";

sub trim {
    my $str = shift;
    $str =~ s/^\s+//;
    $str =~ s/\s+$//;
    return $str;
}

my $i = 0;
my $outf = '';
my $outstr = '';
my $in_lvl = 0;

my $indent = 0;

my @header_comments = ();

sub nline {
    my ($str, $ind) = @_;

    $indent += $ind if (defined($ind) && $ind < 0);
    $outstr .= "\n";
    $outstr .= ("  " x $indent) if ($indent > 0);
    $outstr .= join("", $str);
    $indent += $ind if (defined($ind) && $ind > 0);
}

sub write_outfile {
    if ($outf eq '' || $outstr eq '' || $in_lvl != 1) {
        die("cannot write empty file");
    }
    print STDOUT "Writing $outf\n";
    open(OUTFILE, ">$outf") or die("cannot write to $outf");
    print OUTFILE join("\n", @header_comments) if (scalar(@header_comments) > 0);
    print OUTFILE $outstr;
    close(OUTFILE);
    $outf = '';
    $outstr = '';
    $in_lvl = 0;
}

my @nh_funcs = (
    #{ re => '^ *REGION *: *(.+)$',  out => $NH.'region($1)' },
    #{ re => '^ *STAIR *: *(.+)$',  out => $NH.'stair($1)' },
    { re => '^ *LADDER *: *(.+)$',  out => $NH.'ladder($1)' },
    #{ re => '^ *BRANCH *: *(.+)$',  out => $NH.'branch($1)' },
    #{ re => '^ *DOOR *: *(.+)$',  out => $NH.'door($1)' },
    { re => '^ *ROOMDOOR *: *(.+)$',  out => $NH.'roomdoor($1)' },
    #{ re => '^ *MONSTER *: *(.+)$',  out => $NH.'monster($1)' },
    #{ re => '^ *OBJECT *: *(.+)$',  out => $NH.'object($1)' },
    { re => '^ *NON_DIGGABLE *: *(.+)$',  out => $NH.'non_diggable($1)' },
    { re => '^ *NON_PASSWALL *: *(.+)$',  out => $NH.'non_passwall($1)' },
    #{ re => '^ *TRAP *: *(.+)$',  out => $NH.'trap($1)' },
    { re => '^ *ALTAR *: *(.+)$',  out => $NH.'altar($1)' },
    { re => '^ *FOUNTAIN *: *(.+)$',  out => $NH.'fountain($1)' },
    { re => '^ *SINK *: *(.+)$',  out => $NH.'sink($1)' },
    { re => '^ *ENGRAVING *: *(.+)$',  out => $NH.'engraving($1)' },
    { re => '^ *MAZEWALK *: *(.+)$',  out => $NH.'mazewalk($1)' },
    { re => '^ *PORTAL *: *(.+)$',  out => $NH.'portal($1)' },
    { re => '^ *TELEPORT_REGION *: *(.+)$',  out => $NH.'teleport_region($1)' },
    { re => '^ *DRAWBRIDGE *: *(.+)$',  out => $NH.'drawbridge($1)' },
    { re => '^ *INIT_MAP *: *(.+)$',  out => $NH.'level_init($1)' },
    { re => '^ *SHUFFLE *: *(.+)$',  out => 'local ${1}idx = math.random(1, #$1);' },
    { re => '^ *MESSAGE *: *(.+)$',  out => $NH.'message($1)' },
    #{ re => '^ *TERRAIN *: *(.+)$',  out => $NH.'terrain($1)' },
    { re => '^ *REPLACE_TERRAIN *: *(.+)$',  out => $NH.'replace_terrain($1)' },
    { re => '^ *RANDOM_CORRIDORS *$',  out => $NH.'random_corridors()' },
    { re => '^ *WALLIFY *$',  out => $NH.'wallify()' },
    { re => '^ *NOMAP *$',  out => '' },
    { re => '^ *#(.*)$',  out => '--$1' },
    { re => '^$',  out => '' },
    );

while ($i <= $#ARGV){
    my $infile = $ARGV[$i];
    $i++;

    open(INFILE, $infile) or die "Could not open $infile: $!";

    $outf = '';
    $outstr = '';
    $in_lvl = 0;
    my $lineno = 0;
    my $in_map = 0;
    my @mapstr = ();
    my @unhandled = ();
    my @block_ends = ();
    my @line_ends = ();
    my %variables;
    my $in_array_def = 0;
    my $in_switch = 0;
    my $block_count = 0;
    my $in_header_comments = 1;
    my $map_geom = '';
    undef @header_comments;

    while (my $line = <INFILE>) {
        $lineno++;
        if ($in_map) {
            if ($line =~ /^ *ENDMAP *$/) {
                if ($map_geom eq '') {
                    nline($NH."map([[\n" . join("\n", @mapstr) . "\n]]);");
                } else {
                    nline($NH."map({ $map_geom, map = [[\n" . join("\n", @mapstr) . "\n]] });");
                }
                $in_map = 0;
                @mapstr = ();
                $map_geom = '';
            } else {
                chop($line);
                push(@mapstr, $line);
            }
            next;
        }

        if ($in_header_comments) {
            if ($line =~ /^#(.+)$/) {
                my $l = $1;
                push(@header_comments, '--'.$l);
                next;
            } else {
                push(@header_comments, '--');
                $in_header_comments = 0;
            }
        }

        # [50%]: foo
        if ($line =~ /^ *\[ *(\d+)% *\] *: *(.+)$/) {
            nline("if math.random(0,99) < $1 then", 1);
            $line = $2."\n";
            $block_count = scalar(@block_ends);
            push(@line_ends, "end");
        }

        if ($line =~ /\$([a-z_]+)/ && !($line =~ /^ *\$([a-z_]+)( *=.*)$/)) {
            my $v = $1;
            # TODO: lua arrays  start at 1, fix $variable[x] to $variables[x+1]
            if (defined($variables{$v})) {
                $line =~ s/\$$v/$v/g;
            }
        }

        if (scalar(@block_ends) && $line =~ /^ *\} *$/) {
            if ($in_switch == 2) {
                nline("end", -1);
                $in_switch = 0;
            }
            nline(pop(@block_ends), -1);
        } elsif ($line =~ /^ *MAZE *: *"(.+?)" *, *'(.+?)'/) {
            write_outfile() if ($in_lvl);
            undef %variables;
            $in_lvl = 1;
            $outf = $1 . ".lua";
            nline($NH."level_init({ style = \"solidfill\", fg = \"".$2."\" });"."\n");
            nline($NH."level_flags(\"mazelevel\");"."\n");
        } elsif ($line =~ /^ *MAZE *: *"(.+?)" *, *random/) {
            write_outfile() if ($in_lvl);
            undef %variables;
            $in_lvl = 1;
            $outf = $1 . ".lua";
            nline($NH."level_init({ style=\"mazegrid\", bg =\"-\" });"."\n");
            nline($NH."level_flags(\"mazelevel\");"."\n");
        } elsif ($line =~ /^ *LEVEL *: *"(.+?)"/) {
            write_outfile() if ($in_lvl);
            undef %variables;
            $in_lvl = 1;
            $outf = $1 . ".lua";
        } elsif ($line =~ /^ *FLAGS *: *(.+)$/) {
            my @tmp = split(/,/, $1);
            my $tmps = "\"".join('", "', @tmp)."\"";
            nline($NH."level_flags($tmps)");
        } elsif ($line =~ /^ *GEOMETRY *: *(.+)$/) {
            my @tmp = split(/,/, $1);
            if ($tmp[0] ne 'center' || $tmp[1] ne 'center') {
                $map_geom = "halign = \"".$tmp[0]."\", valign = \"".$tmp[1]."\"";
            }
            #nline($NH."level_geometry($tmps)");
        } elsif ($line =~ /^ *MAP *$/) {
            $in_map = 1;
            @mapstr = ();
        } elsif ($line =~ /^ *ROOM *: *(.+) *\{ *$/) {
            nline($NH."room($1)", 1);
            push(@block_ends, $NH."room_end()");
        } elsif ($line =~ /^ *DOOR *: *(.+)$/) {
            my $m = $1;
            $m =~ s/[\(\)]//g;
            $m = '"'.$m;
            $m =~ s/,/",/;
            nline($NH."door($m)");
        } elsif ($line =~ /^ *BRANCH *: *(.+)$/) {
            my $m = $1;
            my $lr = 0;
            my $er = 0;
            if ($m =~ /^ *(levregion|)(\(.+\)) *, *(levregion|)(\(.+\))$/) {
                $m = $2 . ", " . $4;
                $lr = 1 if ($1 eq 'levregion');
                $er = 1 if ($3 eq 'levregion');
            }
            if ($m =~ /^\((.+)\) *, *\((.+)\)$/) {
                $m = "region = {" . $1 . "}, exclude = {".$2."}";
            }
            $m .= ", region_islev = 1" if ($lr);
            $m .= ", exclude_islev = 1" if ($er);
            nline($NH."levregion({ $m, type=\"branch\" })");
        } elsif ($line =~ /^ *STAIR *: *(.+)$/) {
            my $m = $1;
            if ($m =~ /^ *\((.+)\) *, *(up|down) *$/) {
                $m = '"' . $2 . '", ' . $1;
            } elsif ($m =~ /^ *random *, *(up|down) *$/) {
                $m = '"' . $1 . '"';
            }
            nline($NH."stair($m)");
        } elsif ($line =~ /^ *REGION *: *(.+)$/) {
            my $m = $1;
            if ($m =~ /^(.+), *((un)?lit) *, *"ordinary" *$/) {
                $m = "selection.area" . $1 . ", \"" . $2 ."\"";
            }
            nline($NH."region($m)");
        } elsif ($line =~ /^ *TERRAIN *: *(.+)$/) {
            my $m = $1;
            if ($m =~ /^(.*), *'(.)'$/) {
                $m = $1.', "'.$2.'"';
            }
            if ($m =~ /^ *\( *([0-9]+ *, *[0-9]+) *\)(.*)$/) {
                $m = "{".$1."}".$2;
            }
            nline($NH."terrain($m)");
        } elsif ($line =~ /^ *TRAP *: *(.+)$/) {
            my $m = $1;
            $m =~ s/[\(\)]//g;
            $m =~ s/ *, *random *$//g;
            $m =~ s/^ *random *//g;
            nline($NH."trap($m)");
        } elsif ($line =~ /^ *OBJECT *: *(.+)$/) {
            my $m = $1;
            $m =~ s/ *, *random *$//g;
            $m =~ s/^ *random *//g;
            if ($m =~ /^ *'(.)'(.*)$/) {
                $m = '"'.$1.'"' . $2;
            }
            if ($m =~ /^(.*), *\(([0-9]+) *, *([0-9]+)\)(.*)$/) {
                $m = $1 . ", ".$2.", ".$3.$4;
            }

            if ($m =~ /^(.*)\('.', *("[^"]+")\)(.*)$/) {
                $m = $1.$2.$3;
            }
            
            nline($NH."object($m)");
        } elsif ($line =~ /^ *MONSTER *: *(.+)$/) {
            my $m = $1;
            if ($m =~ /^ *\( *'.' *, *("[^"]+")\) *, *random(.*)$/) {
                $m = $1.$2;
            } elsif ($m =~ /^ *random *, *random *$/) {
                $m = '';
            } elsif ($m =~ /^ *'(.)' *, *random *$/) {
                $m = '"'.$1.'"';
            } elsif ($m =~ /^ *\( *'.' *, *("[^"]+")\)(.*)$/) {
                $m = $1.$2;
            }

            if ($m =~ /^(.*)'(.)'(.*)$/) {
                $m = $1.'"'.$2.'"'.$3;
            }

            if ($m =~ /^(.*), *\(([0-9]+) *, *([0-9]+)\)(.*)$/) {
                my $endm = $4;
                if ($endm ne '') {
                    $m = $1 . ", x=".$2.", y=".$3.$4;
                } else {
                    $m = $1 . ", ".$2.", ".$3;
                }
            }

            nline($NH."monster($m)");
        } elsif ($line =~ /^ *LOOP *\[ *([^]]+) *\] *\{ *$/) {
            my $s = $1;
            $s =~ s/(\d+)d(\d+)/math.random($1 - 1,$1*$2)/g;
            nline("for i=1,$s do", 1);
            push(@block_ends, "end");
        } elsif ($line =~ /^ *SWITCH *\[([^]]+)\] *\{ *$/) {
            my $tmp = trim($1);
            nline("do", 1);
            nline("local choice = math.random(1, $tmp)");
            push(@block_ends, "end");
            $in_switch = 1;
        } elsif ($in_switch && $line =~ /^ *CASE +([^:]+): *$/) {
            my $choice = trim($1);
            if ($in_switch == 2) {
                $indent--;
                nline("elseif choice == $choice then", 1);
            } else {
                nline("if choice == $choice then", 1);
            }
            $in_switch = 2;
        } elsif ($in_switch == 2 && $line =~ /^ *BREAK *$/) {
            # nothing
        } elsif ($in_switch && $line =~ /^ *DEFAULT *: *$/) {
            if ($in_switch == 2) {
                $indent--;
            }
            nline("else", 1);
            # nothing
        } elsif ($line =~ /^ *IF *\[ *(\d+)% *\] *\{ *$/) {
            nline("if math.random(0, 99) < $1 then", 1);
            push(@block_ends, "end");
        } elsif ($line =~ /^ *\} *ELSE *\{ *$/) {
            $indent--;
            nline("else", 1);
        } elsif ($line =~ /^ *SUBROOM *: *(.+) *\{ *$/) {
            nline($NH."subroom($1)", 1);
            push(@block_ends, $NH."subroom_end()");
        } elsif ($line =~ /^ *REGION *: *(.+) *\{ *$/) {
            nline($NH."region_start($1)", 1);
            push(@block_ends, $NH."region_end()");
        } elsif ($line =~ /^ *CONTAINER *: *(.+) *\{ *$/) {
            nline($NH."container_start($1)", 1);
            push(@block_ends, $NH."container_end()");
        } elsif ($line =~ /^ *CONTAINER *: *(.+) *\{ *\} *$/) {
            nline($NH."container_start($1)");
            nline($NH."container_end()");
        } elsif ($line =~ /^ *\$([a-z_]+)( *=.*)$/) {
            # $variable = values
            my $v = $1;
            my $l = $v.$2;
            $variables{$v} = 1;
            nline($l);
            $in_array_def = 1 if ($line =~ /^ *\$([a-z_]+)( *= *\{.*), *$/);
        } else {
            my $re_matched = 0;
            for my $href (@nh_funcs) {
                if ($line =~ m/$href->{re}/) {
                    my $s = '"'.$href->{out}.'"';
                    chop($line);
                    $line =~ s/$href->{re}/$s/ee;
                    nline($line);
                    $re_matched = 1;
                    last;
                }
            }

            if (!$re_matched && $in_array_def && $line =~ /[,}] *$/) {
                chop($line);
                nline($line);
                $in_array_def = 0 if ($line =~ /\} *$/);
            } elsif (!$re_matched) {
                chop($line);
                nline($line);
                push(@unhandled, "Line $lineno: \"$line\"");
            }
        }

        if (scalar(@line_ends) && $block_count == scalar(@block_ends)) {
            foreach (@line_ends) {
                nline($_, -1);
            }
            @line_ends = ();
        }

    }
    write_outfile() if ($in_lvl);
    undef %variables;
    print STDERR "Unhandled block_ends" if (scalar(@block_ends));
    print STDERR "Unhandled line_ends" if (scalar(@line_ends));

    close(INFILE);

    if (scalar(@unhandled)) {
        print STDERR "Unhandled lines in $infile:\n" . join("\n", @unhandled)."\n";
    }

}

