#!/usr/bin/perl

my $options;
if (@ARGV) {
  my ($hspc, $vspc, $minslp) = @ARGV;
  $vspc = $hspc unless defined $hspc;
  $minslp = 1/4 unless  defined $minslp;
  $options = {SPACING => [$hspc, $vspc, $minslp]};
}

sub layout_tree {
  my ($tree, $hash) = @_;
  local *Tree::OPTION = $hash if defined $hash;
  local *Glue::SPACING = $hash->{SPACING} || [2, 1, 0.20];
  my $c = Tree::Canvas->new;
  Glue->new($tree)->make_tree($c);
  $c->{CANVAS};
}

package Glue;
@Glue::ISA = 'Tree';

sub new {
  my $package = shift;
  my $t = shift;
  bless \$t => $package;
}

sub children {
  my $self = shift;
  map Glue->new($_), $$self->children;
}

sub text {
  my $self = shift;
  $$self->text;
}

sub spacing {
  @Glue::SPACING;
}

package Tree;
use strict;

# TODO: LEFT_ALIGN doesn't really work

our %OPTION = (CENTERED_ATTACHMENTS => 0,
               LEFT_ALIGN => 0,
              );

sub max {
  my $max = shift;
  for (@_) {
    $max = $_ if $_ > $max;
  }
  return $max;
}

sub min {
  my $min = shift;
  for (@_) {
    $min = $_ if $_ < $min;
  }
  return $min;
}

# lays out entire subtree
# in scalar context returns [$w, $h] of tree from this node
# in list context returns ([$w, $h], subtrees...)
sub tree_size {
  my ($node) = @_;

  # base size of the node itself
  my ($nw, $nh) = $node->node_size;

  # spacing parameters
  my ($HSPC, $VSPC, $MINSLOPE) = $node->spacing;

  # Do the subtrees.  First figure out their total size
  my @ss = map scalar($_->tree_size), $node->children;

  my ($tsw, $tsh) = $node->subtree_size(@ss);
  my ($tw, $th) = $node->total_size($tsw, $tsh);

  wantarray ? ([$tw, $th], @ss) : [$tw, $th];
}

sub make_tree {
  # rx, ry: desired position of root node
  my ($node, $canvas, $rx, $ry) = (@_, 0, 0);

  # base size of the root node
  my ($nw, $nh) = $node->node_size;

  # spacing parameters
  my ($HSPC, $VSPC, $MINSLOPE) = $node->spacing;

  # $tw, $th: width and height of this entire tree
  # @ss: sizes of subtrees
  my ($ts, @ss) = $node->tree_size;
  my ($tsw, $tsh) = $node->subtree_size(@ss);
  my       @sn  = $node->children;
  my ($tw, $th) = @$ts;

  # Here's my box
  $canvas->putat($rx, $ry, $node->text);

  # amount by which the current subtree is offset to the left
  # initially it's half the total width of all subtrees
  my $left = $OPTION{LEFT_ALIGN} ? 0 : -1/2 * $tsw + $ss[0][0]/2; 

  # y position for the roots of all subtrees
  my $xht = ($tsw/2) * $MINSLOPE;
  my $sy = $ry + $nh/2 + max($VSPC, $xht); 
  for my $i (0 .. $#sn) {
    my ($sw, $sh) = @{$ss[$i]}; # subtree size
    my ($cw, $ch) = $sn[$i]->node_size; # subnode size

    #  x position for the root of this subtree
    my $sx = $rx + $left;
    $sn[$i]->make_tree($canvas, $sx, $sy + $ch/2);

    # Draw a line from this node to the subnode
#    print "sy=$sy; ch=$ch; sy-ch/2=", $sy-$ch/2, "\n";
    my ($x1, $y1, $x2, $y2) = ($rx, $ry+$nh/2, # south edge
                               $sx, $sy);      # north edge
    unless ($OPTION{CENTERED_ATTACHMENTS}) {
      $x1 = $rx - $nw/2 + ($i+1)*$nw/($#sn+2);
    }
    #    print STDERR "Drawing line from ($x1,$y1) to ($x2,$y2)\n";
    $canvas->line($x1, $y1, $x2, $y2, "no overwrite")
      if $sn[$i]->attached;

    $left += $ss[$i][0]/($OPTION{LEFT_ALIGN} ? 1 : 2) + $HSPC;
    if ($i < $#sn) { $left += $ss[$i+1][0]/2 }
  }
}

# Given a list of [width,height] pairs
# compute and return the total width and height
# assuming items are arrange horizontally
sub subtree_size {
  my $node = shift;
  my @s = @_;
  my ($HSPC) = $node->spacing;
  
  my $tw = 0;  # Total width of these items
  for (@_) { $tw += $_->[0] }
  $tw += (@_ - 1) * $HSPC if @_; # extra space between items

  my $th = max(map $_->[1], @_); # total height of items

  return ($tw, $th);
}

sub total_size {
  my ($node, $tsw, $tsh) = @_;
  my ($HSPC, $VSPC, $MINSLOPE) = $node->spacing;
  my ($nw, $nh) = $node->node_size;

  # Minimum extra height needed to ensure suff. large slope of lines
  my $xht = ($tsw/2) * $MINSLOPE;
  # Total height: subtrees, plus this node, plus the intervening space
  my $th = $tsh + $nh + max($VSPC, $xht); # FIX ME: omit $VSPC if no subnodes

  # Total width: at least as wide as the node itself
  my $tw = max($tsw, $nw);
  return ($tw, $th);
}

sub node_size {
  my $self = shift;
  my $text = $self->text;
  return Tree::Canvas::sizeof($text);
}

sub attached { 1 }

package Tree::Canvas;
use Carp 'confess';

sub new {
  my $pack = shift;
  my $self = {CANVAS => [], OFFSET => [0, 0]};
  bless $self => $pack;
}

# $text is a reference to an array of lines
# [line1, line2, ...]
# A \0 character means that the item is transparent
sub putat {
  my ($self, $x, $y, $text, $novr) = @_;

  my ($w, $h) = sizeof($text);
  for my $r (0 .. $#$text) {
    my $line = $text->[$r];
    for my $c (0 .. length($line)-1) {
      my $ch = substr($line, $c, 1);
      if ($ch eq "\0") {
        die "No transparent things yet.\n";
        $self->[$y+$r][$x+$c] = " " unless defined $self->[$y+$r][$x+$c];
      } else {
        my ($xc, $yc) = ($x+$c-$w/2+0.5, $y+$r-$h/2+0.5);
        $self->plot($xc, $yc, $ch, $novr);
      }
    }
  }
}

sub pr {
  my $self = shift;
  for (@{$self->{CANVAS}}) {
    print;
    print "\n";
  }
}


# Graphics for drawing lines
#
# In this hash, the key is in two pairs of two symbols each.  Each
# pair of symbols represents the change to the X and Y coordinates as
# we move through the point of interest.  For example, what character
# should replace the X in 
#
#    *
#    X
#   *
#
# ?  To move from the top * to the X, the x coordinate increases by 0,
# and the y coordinate increases by 1, so the first pair of symbols is 01.
# To move from the X to the bottom *, the x coordinate increases by -1 
# and the y coordinate by 1, so the second pair of symbols is -1.
# The key is then "01-1" and the appropriate character is $plotchars{"01-1"}
# which is ')'.  
#
# Rule:  The y coordinate may not decrease.  If it does, you are 
# travelling in the wrong direction.  This leaves one ambiguity, which is
# that -*- might be "1010" or "-0-0".  We list both in the table.

my %plotchar = ("1110" => '`',  "1111" => '\\', "1101" => '\\',
                "01-1" => ')',  "0101" => '|',  "0111" => '(',
                "-1-0" => '\'', "-1-1" => '/',  "-101" => '/',
                "-0-1" => ',',  "-0-0" => '-',  "1011" => '.',
                                "1010" => '-',
               );


my $STEP = 1;
# Change to Brezenham
sub line {
  my $self = shift;
  my ($x1, $y1, $x2, $y2, $novr) = @_;
  my @p;                        # coordinates of plotted points
  my @c;                        # characters to plot
#  print STDERR "Drawing line from ($x1,$y1) to ($x2,$y2)\n";


  # Figure out which points we want to plot
  # Also get one extra point at the beginning and end
  # We will ignore these later when we actually do the plotting,
  # but first we will use them to figure out what graphic symbols
  # should appear at the line segment endpoints.
  if ($x2-$x1 == 0) {           # vertical special case
    ($x1, $y1, $x2, $y2) = ($x2, $y2, $x1, $y1) if $y1 > $y2;
    for (my $y=$y1-$STEP; $y <= $y2+$STEP; $y += $STEP) {
      push @p, [round($x1), round($y)];
    }
  } else {
    my $m = ($y1-$y2)/($x1-$x2);
    if (abs($m) > 1) {                 # steep line
      ($x1, $y1, $x2, $y2) = ($x2, $y2, $x1, $y1) if $y1 > $y2;
      for (my $y=$y1-$STEP; $y <= $y2+$STEP; $y += $STEP) {
        my $x = $x1 + ($y-$y1)/$m;
        push @p, [round($x), round($y)];
      }
    } else {                      # shallow line
      ($x1, $y1, $x2, $y2) = ($x2, $y2, $x1, $y1) if $x1 > $x2;
      my $ch = ($m ? '.' : '-');
      for (my $x=$x1-$STEP; $x <= $x2+$STEP; $x += $STEP) {
        my $y = $y1 + ($x-$x1)*$m;
        push @p, [round($x), round($y)];
      }
    }
  }

  # Now we know which points we're going to plot (@p)
  # Figure out what characters to plot at those points (@c)
  for my $i (1 .. $#p-1) {
    my ($X, $Y) = (0,1);
    my ($dx1, $dy1, $dx2, $dy2) ;
    ($dx1, $dy1) = map $p[$i][$_] - $p[$i-1][$_], $X, $Y;
    ($dx2, $dy2) = map $p[$i+1][$_] - $p[$i][$_], $X, $Y;
    if ($dy1 < 0 || $dy2 < 0) {
      # We're going in the wrong direction
      ($dx1, $dy1, $dx2, $dy2) = (-$dx2, -$dy2, -$dx1, -$dy1)
    }
    my $key = "";
    for ($dx1, $dy1, $dx2, $dy2) {
      $key .= ($_ > 0  ? '1' : 
              $_ == 0 ? '0' :
                        '-');
    }
    $c[$i] = $plotchar{$key} || "*";  # "*" is the last resort
    if ($c[$i] eq "*") {
      warn "peculiar key $key\n";
    }
  }

  # Now plot the points.
  # Ignore the two extra points that are past the endpoints
  for my $i (1 .. $#p-1) {
    my ($x, $y) = @{$p[$i]};
    my $c = $c[$i];
    $self->plot($x, $y, $c, $novr);
  }
}


use POSIX 'ceil', 'floor';
# Round to nearest integer.
# If argument is a half-integer, round to positive infinity
# It's important not to round away from zero here,
# because if you do, then 0.5 and -0.5 both round away from zero,
# and you end up with boxes that have a gap in them at the y axis.
sub round {
  my $a = shift;
  return int($a+0.5) if $a >= 0;
  my $f = $a - int($a);         # fractional part of $a
  $f == -0.5 ? int($a) : int($a-0.5);
}

sub plot {
  my ($self, $x, $y, $ch, $novr) = @_;
  ($x, $y) = (round($x), round($y)); # round off
  $ch = "." unless defined $ch;
  my ($xo, $yo) = @{$self->{OFFSET}};
  $x += $xo; $y += $yo;
  if ($y < 0) {
#    print STDERR "Downshifting$y\n";
    unshift @{$self->{CANVAS}}, ("") x -$y; # move everything down
    $self->{OFFSET}[1] += -$y;
    $y = 0;
  } 
  if ($x < 0) {
#    print STDERR "Rightshifting$x\n";
    for (@{$self->{CANVAS}}) {
      substr($_, 0, 0,  " "x -$x);    # move everything right
    }
    $self->{OFFSET}[0] += -$x;
    $x = 0;
  } 

  for ($self->{CANVAS}[$y]) {
    $_ = "" unless defined;
    if (length() < $x+1) {
      my $shortness = $x+1-length;
      $_ .= " " x $shortness;
    }
    my $c = substr($_, $x, 1, $ch);
    return unless $novr && $c ne " ";
    substr($_, $x, 1, $c); # no-overwrite mode - put it back the way it was
  }
  for (@{$self->{CANVAS}}) {
    print "OUCH!\n"  if /ARRAY/;
  }
}

# Measure a piece of text and return weidth and height in characters
sub sizeof {
  my $text = shift;
  my $h = @$text;
  my $w = 0;
  for (@$text) {
    $w = length if $w < length;
  }
  return ($w, $h);
}

# Take a piece of text and put it in a box
sub box {
  my $t = shift;
  my $boxed = ["", @$t, ""];
  for (@$boxed) {
    $_ = "|$_|";
  }
  my ($w) = sizeof($t);
  $boxed->[0] = $boxed->[-1] = "+" . ("-"x$w) . "+"; 
  $boxed;
}

# Take a piece of text and center it
sub center {
  my $t = shift;
  my $centered = [@$t];
  my ($w) = sizeof($t);
  for (@$centered) {
    my $spc = " " x (($w - length)/2);
    $_ = $spc . $_;
  }
  $centered;
}

1;

__END__
