#!/usr/local/bin/perl
# $Id: cwb2daVinci,v 1.13 1997/10/07 17:08:41 pxs Exp $
# This script is part of an experimental interface between the CWB and
# the graph drawing package daVinci from Bremen. It takes CWB output
# in various forms and turns it into a daVinci command to display the
# transistions or graphs.
#
# There are no newlines or spaces in the output because daVinci can't
# cope with them.
#
# All sorts of problems can cause nodes not to be recognised as the
# same when "in fact" they are the same. Most are outwith our control
# here. We do, however, delete spaces with gay abandon to ease the problem.
#
# Using the -a option we can take the existing graph (stored in a DBM
# file) and add the
# transitions (or graph) from a new agent into it, instead of starting
# from scratch. DaVinci will still insist on starting from scratch,
# re-reading the whole graph, but that's its problem!
#
use Getopt::Std;
getopts('af:t:i:'); # f(ormat commun) option takes an fc file
                    # t(ransistions) from the opt. agent as argument
                    # a(dd) this info to existing graph, don't replace
                    # i(input) from this arg, not from STDIN

$opt_a && ($dontwarn = 1); # if we're adding things may well be
			   # disconnected; don't warn about that

# if -i was used, get INPUT from there, otherwise use STDIN
open (INPUT, $opt_i ? "echo \"$opt_i\"|" : "-");

$errorfile = "/tmp/CWBtranslateerrors";
$tmpfile = "/tmp/CWBstoredinfo"; # used to store this graph in case we
			        # have to add to it next time
# it would be more efficient to store colour info in the same array as
# the transition info, but daVinci is so much the limiting factor on
# performance that I'm doing it this way for programmer efficiency!
$colourfile = "/tmp/CWBcolourinfo"; # used to store colour info

$prompt = "Command:";
$edgeattributes1 = "[a(\"EDGECOLOR\",\"black\"),a(\"_DIR\",\"none\")]";
$edgeattributes2 = "[a(\"EDGECOLOR\",\"black\")]"; # with an arrow
$edgestring = "\"anything\"";
$nodestring = "\"anything\"";
$topnodekey = 'CWB TOP NODE'; # hack: store topnode in the DBM file

open (ERRORS, ">>$errorfile") || die $!;

# If required, read in the transition system for the current graph.
# Otherwise, delete the stored info and start again.
unless ($opt_a) { unlink <$tmpfile.*>; unlink <$colourfile.*>;}
dbmopen (%transitions, $tmpfile, 0666);
dbmopen (%colour, $colourfile, 0666);
#$topnode = $transitions{$topnodekey};
#delete $transitions{$topnodekey}; # it doesn't belong, it was a hack to
				   # put it there!
# Set up the transition system...
if ($opt_f) {
  &readfc($opt_f);
} elsif ($opt_t) {
# HACK. We store the topnode in the DBM array, so if it an entry for it
# already exists there we should use it. If it's not there, get it, and
# we'll put it into the array at the end.
  unless ($topnode) {
    if ($opt_t =~ /lookinregion/ ) {&gettopnode;} else {$topnode = $opt_t;}
    $topnode =~ tr/ //d;
  }
  &getarrowtransitions;
  $colour{$topnode} = 'y';
} else {die "No option given";}
# ... and now make a daVinci term out of it
&doit;
# check that we used all the information -- if not, we probably have an alias
# problem, or a prefix-form problem, or...
for (keys %transitions) {
  unless ($seen{$_}) {
    ($othertree = &graphtree($_)) =~ s/\\/\\\\/g; 
    print ",$othertree";
    s/\\/\\\\/g;
    push (@unseen, $_);
  }
}
print "])";			# close the list of graphtrees
# Make sure the node the user's really interested in is visible
$topnode =~  s/\\/\\\\/g;  #escape backslashes for daVinci
print "\nfocus_node_animated (30, \"$topnode\")";

if ((!$dontwarn) && @unseen) {
  print "\nconfirmer(\"WARNING\",[\"Node(s) ", join (',',@unseen),
  " not connected. \",\"This could be an alias problem.\"],\"OK\")";
}

exit;

sub gettopnode {
  while (<INPUT>) {
    next if /^\s*$/;
    if (/\s*(transitions|graph)\s*\(?([^;\n]*)\)?;?\s*$/) {
      $topnode = $2;
      last;
    }
  }
}

sub getarrowtransitions {
  local ($node) = $topnode;
  while (<INPUT>) {#print "\nLine is $_, node is $node\n";
    chop;
    next if /^\s*$/;
    if (/--- (.*) ---> (.*)/) {
      unless ($colour{$node}) {
# we don't already know all about transitions from here, and this line
# gives us one, so grab it.
	($action = $1) =~ tr/ //d;
	($agent = $2) =~ tr/ //d;
	$transitions{$node} .= "$action -> $agent\n";
      }
    } elsif (/None/) {next;
    } else {
# we've found the next node. Colour the old one green and grab this next one.
      ($node eq $topnode) || ($colour{$node} = 'g');
      ($node) = /\s*(.*)\s*/;
      $node =~ tr/ //d;
    }
  }
# remember to colour the final node too, groan!
  $colour{$node} = 'g';  
}

sub readfc {
  local ($file) = @_;
  open (FILE, $file) || die $!;
  $state = 0;		       
  while (<FILE>) {
    ($topnode = "st_0") if /automaton "(.*)"/; # want all names, really
    next unless defined $topnode;
    $gotallatoms++ if /^state 0/;
    if (!$gotallatoms) {
      /^(\d*):\s*"(.*)"/ && ($atom{$1} = $2);
    } elsif (/^state/) {
      $node = $atom{$state};
      $state++;
    } elsif (/\d*:\s*a(\w*) -> (\w*)/) {
      ($action = $atom{$1}) || warn "No action for $1";
      ($agent = $atom{$2}) || warn "No agent for $2";
      $transitions{$node} .= "$action -> $agent\n";
#    print "Node $node action $action agent $agent\n";
    } elsif (/^end/) {		# do nothing
    } else {print ERRORS "Don't recognise $_";}
  }
}

sub doit {
  ($tree = &graphtree($topnode)) =~ s/\\/\\\\/g;#escape backslashes for daVinci
  print "new_term_placed([", $tree;# don't close brackets, there may be more
}

# If we've seen an agent before, we want a reference to it, otherwise, we 
# make a new node out of it. NB This really will build the whole graph
# (i.e. using all the transition info we have) from this node, because
# we call edges which calls edge which calls graphtree...
sub graphtree {
  local ($node) = @_;
  local ($graphtreedesc) = "";
  if ($seen{$node}++) {
    $graphtreedesc = "r(\"$node\")";
  } else {
    $colour = &lookupcolour($node);
    $graphtreedesc = "l(\"$node\",n($nodestring,[a(\"COLOR\",\"$colour\"),a(\"OBJECT\",\"$node\")],";
    $graphtreedesc .= &edges($node);
    $graphtreedesc .= "))";	# one for the l, one for the n
  }
  #print "graphtree on $node gave $graphtreedesc\n";
  $graphtreedesc;
}

sub lookupcolour {
  local ($node) = @_;
  local ($colour) = $colour{$node};
  local ($return);
  if ($colour eq 'y') {
    $return = 'yellow';	
# make it green for next time
    $colour{$node} = 'g';
  } elsif ($colour eq 'g') {
    $return = 'green';
  } else {
    $return = 'white';
  }
  $return;
}

# builds a daVinci representation of the transitions from the given agent 
sub edges {
  local ($node) = @_;
  local ($edgesdesc) = "";
  local(@nextsteps, @parts);
  @nextsteps = split (/\n/, $transitions{$node});#print "Size $#nextsteps\n";
  for (@nextsteps) {
    ($action, $agent) = /(.*) -> (.*)/; 
    #print "\n Got $node -> $action -> $agent\n";
    push (@parts, &edge($node, $action, $agent));
  }
  $edgesdesc = "[".join(',',@parts)."]";
  #print "edges on $node gave $edgesdesc\n";
  $edgesdesc;
}


# This gives an "edge" which actually includes a dummy node in the middle 
# to carry the edge label. NB It also gives the graph at the bottom of
# the edge, calling graphtree on the bottom, and so on!
sub edge {
  local ($top, $action, $bottom) = @_;
  local ($edgedesc) = "";
  $edgedesc = "l(\"edge$top->$action->$bottom\",e($edgestring,$edgeattributes1,l(\"DUMMY$top->$action->$bottom\",n($nodestring,[a(\"COLOR\",\"white\"),a(\"OBJECT\",\"$action\"),a(\"_GO\",\"text\")],[l(\"edge$bottom<-$action<-$top\",e($edgestring,$edgeattributes2,";
  $edgedesc .= &graphtree($bottom);
  $edgedesc .= "))]))))";	# you counted 'em out, now count 'em in!
  #print "edge on $top $action $bottom gave $edgedesc\n";
  $edgedesc;
}