view release on metacpan or  search on metacpan

drawstate.source  view on Meta::CPAN

    Starting
    0,0,N N

    Accepting
    0,2
    2,3

    5
    0,0,E 2,0,W
    2,0,S 2,1,N
    2,1,W 1,2,E
    1,2,S 1,3,N
    1,3,W 0,2,S

    10
    0,0,S 2,1,W
    1,2,W 0,2,E
    2,1,S 1,3,E
    1,3,E 2,3,W

    25
    0,0,S 0,2,N Counter
    2,0,E 2,3,E Clock

This represents the states in a coin operated vending machine which accepts
coins with values of 5, 10, and 25.  The purchase price for the machine is
25, so 25 and 30 are accepting states.  Zero is the start state.  Each
deposited coin increases the total, which is used to label the nodes.
Edges represent deposits and are labeled with the value of the deposited
coin.  (The diagram is not complete.  It is meant to show features of
diagrams.  If you have a coin-op machine you need to build, feel free
to extend it as needed.)

Each paragraph except the one for node layout has a label.  The labels are
only used for edge paragraphs.  All coordinates are in terms of the node
layout which is numbered from 0.  Columns are listed first, then rows
(think x and y from algebra).  Sides of the nodes (where edges begin and
end) are labeled with compass points N(orth), S(outh), E(ast), and W(est).

This input format is idiosyncratic.  If you don't like it, you should design
your own and interface directly with UML::State.  If you don't like listing
columns first, or numbering from zero, you will need to account for that
in your new script or change UML::State.

=head1 BUGS

The order of the paragraphs matters.  All paragraphs except the node layout
must be labeled.

All edges using the same label must be in the same paragraph.
If an edge paragraph repeats a label used by an earlier edge paragraph,
it overwrites that paragraph.  (Think of the labels as hash keys, I do.)

The bugs in UML::State apply here as well, since this script uses it
to make the pictures.  See perldoc UML::State for those bugs.

=cut

use UML::State;

$/                   = "";   # paragraph mode

my $node_data        = <>;
my $start_states     = <>;
my $accepting_states = <>;

my $nodes            = make_2D_array($node_data       );
my $starts           = make_array   ($start_states    );
my $accepting        = make_array   ($accepting_states);

my $edges = {};

while (<>) {
    my ($label, @arrows) = split /\n/;
    $edges->{$label} = \@arrows;
}

my $machine = UML::State->new($nodes, $starts, $accepting, $edges);

print $machine->draw();

sub make_2D_array {
    my $input = shift;
    my @answer;

    my @rows  = split /\n/, $input;

    foreach my $row (@rows) {
        $row  =~ s/^\s*\(//;  # remove the first (
        $row  =~ s/\)\s*$//;  # remove the last )
        my @elements = split /\)\s*\(/, $row; # split on ') (' or similar
        push @answer, \@elements;
    }
    return \@answer;
}

sub make_array {
    my     $input  = shift;
    my     @answer = split /\n/, $input;
    shift  @answer;
    return \@answer;
}