view release on metacpan or  search on metacpan

lib/RTF/Writer/TableRowDecl.pm  view on Meta::CPAN

#--------------------------------------------------------------------------

sub clone {
  # sufficient to our task, I think
  bless [ map {;
            (!defined $_) ? undef
            : (ref($_) eq 'ARRAY') ? [@$_]
            : (ref($_) eq 'HASH' ) ? {%$_}
            : $_
          } @{$_[0]}
        ],
        ref $_[0];
}

#--------------------------------------------------------------------------

sub make_border_decl {
  my($it, @params) = @_;
  my @borders;

  $it->[3] = \@borders;

  unless( @params and grep defined($_), @params ) {
    @params = ('1');
  }

  @params = @{$params[0]} if @params == 1 and ref $params[0];
   # I.e., if they passed border => [...] 
  @params = "all-$DEFAULT_BORDER_WIDTH-s"
   if @params == 1 and $params[0] eq '1';
   #  if they passed just border => 1
  
  foreach my $spec (@params) {
    push @borders, $it->_borderspec2bordercode($spec);
  }
  
  return;
}
#--------------------------------------------------------------------------

sub make_alignment_decl {
  my($it,@alignments) = @_;
  my(@valign, @halign);
  $it->[4] = \@valign;
  $it->[5] = \@halign;

  unless(@alignments and grep defined($_), @alignments) {
    # most common case: nothing
    push @valign, '';
    push @halign, '';
    return;
  }
  
  if( @alignments != 1) {
    # Pass thru (altho normally impossible)
  } elsif( ref $alignments[0] ) {
    @alignments = @{$alignments[0]}
    # I.e., they passed align => [...] 
  } else {
    @alignments =  grep length($_), split m/(?:\s*,\s*)|\s+/, $alignments[0];
    # I.e., they passed in align => 'sw c c t' or 'sw, c, t' or whatever.
  }
  
  my($x, $v, $h);
  foreach my $spec (@alignments) {
    unless(defined $spec and length $spec) {
      push @valign, '';
      push @halign, '';
      DEBUG and printf " - => valign -             halign -\n";
      next;
    }
    $x = $Align_Directions{$spec};
    unless($x) {
      require Carp;
      Carp::croak "Unintelligible alignment spec \"$spec\"";
    }
    die "WHAAAAA? [$x]" unless 2 == length $x;  # sanity
    my($v,$h) = split '', $x;
    push @valign, "\\clvertal$v";
    push @halign, "\\q$h";
    DEBUG and printf "% 2s => valign %s    halign %s\n",
     $spec, $valign[-1], $halign[-1];
  }
  
  return;
}

#--------------------------------------------------------------------------
sub _borderspec2bordercode {

  my($it, $spec) = @_;

  $spec = 'all' unless defined $spec and length $spec;
  return '' if lc($spec) eq 'none';
  
  $spec = "all-$spec-s" if $spec =~ m/^\d+$/s;

  my @widths = (undef, undef, undef, undef);
  my @styles = (undef, undef, undef, undef);

  my($dir, $width, $style);
  my @specs = split m/(?:,|\s+)/, $spec;
  
  foreach my $it (@specs) {
    next unless $it;

    unless( ($dir, $width, $style) =  $it =~
     m/
      ^\s*
      (all|[nsewNSEWtbrlTBRL])
      (?:-(\d+))?
      (?:-([a-z]+))?
      \s*
      $
     /xs
    ) {
      require Carp;
      Carp::croak "Unintelligible cell-border spec \"$spec\"";
    }
    
    $width = $DEFAULT_BORDER_WIDTH unless defined $width and length $width;

    #print " $it => [$dir] [$width] [$style]\n";

    $style ||= 's';
      
    if($dir eq 'all') {
      @widths = ($width) x 4;
      @styles = ($style) x 4;
    } else {
      $dir = $Directions{$dir};
      $widths[$dir] = $width;
      $styles[$dir] = $style;
    }
  }

  my @out;
  foreach my $i (0 .. 3) {
    next unless $styles[$i];
    push @out, sprintf '\clbrdr%s\brdrw%s\brdr%s',
      $tabledirs[$i],
      $widths[$i],
      $styles[$i],
    ;
  }
  return join "\n", @out;
}

#--------------------------------------------------------------------------

sub new_auto_for_rows {
  my $class = shift;
  my $max_cols = 1;
  foreach my $r (@_) {
    next unless defined $r and ref $r eq 'ARRAY';
    $max_cols = @$r if @$r > $max_cols;
  }
  return
   $class->new( 'width' => [ ((6.5 * 1440) / $max_cols) x scalar(@_) ] );
}

#--------------------------------------------------------------------------