# file KLEIDER/web/src/pinw/Punktediagramm.pm
# Diagramm mit Punktwolken und C-Bezier-Linien
# 2020-07-31 Herbert Schiemann <h.schiemann@herbaer.de>

package Herbaer::Punktediagramm ;

BEGIN {
   our $xmloptions = {
      '@realrange'   => ["realrange",   "co"],
      '@outrange'    => ["outrange",    "co"],
      '@scloutrange' => ["scloutrange", "co"],
      '@points'      => ["points",      "pt"],
      '@scaled'      => ["scaled",      "pt"],
      '@size'        => ["size",        "co"],
      '@pt'          => ["pt",          "co"],
      '@sclyticks'   => ["sclyticks",   "tk"],
      '@yticks'      => ["yticks",      "tk"],
      '@sclxticks'   => ["sclxticks",   "tk"],
      '@xticks'      => ["xticks",      "tk"],
      '@xlabels'     => ["xlabels",     "lb"],
      '@ylabels'     => ["ylabels",     "lb"],
    };
}

use utf8;
use Herbaer::XMLDataWriter;
use POSIX qw(floor);

sub new {
   my ($class, $width, $height, $title) = @_;
   my $self = {
      "size"        => [$width, $height],
      "title"       => $title,
      "pointset"    => [],
      "cbezier"     => [],
      "realrange"   => undef,  # xmin, xmax, ymin, ymax
      "outrange"    => undef,
      "xticks"      => [],
      "xlabels"     => [],
      "yticks"      => [],
      "ylabels"     => [],
      "scloutrange" => [],
      "sclxticks"   => [],
      "sclyticks"   => [],
   };
   return bless ($self, $class);
} # new

sub add_pointset {
   my ($self, $cls, $points) = @_;
   _add ($self, $self -> {"pointset"}, $cls, $points);
} # add_pointset

sub add_cbezier {
   my ($self, $cls, $points) = @_;
   my $i;
   _add ($self, $self -> {"cbezier"}, $cls, $points);
} # add_cbezier

sub _add {
   my ($self, $s, $cls, $points) = @_;
   my $r = $self -> {"realrange"};
   my ($p, $x, $y);
   my ($xmin, $xmax, $ymin, $ymax);
   my $i;
   my $l = @$points;
   if ($l) {
      push (@$s, {"class" => $cls, "points" => $points,});
      $p = $points -> [0];
      ($x, $y) = (@$p);
      if ($r) {
         ($xmin, $xmax, $ymin, $ymax) = @$r;
      }
      else {
         $xmin = $xmax = $x;
         $ymin = $ymax = $y;
      }
      for ($i = 0; $i < $l; ++$i) {
         $p = $points -> [$i];
         ($x, $y) = @$p;
         if ($x < $xmin) {
            $xmin = $x;
         }
         elsif ($x > $xmax) {
            $xmax = $x;
         }
         if ($y < $ymin) {
            $ymin = $y;
         }
         elsif ($y > $ymax) {
            $ymax = $y;
         }
      }
      $self -> {"realrange"} = [$xmin, $xmax, $ymin, $ymax];
   }
   return $self;
} # _add

sub y_autorange {
   my ($self, $minticks) = @_;
   $minticks ||= 7;
   my $r = $self -> {"realrange"};
   return $self unless $r;
   my $rmin = $r -> [2];
   my $rmax = $r -> [3];
   my $d = ($rmax > $rmin ? $rmax - $rmin : $rmax > 0 ? $rmax : 1) / $minticks;
   my $t = 1;
   while ($t < $d) {$t *= 10;}
   while ($t > $d) {$t /= 10;}
   if    (5 * $t <= $d) { $t *= 5;}
   elsif (2 * $t <= $d) { $t *= 2;}
   y_autorange_step ($self, $t);
} # y_autorange

sub y_autorange_step {
   my ($self, $t) = @_;
   my $r = $self -> {"realrange"};
   return $self unless $r;
   my $rmin = $r -> [2];
   my $rmax = $r -> [3];
   my $min  = floor ($rmin / $t) * $t;
   my $tk   = [];
   my $i    = 0;
   my $max;
   for ($max = $min; $max < $rmax || !$i; $max = $min + (++$i * $t)) {
      push (@$tk, $max);
   }
   my $lb = map {sprintf ("%g", $_)} @$tk ;
   my $or = $self -> {"outrange"} //= [@$r];
   $or -> [2] = $min;
   $or -> [3] = $max;
   $self -> {"outrange"} = $or;
   $self -> {"yticks"}   = $tk;
   $self -> {"ylabels"}  = [ map {sprintf ("%g", $_)} (@$tk) ];
   return $self;
} # y_autorange_step

sub x_autoticks {
   my ($self, $minticks) = @_;
   $minticks ||= 7;
   my $r = $self -> {"outrange"} //= $self -> {"realrange"};
   return $self unless $r;
   my $min = $r -> [0];
   my $max = $r -> [1];
   my $tk = [];
   if ($max == $min) {
      $tk = [ $min ];
   }
   else {
      my $d = ($max - $min) / $minticks;
      my $t = 1;
      while ($t < $d) { $t *= 10; }
      while ($t > $d) { $t /= 10; }
      if    (5 * $t <= $d) { $t *= 5; }
      elsif (2 * $t <= $d) { $t *= 2; }
      my $t2 = $t / 2;
      my $s = (floor ($min / $t) + 1) * $t;
      $s += $t if $s < $min + $t2;
      my $i;
      my $p;
      for ($p = $s; $p + $t2 < $max; $p = $s + (++$i * $t)) {
         push (@$tk, $p);
      }
      push (@$tk, $max);
      $self -> {"xticks"}   = $tk;
      $self -> {"xlabels"}  = [ map {sprintf ("%g", $_)} @$tk ];
   }
   return $self;
} # x_autoticks

sub scale {
   my ($self, $sxmin, $sxmax, $symin, $symax) = @_;
   my $r = $self -> {"outrange"} //= $self -> {"realrange"};
   return $self unless $r;
   my ($xmin, $xmax, $ymin, $ymax) = @$r;
   if ($xmin == $xmax) {
      $xmin -= 1;
      $xmax += 1;
   }
   if ($ymin == $ymax) {
      $ymin -= 1;
      $ymax += 1;
   }

=for comment
   min -> smin
   max -> smax
   x   -> smin + (smax - smin) / (max - min) * (x - min)
          f * x + b
   f = (smax - smin) / (max - min)
   b = smin - min * (smax - smin) / (max - min)
     = ( smin * max - smin * min - min * smax + min * smin ) / (max - min)
     = ( max * smin - min * smax) / (max - min)
=cut
     
   my $fx = ($sxmax - $sxmin) / ($xmax - $xmin);
   my $fy = ($symax - $symin) / ($ymax - $ymin);
   my $bx = ($xmax * $sxmin - $xmin * $sxmax) / ($xmax - $xmin);
   my $by = ($ymax * $symin - $ymin * $symax) / ($ymax - $ymin);
   
   my $d;
   for $d (@{$self -> {"pointset"}}, @{$self -> {"cbezier"}}) {
      $d -> {"scaled"} = [
         map { [$fx * $_->[0] + $bx, $fy * $_->[1] + $by] }
         @{$d -> {"points"}}
         ];
   }
   $self -> {"sclxticks"} = [ map { $fx * $_ + $bx } @{$self -> {"xticks"}} ];
   $self -> {"sclyticks"} = [ map { $fy * $_ + $by } @{$self -> {"yticks"}} ];
   $self -> {"scloutrange"} = [$sxmin, $sxmax, $symin, $symax];
   return $self;
} # scale

sub write_xml {
   my ($self, $out) = @_;
   my $w = Herbaer::XMLDataWriter -> new (
      $xmloptions,
      "utf-8",
      "http://herbaer.de/xmlns/20200803/punktediagramm/"
      );
   $w -> open ($out);
   $w -> write ("punktediagramm", {}, $self);
   $w -> close ();
   return $self;
} # write_xml
   
1;

# end of file KLEIDER/web/src/pinw/Punktediagramm.pm