Script 1 called tree-paths.pl currently

Usage:

tree-paths.pl 'family=Noyb; rel=marriage; mother=Susie Q; father=Gerald McBoing-Boing; children=Foo Q-Boing, Bar Q-Boing, Baz Q-Boing, Qux Q-Boing; gen=3;'

#!/usr/bin/perl
use strict;
use warnings;

use Fancy::Join qw(join_defined); # this can be replaced with join('',
+ defined()); for the $couple variable
use Util::Convert qw(idify);      # this can be removed from the make_
+ids sub

use SVG ();

# Note
## It appears the SVG module is not complete.
## When you see '->tag ', that means that tag was not exported by SVG.

sub make_ids {
  my $in = shift;
  ( my $no_space = $in) =~ s/\s//g;
  my $id = idify($no_space);
  return $id;
}

sub family_y {
  my ($gen, $num_parents) = @_;

  my $multiplier = $gen - 1;
  my $modifier   = $num_parents == 2 ? 0 : $num_parents == 1 ? 18 : 38
+;
  my $family_y = (-18 + (-76 * $multiplier)) + $modifier;

  return $family_y;
}

my $input = shift;
my $points = [ split(/; /, $input) ];

my $data;
for my $point (@$points) {
  my ($key, $value) = split(/\=/, $point);
  $data->{$key} = $value;
}

# Start the top of the svg

my $width  = 300;
my $height = 300;

my $svg = SVG->new( viewBox => "0 0 $width $height", width => $width, 
+height => $height);

# Start the family groups

my $family   = $data->{family};
my $gen      = $data->{gen};
my $mother   = $data->{mother};
my $father   = $data->{father};
my $children = $data->{children};

if ( $gen == 1 && $children ) {
  die "Generation 1 families do not have children, you might want gene
+ration 2. tree-paths.pl died$!";
}
my $Yyy     = $mother ? substr $mother, 0, 3 : undef;
my $Xxx     = $father ? substr $father, 0, 3 : undef;

my $moth_id = $mother ? make_ids($mother) : undef;
my $fath_id = $father ? make_ids($father) : undef;

my $couple  = join_defined(' and ', ($mother, $father));

my $num_parents = ($mother && $father) ? 2 :
                  ($mother || $father) ? 1 :
                  0;

my $rel_id  = $num_parents == 2 ? "$Yyy$Xxx" :
              $mother ? $moth_id :
              $father ? $fath_id :
              $family ? $family :
              undef;

my $rel     = $data->{rel} // undef;
my $abb_rel = $rel ? substr $rel, 0, 1 : undef;

my $couple_id = "$abb_rel$rel_id";

my $child_list  = $children ? [ split(/, /, $children) ] : undef;
my $child_ids   = $children ? [ map { make_ids($_) } @$child_list ] : 
+undef;
my $child_count = $children ? @$child_list : 0;

my $family_y = family_y($gen, $num_parents);

my $family_group;
my $child_group;

# Start the paths of relationship if both parents are known

if ( $num_parents == 2 ) {
  $family_group   = $svg->group( id => '', class => $rel, transform =>
+ "translate(79, $family_y)" );
  $family_group->tag('title')->cdata(ucfirst "$rel of $couple");
  $family_group->tag('path', d => 'm 0,0 h -19', id => "$couple_id-$mo
+th_id");
  $family_group->tag('path', d => 'm 0,0 h  19', id => "$couple_id-$fa
+th_id");
}

# End the paths of relationship if both parents are known
# Start the group for the children

if ( $child_count > 0 ) {
  my $id_prefix = $num_parents > 0 ? "c$rel_id" : "sib$rel_id";

  # Start section determining if children group stands alone.
  if ( $num_parents == 2 ) {
    $child_group = $family_group->group( id => "$family-children", cla
+ss => 'child' );
  }
  else {
    $child_group = $svg->group( id => "$family-siblings", class => 'ch
+ild', transform => "translate(30, $family_y)" );
  }

  # End section determining if children group stands alone.
  # Start paths for children
  # Start path for one child

  if ( $child_count == 1 ) {
    $child_group->tag('title')->cdata("$child_list->[0], child of $cou
+ple");
    $child_group->tag('path', d => 'm 0,0 v  58', id => "$couple_id-$c
+hild_ids->[0]");
  }

  # End path for one child
  # Start group for multiple children

  else {
    my $child_title = $num_parents > 0 ? "Children of $couple" : "$fam
+ily siblings";

    my $base_h  = -40;
    my $start_h = $base_h + (( $#$child_ids - 1 ) * -40);

    $child_group->tag('title')->cdata($child_title);
    $child_group->tag('path', d => 'm 0,0  v  38', id => "$couple_id-$
+id_prefix") if $num_parents > 0;
    for my $num (0..$#$child_ids) {
      $child_group->tag('path', d => "m 0,38 h $start_h v 20", id => "
+$id_prefix-$child_ids->[$num]");
      $start_h += 80;
    }

    $child_group->tag('circle', cx => '0', cy => '38', r => "1.5", id 
+=> "$id_prefix");

  # End group for multiple children
  }
}

# End the group for the children
# Start the circle of relationship of parents if both are known
## This circle had to come last.
## It covers the converging ends of the paths between the parents and 
+children.

if ( $num_parents == 2 ) {
  $family_group->tag('circle', cx => '0', cy => '0', r => "1.5", id =>
+ "$abb_rel$rel_id");
}

# End the circle of relationship of parents if both are known
# End the family groups

my $text = $num_parents == 2 ? $family_group->xmlify : $child_group->x
+mlify;
print "$text\n";
[download]

Script 2 called family-tree.pl currently. It hasn't been written to accept data yet.

#!/usr/bin/perl

use strict;
use warnings;
use feature qw(say);
use Data::Dumper;

use Fancy::Join qw(join_defined);

use SVG ();

sub gen_y {
  my $gen = shift;

  my $multiplier  = $gen - 1;
  my $gen_y = 36 + ( 76 * $multiplier);

  return $gen_y;
}

sub family_y {
  my ($gen, $two_parents, $one_parent) = @_;

  my $multiplier = $gen - 1;
  my $modifier   = $two_parents ? 0 : $one_parent ? 18 : 38;
  my $family_y = (-18 + (-76 * $multiplier)) + $modifier;

  return $family_y;
}

my $width  = 620;
my $height = 220;

my $chart_trans_y = $height - 5;
my $chart_title_y = ($chart_trans_y - 12) * -1;

my $family = 'Noyb';
my $source = 'me';

my $svg = SVG->new(
  'xmlns'       => "http://www.w3.org/2000/svg",
  'xmlns:xlink' => "http://www.w3.org/1999/xlink",
  'xmlns:rdf'   => "http://www.w3.org/1999/02/22-rdf-syntax-ns#",
  'xmlns:dc'    => "http://purl.org/dc/elements/1.1/",
  'xmlns:cc'    => "http://creativecommons.org/ns#",
  viewBox       => "0 0 $width $height",
  width         => $width,
  height        => $height
);

   $svg->tag('title', id => "svg_title" )->cdata(ucfirst "The $family 
+family from $source");

  my $metadata   = $svg->tag('metadata', id => "Family_metadata");
    my $md_rdf     = $metadata->tag('rdf:RDF');
      my $rdf_cc     = $md_rdf->tag('cc:work', 'rdf:about' => '');
         $rdf_cc->tag('dc:format')->cdata('image/svg+xml');
         $rdf_cc->tag('dc:type', 'rdf:resource' => 'http://purl.org/dc
+/dcmitype/StillImage');
         $rdf_cc->tag('dc:title')->cdata("The $family family from $sou
+rce");
        my $cc_creator = $rdf_cc->tag('dc:creator');
          my $dc_creator = $cc_creator->tag('cc:agent');
             $dc_creator->tag('dc:title')->cdata('me');
         $rdf_cc->tag('dc:language')->cdata('en-US');
         $rdf_cc->tag('dc:date')->cdata('2020-03');

   $svg->tag('style', id => "Family_styles", type => "text/css")->cdat
+a(q(
            @import url(../../../css/family_tree.css);
            g.deceased.male   rect { fill: url(#m_dead); }
            g.deceased.female rect { fill: url(#f_dead); }
        ));
  my $defs = $svg->tag('defs', id => "Family_defs");
  my $m_dead_grad = $defs->gradient( -type => "radial", id => "m_dead"
+);
     $m_dead_grad->stop( id => 'mds1', offset => '75%', style => 'stop
+-color:#ccccff;stop-opacity:0.85;');
     $m_dead_grad->stop( id => 'mds2', offset => '25%', style => 'stop
+-color:#eeeeff;stop-opacity:0.85;');
  my $f_dead_grad = $defs->gradient( -type => "radial", id => "f_dead"
+);
     $f_dead_grad->stop( id => 'fds1', offset => '75%', style => 'stop
+-color:#ffcccc;stop-opacity:0.85;');
     $f_dead_grad->stop( id => 'fds2', offset => '25%', style => 'stop
+-color:#ffeeee;stop-opacity:0.85;');

  my $tree = $svg->group( id => $source, class => 'graph', transform =
+> "translate(5, $chart_trans_y)" );
     $tree->tag('title')->cdata('');
     $tree->text( x => $width / 2, y => $chart_title_y, class => 'char
+t_title')->cdata("The $family family from $source");

  my $text = $svg->xmlify;
print "$text\n";
[download]