From 43ad0da50e00c5d7cc14613f55d09e5ef3ea56e1 Mon Sep 17 00:00:00 2001
From: Stephan Barth <barths@gate2.tcs.ifi.lmu.de>
Date: Mon, 17 May 2021 15:17:52 +0000
Subject: [PATCH] Visualisierungsprototyp hochgeladen.

---
 tools/visualize/Graphy.pm  | 138 +++++++++++++++++++++++
 tools/visualize/WFparse.pm |  90 +++++++++++++++
 tools/visualize/gui.pl     | 219 +++++++++++++++++++++++++++++++++++++
 3 files changed, 447 insertions(+)
 create mode 100644 tools/visualize/Graphy.pm
 create mode 100644 tools/visualize/WFparse.pm
 create mode 100755 tools/visualize/gui.pl

diff --git a/tools/visualize/Graphy.pm b/tools/visualize/Graphy.pm
new file mode 100644
index 0000000..ab288d8
--- /dev/null
+++ b/tools/visualize/Graphy.pm
@@ -0,0 +1,138 @@
+package Graphy;
+
+use strict;
+use warnings;
+
+use Tk;
+use Data::Dumper;
+
+# show the graph on a canvas and generate click hook (x,y -> name)
+sub display {
+  my ($can, # canvas
+  $vertices, # hash ref; name -> x=>..,y=>..,col?=>..
+  $edges, # array ref; {from=>..,to=>..,col=>..}
+  $selected, # array ref, what to highlight
+  $config, # display configuration
+  ) = @_;
+  my $keysstring = join ' ', keys %$vertices;
+  my $sep = '#';
+  $sep.=('#',':',',')[int rand 3] while $keysstring=~m/$sep/;
+  my %edgecollect = ();
+  for my $con(@$edges) {
+    my $u = $con->{from};
+    my $v = $con->{to};
+    next if $u eq $v; # XXX self loops thrown away, do not work, yet
+    my $dir = 1;
+    if($u gt $v) {
+      ($u,$v) = ($v,$u);
+      $dir = -1;
+    }
+    my $at = "$u$sep$v";
+    push @{$edgecollect{$at}}, {u=>$u,v=>$v,dir=>$dir,con=>$con};
+  }
+  for my $k(keys %edgecollect) {
+    my %has = ();
+    my ($u,$v) = ();
+    for(@{$edgecollect{$k}}) { $has{$_->{dir}} = 1; ($u,$v) = @{$_}{'u','v'}}
+    if(keys %has > 1) {
+      push @{$edgecollect{$k}}, {u=>$u,v=>$v,dir=>0,con=>undef}
+    }
+    $edgecollect{$k} = [sort {
+      $a->{dir} <=> $b->{dir} ||
+      $a->{con}->{col} cmp $b->{con}->{col}
+    } @{$edgecollect{$k}}]
+  }
+  for my $conr(values %edgecollect) {
+    #print ">> $conr\n";
+    #print Data::Dumper::Dumper($conr);
+    my ($u,$v) = ();
+    for(@{$conr}) { ($u,$v) = @{$vertices}{@{$_}{'u','v'}} }
+    #print "<<$u $v>>\n";
+    my ($x0,$y0) = @{$u}{'x','y'};
+    my ($x1,$y1) = @{$v}{'x','y'};
+    my $dx = $x1-$x0;
+    my $dy = $y1-$y0;
+    my $normsq = $dx*$dx + $dy*$dy;
+    my $norm = sqrt $normsq;
+    my $rx = $dx/$norm*$config->{circr};
+    my $ry = $dy/$norm*$config->{circr};
+    my $horx = -$dy/$norm*$config->{linescale}*1.4;
+    my $hory = $dx/$norm*$config->{linescale}*1.4;
+    for(0..$#$conr) {
+      my $con = $conr->[$_];
+      #print Data::Dumper::Dumper($con);
+      if($con->{dir} != 0) {
+        my $col = $con->{con}->{col};
+        my $hor = $_-$#$conr/2;
+        my $smallrad = $config->{linescale}*1.5;
+        my $tx0 = $x0 + $horx*$hor;
+        my $ty0 = $y0 + $hory*$hor;
+        my $tx1 = $x1 + $horx*$hor;
+        my $ty1 = $y1 + $hory*$hor;
+        my ($hx,$hy) = ($tx0+$rx,$ty0+$ry);
+        ($hx,$hy) = ($tx1-$rx,$ty1-$ry) if $con->{dir} > 0;
+        $can->createOval($hx-$smallrad,$hy-$smallrad,$hx+$smallrad,$hy+$smallrad,-fill=>$col);
+        $can->createLine(
+          $tx0, $ty0,
+          $tx1, $ty1,
+          -width=>$config->{linescale},
+          -fill=>$col,
+        );
+      }
+    }
+  }
+#  for my $con(@$edges) {
+#    my ($x0,$y0) = @{$vertices->{$con->{from}}}{'x','y'};
+#    my ($x1,$y1) = @{$vertices->{$con->{to}}}{'x','y'};
+#    my $dx = $x1-$x0;
+#    my $dy = $y1-$y0;
+#    my $normsq = $dx*$dx + $dy*$dy;
+#    my $norm = sqrt $normsq;
+#    my $rx = $dx/$norm*$config->{circr};
+#    my $ry = $dy/$norm*$config->{circr};
+#    my $hx = $x1-$rx;
+#    my $hy = $y1-$ry;
+#    $can->createOval($hx-8,$hy-8,$hx+8,$hy+8,-fill=>$con->{col});
+#    $can->createLine(
+#      $x0, $y0,
+#      $x1, $y1,
+#      -width=>5,
+#      -fill=>$con->{col},
+#    );
+#  }
+  for my $k(keys %$vertices) {
+    my $v = $vertices->{$k};
+    my $text = $k;
+    $text=~s/&/&\n/gs;
+    $text=~s/\s+/\n/gs;
+    $text=~s/~\s+/ /gs;
+    $text=~s/~~/~/g;
+    $can->createOval($v->{x}-$config->{circr},$v->{y}-$config->{circr},$v->{x}+$config->{circr},$v->{y}+$config->{circr},-fill=>$v->{col});
+    $can->createText($v->{x}-1,$v->{y}-1,-fill=>'#ffffff',-text=>$text);
+    $can->createText($v->{x}+1,$v->{y}-1,-fill=>'#ffffff',-text=>$text);
+    $can->createText($v->{x}-1,$v->{y}+1,-fill=>'#ffffff',-text=>$text);
+    $can->createText($v->{x}+1,$v->{y}+1,-fill=>'#ffffff',-text=>$text);
+    $can->createText($v->{x}+2,$v->{y},-fill=>'#ffffff',-text=>$text);
+    $can->createText($v->{x}-2,$v->{y},-fill=>'#ffffff',-text=>$text);
+    $can->createText($v->{x},$v->{y},-fill=>'#000000',-text=>$text);
+  }
+
+  return sub {
+    my ($x,$y) = @_;
+    my $ret = undef;
+    my $bestd = -2;
+    for my $k(keys %$vertices) {
+      my $v = $vertices->{$k};
+      my $dx = $x-$v->{x};
+      my $dy = $y-$v->{y};
+      my $distsq = $dx*$dx + $dy*$dy;
+      if($bestd < -1 || $distsq < $bestd) {
+        $bestd = $distsq;
+        $ret = $k;
+      }
+    }
+    return $ret;
+  };
+}
+
+1;
diff --git a/tools/visualize/WFparse.pm b/tools/visualize/WFparse.pm
new file mode 100644
index 0000000..f61fd08
--- /dev/null
+++ b/tools/visualize/WFparse.pm
@@ -0,0 +1,90 @@
+package WFparse;
+
+use strict;
+use warnings;
+
+sub parsefile {
+  my $fn = shift;
+  my $fh = undef;
+  open($fh, '<', $fn) or die "Could not read '$fn', because: $!\n";
+  my @cont = <$fh>;
+  chomp for @cont;
+  return parselines(@cont);
+}
+
+sub parselines {
+  my @cont = @_;
+  my %node = ();
+  my $name = undef;
+  my $edgeto = undef;
+  my $state = "init";
+  my $source = undef;
+  my @linebuffer_master = ();
+  my @linebuffer_edges = ();
+  my %edges = ();
+  my $consumeedge = sub {
+    return if $state eq 'node-edges';
+    return unless $state =~ m/^node-edges/;
+    $edges{$edgeto} = {lines=>[@linebuffer_edges],source=>$source};
+    $source = undef;
+    @linebuffer_edges = ();
+    $edgeto = undef;
+  };
+  my $finalizenode = sub {
+    return if $state eq 'init';
+    $consumeedge->();
+    $node{$name}={
+      lines=>[@linebuffer_master],
+      edges=>{%edges},
+    };
+    @linebuffer_master = ();
+    %edges = ();
+    $name=undef;
+  };
+  for my $i(0..$#cont) {
+    my $l = $cont[$i];
+    do {push @linebuffer_master, $l;next} if $l=~m/^\s*(?:#.*)?$/;
+    $l=~m#^"(.*)":$# and do {
+      $finalizenode->();
+      $state = 'node-master';
+      $name = $1;
+      next;
+    };
+    $state eq 'node-master' && $l=~m#^  edges:$# and do {
+      $state = 'node-edges';
+      next;
+    };
+    $state=~m/^node-edges/ && $l=~m/^    "(.*)":/ and do {
+      my $ename = $1;
+      $consumeedge->();
+      $edgeto = $ename;
+      $state = "node-edges-inedge";
+      next;
+    };
+    $state=~m/node-edges/ && $l=~m/^      source: "(.*)"/ and do {
+      $source = $1;
+      next;
+    };
+    $state=~m/node-edges/ && $l=~m/^    (.*)/ and do {
+      push @linebuffer_edges, $1;
+      next;
+    };
+    $state=~m/node-edges/ && $l=~m/^  (.*)/ and do {
+      my $read = $1;
+      $consumeedge->();
+      $state = "node-master";
+      push @linebuffer_master, $read;
+      next;
+    };
+    $state=~m/node-master/ && $l=~m/^  (.*)/ and do {
+      push @linebuffer_master, $1;
+      next;
+    };
+    die "Unexpeced line in state $state: $l (line ".($i+1).")\n";
+  }
+  return (\%node);
+}
+
+
+
+1;
diff --git a/tools/visualize/gui.pl b/tools/visualize/gui.pl
new file mode 100755
index 0000000..8d2d1b3
--- /dev/null
+++ b/tools/visualize/gui.pl
@@ -0,0 +1,219 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use YAML::XS;
+use Data::Dumper;
+use Tk;
+use Math::Trig;
+
+BEGIN {
+  my $pwd = $0;
+  $pwd=~s#/[^/]+$##;
+  push @INC, $pwd;
+};
+
+use Graphy;
+use WFparse;
+
+my $fn = shift;
+die unless -e $fn;
+
+my $maindata = WFparse::parsefile($fn);
+
+#my $fh = undef;
+#open($fh, '<', $fn) or die "Could not open $fn, as: $!";
+#my $data = join '', <$fh>;
+#close $fh;
+#
+#my $yaml = Load($data);
+#
+##print "<<<<<<< ", ref $yaml;
+#
+#$yaml = {nodes => $yaml}
+#  unless
+#  1 == %$yaml and exists $yaml->{nodes}
+#  #'HASH' eq ref $yaml
+#  ;
+#
+#print Dumper($yaml);
+#
+#print "Analyze \$yaml\n";
+#for my $k(keys %$yaml) {
+#  print "  Key found: $k\n";
+#}
+#
+#my $nodes = $yaml->{nodes};
+#
+#print "Analyze \$nodes\n";
+#for my $k(keys %$nodes) {
+#  print "  Key found: $k\n";
+#}
+#
+#print Dumper($nodes->{antrag});
+#
+#my $onenode = $nodes->{antrag};
+#
+#print "Analyze \$onenode\n";
+#for my $k(keys %$onenode) {
+#  print "  Key found: $k\n";
+#}
+#
+#my $edges = $onenode->{edges};
+#
+#print Dumper($edges);
+#
+#
+#for my $nk(sort keys %$nodes) {
+#  my $ed = $nodes->{$nk}->{edges};
+#  for my $ek(sort keys %$ed) {
+#    my $src = '  (thin air)';
+#    $src = $ed->{$ek}->{source} if $ed->{$ek}->{source};
+#    print "$src   --$ek-->   $nk\n";
+#  }
+#  #print "  Key found: $k\n";
+#}
+
+my %xy = (); # xy-extradata, where it is not stated in the yaml
+
+my %nodes = %$maindata;
+
+my %layout = (
+  width=>800,
+  height=>800,
+  horsplit=>0.5,
+  vertsplit=>0.5,
+);
+
+my @nodekeys = sort keys %nodes;
+for my $i(0..$#nodekeys) {
+  my $nk = $nodekeys[$i];
+  my $phi = ($i/@nodekeys) * 2 * pi;
+  my $x = 400 + 300*sin $phi;
+  my $y = 400 + 300*cos $phi;
+  #$x = $nodes->{$nk}->{x}*800 if $nodes->{$nk}->{x};
+  #$y = $nodes->{$nk}->{y}*800 if $nodes->{$nk}->{y};
+  $xy{$nk} = [$x,$y];
+}
+
+my $main = MainWindow->new();
+my $can = $main->Canvas(-width=>800,-height=>800,-background=>'#000000')->pack(-side=>'left');
+my $texte = $main->Frame->pack(-side=>'left');
+my $knotentext = $texte->Text->pack;
+my $knotenwahl = $texte->Frame->pack(-expand=>1,-fill=>'x');
+my $kantentext = $texte->Text->pack;
+
+my $zentrierer = $knotenwahl->Canvas(-width=>80,-height=>80,-background=>'#000044')->pack(-side=>'left');
+my $filler = $knotenwahl->Frame->pack(-side=>'left',-expand=>1,-fill=>'x');
+#$knotenwahl->Label(-text=>'Foo')->pack(-side=>'left',-expand=>1,-fill=>'x');
+
+my $picker = sub {return undef};
+
+my @hl = ();
+
+$can->Tk::bind('<1>' => [sub {
+  my (undef, $x, $y) = @_;
+  my $got = $picker->($x,$y);
+  if(defined $got) {
+    push @hl, $got;
+    shift @hl if @hl > 2;
+    show();
+  }
+}, Ev('x'), Ev('y')]);
+
+$can->Tk::bind('<3>' => [sub {
+  my (undef, $x, $y) = @_;
+  @hl = ();
+  show();
+}, Ev('x'), Ev('y')]);
+
+
+show();
+
+MainLoop;
+
+sub show {
+  $can->delete('all');
+  my %pts = ();
+  my @trans = ();
+  for my $nk(sort keys %nodes) {
+    my $ed = $nodes{$nk}->{edges};
+    for my $ek(sort keys %$ed) {
+      my ($xt,$yt) = @{$xy{$nk}};
+      my $src = '  (thin air)';
+      my ($xs,$ys) = ($xt,$yt);
+      if($ed->{$ek}->{source}) {
+        $src = $ed->{$ek}->{source};
+        print "$src   --$ek-->   $nk\n";
+        ($xs,$ys) = @{$xy{$src}};
+      } else {
+        $_ = $_-400 for $xs,$ys;
+        $_ = $_*1.3 for $xs,$ys;
+        my $dx = $ys*0.3;
+        my $dy = -$xs*0.3;
+        $xs += $dx;
+        $ys += $dy;
+        $_ = $_+400 for $xs,$ys;
+        $src = "$nk (thin~ air)";
+        $pts{$src} = {x=>$xs,y=>$ys,col=>'#8888aa'};
+      }
+      #$can->createLine($xs,$ys,$xt,$yt,-fill=>'#ffffff',-width=>3);
+      push @trans, {from=>$src, to=>$nk, col=>'#ffffff'}
+    }
+    #print "  Key found: $k\n";
+    my ($x,$y) = @{$xy{$nk}};
+    $pts{$nk} = {x=>$x,y=>$y,col=>'#8888aa'};
+  }
+  $picker = Graphy::display(
+    $can,
+    \%pts,
+    \@trans,
+    [],
+    {circr=>42, linescale=>5}
+  );
+  {
+  my ($x0,$y0,$x1,$y1) = ();
+  if($hl[0]) {
+    my $o = $nodes{$hl[0]};
+    ($x0, $y0) = @{$xy{$hl[0]}};
+    my $r = 46;
+    $can->createOval($x0-$r,$y0-$r,$x0+$r,$y0+$r,-fill=>undef,-outline=>'#ff00ff',-width=>6);
+  }
+  if($hl[1]) {
+    my $o = $nodes{$hl[1]};
+    ($x1, $y1) = @{$xy{$hl[1]}};
+    my $r = 50;
+    $can->createOval($x1-$r,$y1-$r,$x1+$r,$y1+$r,-fill=>undef,-outline=>'#ff00ff',-width=>9);
+    my $minr = 12;
+    $can->createOval($x1-$minr,$y1-$minr,$x1+$minr,$y1+$minr,-fill=>'#8800ff',-outline=>'#ffffff');
+    $can->createLine($x0,$y0,$x1,$y1,-fill=>'#8800ff',-width=>$minr);
+  }
+  }
+}
+
+sub show_ {
+  $can->delete('all');
+  for my $nk(sort keys %nodes) {
+    my $ed = $nodes{$nk}->{edges};
+    for my $ek(sort keys %$ed) {
+      my ($xt,$yt) = @{$xy{$nk}};
+      my $src = '  (thin air)';
+      my ($xs,$ys) = ($xt,$yt);
+      if($ed->{$ek}->{source}) {
+        $src = $ed->{$ek}->{source};
+        print "$src   --$ek-->   $nk\n";
+        ($xs,$ys) = @{$xy{$src}};
+      } else {
+        $_ = ($_-400)*1.2+400 for $xs,$ys;
+      }
+      $can->createLine($xs,$ys,$xt,$yt,-fill=>'#ffffff',-width=>3);
+    }
+    #print "  Key found: $k\n";
+  }
+  for my $nk(sort keys %nodes) {
+    my ($x,$y) = @{$xy{$nk}};
+    $can->createOval($x-7,$y-7,$x+7,$y+7,-fill=>'#ffffff');
+    $can->createText($x,$y,-fill=>'#8888ff',-text=>$nk);
+  }
+}