#!/usr/bin/perl -w
# file KLEIDER/web/src/pinw/posinfo_svg.pl
# SVG-Dateien zur Zerlegung der Pinwand
# 2020-06-30 Herbert Schiemann <h.schiemann@herbaer.de>

use utf8;                  # Dieser Quelltext ist utf-8-kodiert
use Herbaer::Readargs;     # read_args ()
use Herbaer::Placeholders; # Zähler-Platzhalter
binmode (STDIN,  ":encoding(utf-8)");
binmode (STDOUT, ":encoding(utf-8)");
binmode (STDERR, ":encoding(utf-8)");

my $args = {
   "[cnt]verbose" => undef,
   "in"           => "debuginfo",
   "svg"          => undef
};

# gibt die Version nach STDOUT aus
sub version {
   print << 'VERSION';
posinfo_svg.pl
SVG-Dateien zur Zerlegung der Pinwand
2020-06-30 Herbert Schiemann <h.schiemann@herbaer.de>
GPL 2 oder neuer
VERSION
};
$args -> {"[sr]version"} = sub { version (); exit 0; };

$args -> {"[sr]help"} = sub {
   set_default ($args);
   version ();
   print_message_with_values (<<"HELP", $args);
$0 --help     zeigt diese Hilfe an
$0 --version  zeigt die Programm-Version an

$0 [option]...
--[no_]verbose erhöht den Umfang der STDERR-Ausgabe \${[cnt]verbose}
--in  IN       Pfad der Eingabedatei \${in}
--svg SVG      Pfad der SVG-Ausgabedateien mit Zähler-Platzhalter \${svg}
HELP
   exit 0;
}; # help

sub set_default {
   my $args = shift;
   my $n;
   if (! $args -> {"svg"}) {
      $n = $args -> {"in"} || "svg";
      $n =~s/\.[^.]*//;
      $args -> {"svg"} = $n . '_${#dec}.svg';
   }
}; # set_default

my $data = [];

sub read_data {
   my ($args, $data) = @_;
   my $verb = $args -> {"[cnt]verbose"};
   print STDERR "read_data\n" if $verb;
   my $hin;
   my $in = $args -> {"in"};
   my $line;
   my $id   = {};   # Daten zur Positionierung eines Pinwandzettels
   my $flds = [];   # Liste der Zerlegungsfelder
   open ($hin, "<:encoding(utf-8)", $args -> {"in"}) or do {
      print STDERR "Kann Datei $in nicht öffnen: $!\n" if $verb;
   };
   while (defined ($line = <$hin>)) {
      # eine img - Zeile leitet die Daten zu einem neuen Pinwandzettel ein
      # img:0,0,358,149
      if ($line =~ /^img:(\d+),(\d+),(\d+),(\d+)\s*$/) {
         $flds = [];
         $id   = {
            "imgsize" => [$3 - $1, $4 - $2],
            "fields"  => $flds,
         };
         push (@$data, $id);
      }
      # `set:${self.rmx},${self.ctsq},${self.clpx},${self.clpy},${self.lvq}\n`;
      # set:1,0,2,2,1000000
      elsif ($line =~ /^set:(\d),(\d),(\d),(\d),(\S+)\s*$/) {
         $id -> {"rmx"}  = 0 + $1;
         $id -> {"ctsq"} = 0 + $2;
         $id -> {"clpx"} = 0 + $3;
         $id -> {"clpy"} = 0 + $4;
         $id -> {"lvq"}  = 0.0 + $5;
      }
      # links, oben, rechts, unten, ueberdeckungsfaktor, gewicht
      # `fld ${i}:${f[0]},${f[1]},${f[2]},${f[3]},${f[4]},${f[5]}\n`
      # fld 7:0,149,304,318,1e-12,0.007293747968
      elsif ($line =~ /^fld\s\d+:(\d+),(\d+),(\d+),(\d+),([0-9.eE+-]+),([0-9.eE+-]+)\s*$/) {
         push (@$flds, [0 + $1, 0 + $2, 0 + $3, 0 + $4, 0.0 + $5, 0.0 + $6]);
      }
      # `selfld:${f[0]},${f[1]},${f[2]},${f[3]},${f[4]},${f[5]}\n`
      # selfld:424,0,1920,873,1,309661384704
      elsif ($line =~ /^selfld:(\d+),(\d+),(\d+),(\d+),([0-9.eE+-]+),([0-9.eE+-]+)\s*$/) {
         $id -> {"selfld"} = [0 + $1, 0 + $2, 0 + $3, 0 + $4, 0.0 + $5, 0.0 + $6];
      }
      # `ltwh:${left},${top},${wd},${ht}\n`
      # ltwh:358,0,1920,873
      elsif ($line =~ /^ltwh:(\d+),(\d+),(\d+),(\d+)\s*$/) {
         $id -> {"left"}      = 0 + $1;
         $id -> {"top"}       = 0 + $2;
         $id -> {"totwidth"}  = 0 + $3;
         $id -> {"totheight"} = 0 + $4;
      }
   };
   close $hin;
}; # read_data

sub write_svg {
   my ($args, $data) = @_;
   my $verb = $args -> {"[cnt]verbose"};
   print STDERR "write_svg\n" if $verb;
   my $svgptn = $args -> {"svg"};  # Dateipfad mit Platzhaltern
   my $svg;                        # Dateipfad
   my $id;
   my $hout;
   my ($width, $height);
   my $fld;
   my ($l, $t, $r, $b, $f, $g);    # Felddaten
   my ($w, $h);                    # Bildbreite und -höhe
   my $lvq;                        # Überdeckungs-Quotient
   for $id (@$data) {
      $svg = subst_placeholders ($svgptn);
      print STDERR "file $svg\n" if $verb;
      $l = @{$id -> {"fields"}};
      print STDERR "$l Felder\n" if $verb;
      $hout = undef;
      open ($hout, ">:encoding(utf-8)", $svg) or do {
         print STDERR "Kann Datei $svg nicht ausgeben: $!\n" if $verb;
         next;
      };
      $width  = $id -> {"totwidth"} + 10;
      $height = $id -> {"totheight"} + 10;
      $lvq    = $id -> {"lvq"};
      print $hout <<"HEAD";
<?xml version = "1.0" encoding = "utf-8"?>
<svg xmlns = "http://www.w3.org/2000/svg" viewBox = "0 0 $width $height" version = "1.1">
<style>
path        { stroke: #000000; stroke-width: 4px; }
path.selfld { stroke: #FF4444; fill: none; }
path.img    { stroke: #44FF44; fill: none; }
.c0 { fill: #ffffff; }
.c1 { fill: #dddddd; }
.c2 { fill: #bbbbbb; }
.c3 { fill: #999999; }
.c4 { fill: #777777; }
.c5 { fill: #555555; }
.c6 { fill: #333333; }
</style>
<g transform = "translate(5 5)">
HEAD
      for $fld (@{$id -> {"fields"}}) {
         ($l, $t, $r, $b, $f, $g) = @$fld;
         $g = 0;
         while ($f < 1.0) {
            $f *= $lvq;
            ++$g;
         }
         print $hout "<path d = \"M$l ${t}H${r}V${b}H${l}z\" class = \"c${g}\"/>\n";
      }
      ($l, $t, $r, $b, $f, $g) = @{$id -> {"selfld"}};
      $g = 0;
      while ($f < 1.0) {
         $f *= $lvq;
         ++$g;
      }
      print $hout "<path d = \"M$l ${t}H${r}V${b}H${l}z\" class = \"selfld c${g}\" fill = \"none\"/>\n";
      ($w, $h) = @{$id -> {"imgsize"}};
      $l = $id -> {"left"};
      $t = $id -> {"top"};
      print $hout "<path d = \"M$l ${t}h${w}v${h}H${l}z\" class = \"img\" fill = \"none\"/>\n";
      print $hout "</g></svg>\n";
      close $hout;
   };
}; # write_svg

read_args   ($args);
set_default ($args);
read_data   ($args, $data);
write_svg   ($args, $data);

# end of file KLEIDER/web/src/pinw/posinfo_svg.pl