#!/usr/bin/perl
# Generate graphwiz 'dot' file from SNL

use English;
use strict;
use vars qw ($opt_d $opt_p $opt_h $opt_D);
use Getopt::Std;

if (!getopts("dphD")  or  $opt_h)
{
    print("Convert specially commented SNL to a graphwiz 'dot' file\n");
    print("\n");
    print("Usage: snl_dot.pl [options] snl1.st { snl2.st ... } \n");
    print("\n");
    print("Options: -d  debug\n");
    print("         -p  plain output (the ordinary state diagram)\n");
    print("         -D  use Dromey-type transitions with '?? ... ??'\n"); 
    print("         -h  help\n");
    print("\n");
    print("/* SNL code has to look like this : */\n");
    print("ss t3 /* A COMMENT FOR THE STATE SET */\n");
    print("{\n");
    print("    state start /* A COMMENT FOR THE STATE */\n");
    print("    {\n");
    print("        when (v > 5.0) {} state high /* when COMMENT FOR THE TRANSITION */\n");
    print("        when (v < 5.0) {} state start /* when^ TRANSITION DRAWN TO SHADOW INSTANCE */\n");
    print("    }\n");
    print("}\n");
    exit(1);
}

my ($debug) = $opt_d;
my ($plain) = $opt_p;
my ($dromey) = $opt_D;

# Counter for 'conditional' boxes used in Dromey diags.
my ($conditionals) = 0;

# Create %snl hash, one entry per file==state set.
#
# $snl{$file}{comment}
# - comment string (not used?)
#
# $snl{$file}{init}
# - the initial state
#
# $snl{$file}{state}{$state}{comment}
# - comment for each state
#
# $snl{$file}{state}{$state}{transition}{$next}
# - array of comments for all transitions from $state to $next
#
# $snl{$file}{state}{$state}{declutter_transition}{$next}
# - Simular to transition, but to a copy of the actual state,
#   in order to reduce clutter.
my (%snl);

sub draw_transition($$$$)
{
    my ($out, $state, $next, $condition) = @ARG;
    if ($dromey)
    {   # Show state -> conditional -> next
        ++$conditionals;
        printf $out "    cond%d [ label=\"?? %s ??\\n\" ];\n",
            $conditionals, $condition;
        printf $out "    %s -> cond%d;\n", $state, $conditionals;
        printf $out "    cond%d -> %s;\n", $conditionals, $next;
    }
    else
    {   # Transition state -> next
        printf $out "    %s -> %s [ label=\"%s\" ];\n",
            $state, $next, $condition;
    }
}

sub parse($)
{
    my ($seq_name) = @ARG;
    my ($f, $file, $file_comment, $state, $state_comment, $next, $condition, $mod);
    my ($need_init) = 1;
    
    open($f, $seq_name) or die "Cannot open $seq_name\n";
    while (<$f>)
    {
        # State sets have to start like this:
        # "ss NAME /* COMMENT */"
        #
        if (m/ss\s+(\w+)\s+\/\*\s+(.+) \*\//)
        {
            $file = $1;
            $file_comment = $2;
            printf("File '%s': '%s'\n", $file, $file_comment) if ($debug);
            $snl{$file}{comment} = $file_comment;
            $need_init = 1;
        }
        # States transitions need to be declared like this:
        # "when ()
        #  {
        #    ...
        #  } state NEXT_STATE /* when ONE-LINE-DESCRIPTION */"
        #
        #  Use /* when^ ... instead of /* when ... for transitions
        #  that should not be connected back to the original state.
        #
        if (m/state\s+(\w+)\s+\/\*\s+when(\^?) (.+) \*\//)
        {
            $next = $1;
            $mod = $plain ? 0 : $2;
            $condition = $3;
            printf("Goto '%s' when '%s' (%s)\n", $next, $condition, $mod)
                if ($debug);
            if ($mod eq '^')
            {
                push
                 @{ $snl{$file}{state}{$state}{declutter_transition}{$next} },
                 $condition;
            }
            else
            {
                push
                    @{ $snl{$file}{state}{$state}{transition}{$next} },
                    $condition;
            }
            next;
        }
        # States need to be declared like this:
        # "state NAME /* ONE-LINE-DESCRIPTION */"
        #
        if (m/state\s+(\w+)\s+\/\*\s+(.+) \*\//)
        {
            $state = $1;
            $state_comment = $2;
            printf("State '%s': '%s'\n", $state, $state_comment) if ($debug);
            $snl{$file}{state}{$state}{comment} = $state_comment;
            if ($need_init)
            {
                $snl{$file}{init} = $state;
                $need_init = 0;
            }
        }
    }
    close($f);
}
    
# Create one dot file per state set
sub make_dots()
{
    my ($out, $file, $state, $next, $condition);
    my ($hits) = 1;

    printf "# Run this command sequence to convert and display:\n";
    foreach $file ( keys %snl )
    {
        open($out, ">$file.dot") or die "Cannot create $file.dot";
        printf $out "# dot -Tpng -o %s.png %s.dot && eog %s.png &\n",
            $file, $file, $file;
        printf $out "#\n";
        printf $out "# %s - %s\n", $file, $snl{$file}{comment};
        printf $out "\n";
        printf $out "digraph %s\n", $file;
        printf $out "{\n";

        # Dump all the state names and their comments
        unless ($plain)
        {
            printf $out "node [ shape=record, height=0.1,\n";
            printf $out "       fontname=Helvetica, fontsize=14 ];\n";
        }
        printf $out "    init [ label=\"init\", shape=point ];\n";
	foreach $state ( keys %{ $snl{$file}{state} } )
        {
            printf $out "    %s [ label=\"%s\\n\" ];\n",
                $state, $snl{$file}{state}{$state}{comment};
        }

        # Dump all state transitions and their comments
        printf $out "    init -> %s;\n", $snl{$file}{init};
	foreach $state ( keys %{ $snl{$file}{state} } )
        {
            foreach $next ( keys %{ $snl{$file}{state}{$state}{transition} } )
            {
                foreach $condition
                    ( @{ $snl{$file}{state}{$state}{transition}{$next} } )
                {
                    draw_transition($out, $state, $next, $condition);
                }
            }
            foreach $next ( keys %{ $snl{$file}{state}{$state}{declutter_transition} } )
            {
                foreach $condition
                    ( @{ $snl{$file}{state}{$state}{declutter_transition}{$next} } )
                {   # Transition state -> a dashed instance of next
                    ++$hits;
                    printf $out "    %s%d [ label=\"%s\\n\",style=dashed ];\n",
                        $next, $hits, $snl{$file}{state}{$next}{comment};
                    draw_transition($out, $state, "$next$hits", $condition);
                }
            }
        }
        printf $out "}\n";
        close($out);
        printf "dot -Tpng -o %s.png %s.dot && eog %s.png &\n", $file, $file, $file;
    }
}

# main
my ($file);
foreach $file ( @ARGV )
{
    parse($file);
}
make_dots();