# Copyright 2002-2007 Interchange Development Group and others
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: row.coretag,v 1.4 2007-03-30 23:40:49 pajamian Exp $

UserTag row                 Order        width
UserTag row                 hasEndTag
UserTag row                 Interpolate
UserTag row                 PosNumber    1
UserTag row                 Version      $Revision: 1.4 $
UserTag row                 Routine      <<EOR
sub tag_column {
my($spec,$text) = @_;
my($append,$f,$i,$line,$usable);
my(%def) = qw(
        width 0
        spacing 1
        gutter 2
        wrap 1
        html 0
        align left
      );
my(%spec)  = ();
my(@out)  = ();
my(@lines)  = ();

$spec =~ s/\n/ /g;
$spec =~ s/^\s+//;
$spec =~ s/\s+$//;
$spec = lc $spec;

$spec =~ s/\s*=\s*/=/;
$spec =~ s/^(\d+)/width=$1/;
%spec = split /[\s=]+/, $spec;

for(keys %def) {
  $spec{$_} = $def{$_} unless defined $spec{$_};
}

if($spec{'html'} && $spec{'wrap'}) {
  ::logError("tag_column: can't have 'wrap' and 'html' specified at same time.");
  $spec{wrap} = 0;
}

if(! $spec{align} or $spec{align} !~ /^n/i) {
  $text =~ s/\s+/ /g;
}

my $len = sub {
  my($txt) = @_;
  if (1 or $spec{html}) {
    $txt =~
    s{ <
         (
         [^>'"] +
          |
         ".*?"
          |
         '.*?'
        ) +
      >
    }{}gsx;
  }
  return length($txt);
};

$usable = $spec{'width'} - $spec{'gutter'};
return "BAD_WIDTH" if  $usable < 1;

if($spec{'align'} =~ /^[ln]/i) {
  $f = sub {
        $_[0] .
        ' ' x ($usable - $len->($_[0])) .
        ' ' x $spec{'gutter'};
        };
}
elsif($spec{'align'} =~ /^r/i) {
  $f = sub {
        ' ' x ($usable - $len->($_[0])) .
        $_[0] .
        ' ' x $spec{'gutter'};
        };
}
elsif($spec{'align'} =~ /^i/i) {
  $spec{'wrap'} = 0;
  $usable = 9999;
  $f = sub { @_ };
}
else {
  return "BAD JUSTIFICATION SPECIFICATION: $spec{'align'}";
}

$append = '';
if($spec{'spacing'} > 1) {
  $append .= "\n" x ($spec{'spacing'} - 1);
}

if($spec{'align'} =~ /^n/i) {
  @lines = split(/\r?\n/, $text);
}
elsif(is_yes($spec{'wrap'}) and length($text) > $usable) {
  @lines = wrap($text,$usable);
}
elsif($spec{'align'} =~ /^i/i) {
  $lines[0] = ' ' x $spec{'width'};
  $lines[1] = $text . ' ' x $spec{'gutter'};
}
elsif (! $spec{'html'}) {
  $lines[0] = substr($text,0,$usable);
}

foreach $line (@lines) {
  push @out , &{$f}($line);
  for($i = 1; $i < $spec{'spacing'}; $i++) {
    push @out, '';
  }
}
@out;
}

sub wrap {
  my ($str, $width) = @_;
  my @a = ();
  my ($l, $b);

  for (;;) {
      $str =~ s/^ +//;
      $l = length($str);
      last if $l == 0;
      if ($l <= $width) {
          push @a, $str;
          last;
      }
      $b = rindex($str, " ", $width - 1);
      if ($b == -1) {
          push @a, substr($str, 0, $width);
          $str = substr($str, $width);
      }
      else {
          push @a, substr($str, 0, $b);
          $str = substr($str, $b + 1);
      }
  }
  return @a;
}

sub {
  my($width,$text) = @_;
my($col,$spec);
my(@lines);
my(@len);
my(@out);
my($i,$j,$k);
my($x,$y,$line);

$i = 0;
while( $text =~ s!\[col(?:umn)?\s+
           ([^\]]+)
           \]
           ((?s:.)*?)
           \[/col(?:umn)?\] !!ix    ) {
  $spec = $1;
  $col = $2;
  $lines[$i] = [];
  @{$lines[$i]} = tag_column($spec,$col);
  # Discover X dimension
  $len[$i] = length(${$lines[$i]}[0]);
  if(defined ${$lines[$i]}[1] and ${$lines[$i]}[1] =~ /^<\s*input\s+/i) {
    shift @{$lines[$i]};
  }
  $i++;
}
my $totlen = 0;
for(@len) { $totlen += $_ }
if ($totlen > $width) {
  return " B A D   R O W  S P E C I F I C A T I O N - columns too wide.\n"
}

# Discover y dimension
$j = $#{$lines[0]};
for ($k = 1; $k < $i; $k++) {
  $j = $#{$lines[$k]} > $j ? $#{$lines[$k]} : $j;
}

for($y = 0; $y <= $j; $y++) {
  $line = '';
  for($x = 0; $x < $i; $x++) {
    if(defined ${$lines[$x]}[$y]) {
      $line .= ${$lines[$x]}[$y];
      $line =~ s/\s+$//
        if ($i - $x) == 1;
    }
    elsif (($i - $x) > 1) {
        $line  .= ' ' x $len[$x];
    }
    else {
      $line =~ s/\s+$//;
    }
  }
  push @out, $line;
}
join "\n", @out;
}
EOR