# SPDX-FileCopyrightText: 2022 Stephan Barth <barths@gate2.tcs.ifi.lmu.de>
#
# SPDX-License-Identifier: AGPL-3.0-or-later

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;