#!/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}, 0: 1-way, 1: 2-way
#          Three link types? 1. 1-way, 2. 2-way between same rooms,
#                            3. 2-way between different rooms
## @ALINK: ORIGIN, DEST, TYPE


%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};
	}
    }

    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}
	}
    }

    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};
	}
    }

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

}


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

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
foreach my $link (@RMLINK) {
    my %arlink;
    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($arlink{$rdest}{$rorigin})) {
		$ALINK{$aorigin}{$adest} = 2;
	    }		
	    elsif (defined($ALINK{$adest}{$aorigin})) {
		$ALINK{$adest}{$aorigin} = 1;
	    }
	    else {
		$ALINK{$aorigin}{$adest} = 0;
	    }
	}
    }



#    if (defined($RMAREA{$link->{ORIGIN}}) && defined($RMAREA{$link->{DEST}})) {
#	my ($aorigin, $adest);
#	$aorigin = $RMAREA{$link->{ORIGIN}};
#	$adest = $RMAREA{$link->{DEST}};
#	if ($aorigin != $adest && !defined($ALINK{$aorigin}{$adest})) {
#	    if (defined($ALINK{$adest}{$aorigin})) {
#		$ALINK{$adest}{$aorigin} = 1;
#	    }
#	    else {
#		$ALINK{$aorigin}{$adest} = 0;
#	    }
#	}
#    }
}


foreach my $area (0 .. $#AREA) {
    if (defined $ALINK{$area}) {
	foreach my $adest (keys %{$ALINK{$area}}) {
	    push @ALINK, {ORIGIN => $area,
			  DEST => $adest,
			  TYPE => $ALINK{$area}{$adest}}
	}
    }
}


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

#foreach my $area (0 .. $#AREA) {
#    print "$area.\t$AREA[$area]->{NAME}\n";
#    if (defined $ALINK{$area}) {
#	foreach my $adest (sort {$a <=> $b} keys(%{$ALINK{$area}})) {
#	    push @{$AREA[$area]->{ALINK}}, $adest;
#	    print "\t> $adest.\t$AREA[$adest]->{NAME}\n";
#	}
#    }
#}


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: