#!/usr/local/bin/perl
# atopojo.pl - Generate MUD inter-area topology as JSON
#
# Copyright 2015 David Meyer <papa@sdf.org> +JMJ
# (License and documentation at bottom of file.)


use strict;
use warnings;
use Getopt::Std;
use JSON;


our (@AREA, %RMAREA, @RMLINK, %ALINK, @ALINK);
## @AREA: {ID, FILE, NAME}
## %RMAREA: {rmnum}, areaid
## @RMLINK: {ORIGIN, DEST}
## %ALINK: {aorigin}{adest}, type (0: 1-way; 1: 2-way (indirect);
##                                 2: 2-way (same rooms))
## @ALINK: {AREAO, AREAD, TYPE}


our %OPTIONS = ();
getopts('df:', \%OPTIONS);


%FSM::STATE = (SKIP => 0, 
	       AREA => 1, 
	       ROOMS => 2, 
	       PENDRNAME => 3, 
	       PENDRDESC => 4,
	       WAITDOOR => 5,
	       PENDDDESC => 6,
	       PENDDKW => 7,
	       PENDDLKD => 8);
$FSM::state = $FSM::STATE{SKIP};

sub parse_are_fsm {
    my($afile, $aline) = @_;

    if ($FSM::state == $FSM::STATE{SKIP}) {
	if ($aline =~ /^#AREA\s+({.*}\s+\w+\s+)?(.*)~/) {
	    $FSM::areaname = $2;
	    $FSM::areaid = $#AREA + 1;
	    push @AREA, {ID => $FSM::areaid, FILE => $afile, NAME => $FSM::areaname};
	    $FSM::state = $FSM::STATE{AREA};
	}
    }

    elsif ($FSM::state == $FSM::STATE{AREA}) {
	if ($aline =~ /^#ROOMS$/) {
	    $FSM::state = $FSM::STATE{ROOMS};
	}
	elsif ($aline =~ /^#\$$/) {
	    $FSM::state = $FSM::STATE{SKIP};
	}
    }

    elsif ($FSM::state == $FSM::STATE{ROOMS}) {
	if ($aline =~ /^#0$/) {
	    $FSM::state = $FSM::STATE{AREA};
	}
	elsif ($aline =~ /^#(\d+)$/) {
	    $FSM::room = $1;
	    $RMAREA{$FSM::room} = $FSM::areaid;
	    $FSM::state = $FSM::STATE{PENDRNAME};
#	    if (defined $OPTIONS{d}) {print STDERR "$afile\t#$1:\t";} 
	}
    }

    elsif ($FSM::state == $FSM::STATE{PENDRNAME}) {
	if ($aline =~ /~$/) {
	    $FSM::state = $FSM::STATE{PENDRDESC};
	}
    }

    elsif ($FSM::state == $FSM::STATE{PENDRDESC}) {
	if ($aline =~ /~$/) {
	    $FSM::state = $FSM::STATE{WAITDOOR};
	}
    }

    elsif ($FSM::state == $FSM::STATE{WAITDOOR}) {
	if ($aline =~ /^D(\d+)$/) {
#	    $FSM::exdir = $1;
	    $FSM::state = $FSM::STATE{PENDDDESC};
	}
	elsif ($aline =~ /^S$/) {
	    $FSM::state = $FSM::STATE{ROOMS};
#	    if (defined($OPTIONS{d})) {print STDERR "\n";} 
	}
    }

    elsif ($FSM::state == $FSM::STATE{PENDDDESC}) {
	if ($aline =~ /~$/) {
	    $FSM::state = $FSM::STATE{PENDDKW};
	}
    }

    elsif ($FSM::state == $FSM::STATE{PENDDKW}) {
	if ($aline =~ /~$/) {
	    $FSM::state = $FSM::STATE{PENDDLKD};
	}
    }

    elsif ($FSM::state == $FSM::STATE{PENDDLKD}) {
	if ($aline =~ /^\S+\s+\S+\s+(\d+)$/) {
	    $FSM::exdest = $1;
	    push @RMLINK, {ORIGIN => $FSM::room, DEST => $FSM::exdest};
	    $FSM::state = $FSM::STATE{WAITDOOR};
#	    if (defined $OPTIONS{d}) {print STDERR "$FSM::exdest ";} 
	}
    }

    else {
	die "Invalid state processing file $afile line $.";
    }

}


## Read and parse area files
if (defined($OPTIONS{f})) {
    open(my $FLIST, "<", $OPTIONS{f}) or die "Can't open file $OPTIONS{f}: $!";
    my @afiles;
    while (<$FLIST>) {
	chop $_;
	if ($_ eq '$') {last;}
	push @afiles, $_;
    }
    foreach my $afile (@afiles) {
	open(my $AF, "<", $afile) or die "Can't open file $afile: $!";
	while (<$AF>) {
	    parse_are_fsm($afile, $_);
	}
	close $AF;
    }
}
else {
    while (<>) {
	parse_are_fsm($ARGV, $_);
    }
}


## Select links between different areas
our %arlink;
foreach my $link (@RMLINK) {
    my $rorigin = $link->{ORIGIN};
    my $rdest = $link->{DEST};
    if (defined($RMAREA{$rdest})) {
	my $aorigin = $RMAREA{$rorigin};
	my $adest = $RMAREA{$rdest};
	if ($aorigin != $adest) {
	    $arlink{$rorigin}{$rdest} = 1;
	    if (defined $OPTIONS{d}) {print STDERR "$rorigin\t-> $rdest";}
	    if (defined $OPTIONS{d}) {if (defined($arlink{$rdest}{$rorigin})) {print STDERR "\nD>O\n";} else {print STDERR "\t--\n";}}

	    if (defined($arlink{$rdest}{$rorigin})) {
		$ALINK{$adest}{$aorigin} = 2;
	    }		
	    elsif (defined($ALINK{$adest}{$aorigin})) {
		if ($ALINK{$adest}{$aorigin} == 0) {
		    $ALINK{$adest}{$aorigin} = 1;
		}
	    }
	    else {
		$ALINK{$aorigin}{$adest} = 0;
	    }
#	    if (defined $OPTIONS{d}) {print STDERR "$rorigin\t-> $rdest";}
#	    if (defined $OPTIONS{d}) {if (defined $ALINK{$aorigin}{$adest}) {print STDERR " >$ALINK{$aorigin}{$adest}\n";} if (defined $ALINK{$adest}{$aorigin}) {print STDERR " <$ALINK{$adest}{$aorigin}\n";}}
	}
    }
}


foreach my $area (0 .. $#AREA) {
    if (defined $ALINK{$area}) {
	foreach my $adest (keys %{$ALINK{$area}}) {
	    push @ALINK, {AREAO => $AREA[$area]->{NAME},
			  AREAD => $AREA[$adest]->{NAME},
			  TYPE => $ALINK{$area}{$adest}};
#	    print "test: $ALINK[-1]->{TYPE}\t$ALINK[-1]->{AREAO}\t-> $ALINK[-1]->{AREAD}\n";
	}
    }
}


print encode_json {links => [@ALINK]};


exit 0

__END__

# Documentation #####################################################
=head1 NAME

template.pl - Perl script template (command line)

=head1 SYNOPSIS/USAGE

=head1 DESCRIPTION

Mark up code elements with C<>, file names with F<> (or C<> for
readability), command names with B<>. Also I<> for italics, U<> for
underline. Entities: E<lt> ('<'), E<gt> ('>').

=head1 OPTIONS

=item B<-o> I<value>, B<--option>=I<value>

=head1 RETURN VALUE

=head1 ERRORS

=head1 DIAGNOSTICS

=head1 EXAMPLES

=head1 ENVIRONMENT

=over 6

=item VARIABLE

Description of usage of environment variable C<VARIABLE>.

=back

=head1 FILES

=head1 BUGS, LIMITATIONS, AND CAVEATS

=head1 NOTES

=head1 AUTHOR

David Meyer <papa@sdf.org>

=head1 HISTORY

=head1 COPYRIGHT AND LICENSE

Copyright 201x David Meyer

=head1 SEE ALSO



# Emacs control #####################################################
#Local variables:
#mode: perl
#End: