#!/usr/bin/env perl
package SequenceDiagram;
use 5.024;
use warnings;
use experimental qw< postderef signatures >;
no warnings qw< experimental::postderef experimental::signatures >;
use GD::Simple;
use Exporter 'import';
our @EXPORT_OK = (qw< sequence_diagram >);

sub sequence_diagram ($options, $messages) {
   my $instance = bless {$options->%*, messages => $messages}, __PACKAGE__;
   $instance->_precalculate;
   return $instance->_render->{img};
}

sub _arrow {
   my ($self, $x1, $y1, $x2, $y2) = @_;
   my ($img, $asx, $asy) = $self->@{qw< img arrow_size_x arrow_size_y >};

   $img->moveTo($x1, $y1);
   $img->lineTo($x2, $y2);

   my $tx = $x2 + ($x1 < $x2 ? -$asx : $asx);
   $img->lineTo($tx, $y2 - $asy);
   $img->moveTo($x2, $y2);
   $img->lineTo($tx, $y2 + $asy);

   return $self;
} ## end sub arrow

sub __middle { return $_[0]{x} + int(($_[0]{width} + 1) / 2) }

sub _precalculate ($self) {
   my ($mpx, $mdx) = $self->@{qw< msg_padding_x msg_distance_x >};
   $self->{img} = my $img = GD::Simple->new(1, 1); # temporary
   if ($self->{font}) {
      $img->font($self->{font});
      $img->fontsize($self->{fontsize}) if defined $self->{fontsize};
   }
   $self->{nodes} = \my @nodes;
   $self->{edges} = \my @edges;
   $self->@{qw< maxnh maxeh >} = (0, 0);
   my $id = 0;
   my %nf;
   for my $message ($self->{messages}->@*) {
      push @edges, \my @edge;

      # first two items in the edge are nodes, generated by node names
      push @edge, $nf{$_} //= $self->_precalculate_new_node($_, \@nodes)
         for $message->@[0, 1];

      # add the message text now, pre-pending it with an identifier
      my $text = ++$id . '.';
      $text .= ' ' . $message->[2] if length($message->[2] // '');
      push @edge, $text;

      # calculate how much space this text requires
      my ($width, $height) = $img->stringBounds($text);
      push @edge, $width;    # save this for later, too

      # update maximum height for a message's text
      $self->{maxeh} = $height if $height > $self->{maxeh};

      # move nodes to the right if the message does not fit
      my $needed_width = $width + 2 * $mpx + $mdx;
      my $available_width = abs(__middle($edge[1]) - __middle($edge[0]));
      if ((my $delta = $needed_width - $available_width) > 0) {
         my $rightmost = $edge[0]{x} > $edge[1]{x} ? $edge[0] : $edge[1];
         $nodes[$_]{x} += $delta for $rightmost->{index} .. $#nodes;
      }
   }

   return $self;
} ## end sub _sq_precalculate_layout

sub _precalculate_new_node ($self, $name, $nodes) {
   my $pn = $nodes->[-1];
   my $x = $pn ? ($pn->{x} + $pn->{width} + $self->{node_margin_x}) : 0;
   my ($width, $height) = $self->{img}->stringBounds($name);
   $width  += 2 * $self->{node_padding_x};
   $height += 2 * $self->{node_padding_y};
   $self->{maxnh} = $height if $self->{maxnh} < $height;
   push $nodes->@*, my $node = {
      x      => $x,        # might be moved to the right later
      name   => $name,
      width  => $width,
      height => $height,
      index  => scalar($nodes->@*),
   };
   return $node;
}

sub _render($self) {
   my ($nodes, $edges) = $self->@{qw< nodes edges >};
   my ($maxnh, $maxeh) = $self->@{qw< maxnh maxeh >};
   my ($mx, $my) = $self->@{qw< margin_x margin_y >};
   my $mpy = $self->{msg_padding_y};

   my $x_span = $nodes->[-1]{x} + $nodes->[-1]{width};
   my $y_span = $maxnh +
     scalar($edges->@*) * ($maxeh + 2 * $mpy) +
     $self->{life_continue_y} + $mpy;

   # make sure to add space for margins
   $self->{img} = GD::Simple->new($x_span + 2 * $mx, $y_span + 2 * $my);
   if ($self->{font}) {
      $self->{img}->font($self->{font});
      $self->{img}->fontsize($self->{fontsize})
         if defined $self->{fontsize};
   }

   # render messages first, end_y will track position of messages as we go
   $self->{end_y} = $my + $maxnh + 2 * $mpy + $maxeh;
   $self->_render_edge($_) for $edges->@*;

   # now render nodes
   $self->_render_node($_) for $nodes->@*;

   return $self;
} ## end sub sequence_diagram

sub _render_edge ($self, $edge) {
   my ($img, $mx, $mpx) = $self->@{qw< img margin_x msg_padding_x >};
   my ($from, $to, $text, $width) = $edge->@*;
   my ($fm, $tm) = (__middle($from), __middle($to));
   my $x = $self->{margin_x} + (
      ($fm < $tm) ? $fm + $mpx : $fm - $width - $mpx
   );
   $img->moveTo($x, $self->{end_y});
   $img->string($text);
   $self->_arrow($mx + $fm, $self->{end_y}, $mx + $tm, $self->{end_y});
   $self->{end_y} += $self->{maxeh} + 2 * $self->{msg_padding_y};
   return $self;
}

sub _render_node ($self, $node) {
   my ($img, $mx, $my, $maxnh) = $self->@{qw< img margin_x margin_y maxnh >};
   my $x = $node->{x};
   $img->rectangle(
      $mx + $x                 , $my,
      $mx + $x + $node->{width}, $my + $maxnh
   );
   $img->moveTo(
      $mx + $x + $self->{node_padding_x},
      $my + $maxnh - $self->{node_padding_y},
   );
   $img->string($node->{name});
   my $xm = $mx + __middle($node);
   $img->moveTo($xm, $my + $maxnh);
   $img->lineTo($xm,
      $self->{end_y} - $self->{msg_padding_y} -
         $self->{maxeh} + $self->{life_continue_y});
}

exit sub {
   my %options = (
      arrow_size_x    => 4,
      arrow_size_y    => 4,
      life_continue_y => 5,
      margin_x        => 20,
      margin_y        => 20,
      msg_padding_x   => 10,
      msg_padding_y   => 5,
      msg_distance_x  => 20,
      node_margin_x   => 5,
      node_padding_x  => 10,
      node_padding_y  => 10,
   );
   my @messages = (
      ['Thorrilo'  => 'Forgogrim', 'ororbisrod()'],
      ['Forgogrim' => 'Thorrilo',  'foradurdir()'],
      ['Thorrilo'  => 'Violetas',  'hobgoon()'],
      ['Violetas'  => 'Forgogrim', 'ereritur()'],
   );

   binmode STDOUT;
   print {*STDOUT} sequence_diagram(\%options, \@messages)->png;
   return 0;
}->(@ARGV) unless caller;

1;