#!/usr/bin/perl --
use strict; use warnings; use Data::Dump;
my $root =
[
[
[
[
[[["a", "b"], "c"], ["d", "e"]],
[[["f", "g"], "h"], [["i", "j"], ["k", ["l", "m"]]]],
#~ [[["a", "b"], "cc"], ["dd", "ee"]],
#~ [[["a", "b"], "ccc"], ["ddd", "eee"]],
],
["n", [[["o", "p"], "q"], ["r", "s"]]],
],
["t", ["u", "v"]],
],
[["w", ["x", "y"]], "z"],
];
my $leftstart = 1000;
my @lines;
my @rows;
my $leftestmost = 0;
my $rightestmost = 0;
Fudgy( $root, 0, 0, sub {
my($node, $x,$y,$px,$py, $leftoright ) = @_;
$leftestmost = $x if $x < 0 and $leftestmost > $x;
$rightestmost = $x if $x > 0 and $rightestmost < $x;
my $text = $node;
if( ref $node ){
my( $left, $right ) = @$node;
$text = '';
$text .= '/' if $left;
$text .= '\\' if $right;
}
my $xpd = abs(abs($px)-abs($x));
$x = $leftstart + $x;
push @{ $rows[ $y ] } , [ $x, $text , $px, $py , $xpd ];
my $lll = $lines[ $y ]; $lll ||= ' ' x ( 2 * $leftstart );;
substr $lll, $x, length($text), $text;
$lines[ $y ] = $lll;
if( $y > 0 ){
my $off = $x + 1;
my $rep = '_' x ( $xpd - 1 );
my $lline = $lines[ $y - 1];
if( $leftoright > 0 ){
$off -= length( $rep );
}
substr $lline, $off, length($rep),$rep;
$lines[ $y -1 ] = $lline;
}
} );
dd \@rows;
s/\s+$// for @lines;
$leftestmost = $leftstart + $leftestmost ;
s/^\s{$leftestmost}// for @lines;
print join "\n", @lines;
sub Fudgy {
my( $node , $x, $y, $subref ) = @_;
return if not @$node;
my( $left, $right ) = @$node;
$subref->( $node, $x, $y , $x, $y );
$left and draw_left( $left, $x , $y , $subref );
$right and draw_right($right, $x , $y , $subref );
}
sub draw_left {
my( $node , $px, $py, $subref ) = @_;
my $count = 0;
my( $left, $right ) = eval { @$node };
$right and $count = 1 + descendents_count( $right );
my $x = $px - $count - 1;
my $y = $py + 1;
$subref->( $node, $x, $y, $px, $py , -1 );
$left and draw_left( $left , $x, $y, $subref );
$right and draw_right( $right, $x, $y, $subref );
}
sub children_count {
return 1 if not ref $_[0];
return int @{ $_[0] };
}
sub descendents_count {
my( $node ) = @_;
my( $left, $right ) = eval { @$node };
my $count = 0;
$left and $count += 1 + descendents_count( $left );
$right and $count += 1 + descendents_count( $right );
return $count;
}
sub draw_right {
my( $node , $px, $py, $subref ) = @_;
my $count = 0;
my( $left, $right ) = eval { @$node };
$right and $count = 1 + descendents_count( $left );
my $x = $px + $count + 1;
my $y = $py + 1;
$subref->( $node, $x, $y, $px, $py , +1 );
$left and draw_left( $left , $x, $y, $subref );
$right and draw_right( $right, $x, $y, $subref );
}
__END__
__END__
__END__
__END__