view release on metacpan or  search on metacpan

lib/App/ansicolumn.pm  view on Meta::CPAN

sub set_vertical {
    my $obj = shift;
    my $dp = shift;
    $obj->border_height = do {
	sum map { length > 0 }
	    map { $obj->get_border($_) }
	    qw(top bottom);
    };
    $obj->height ||= div(int @$dp, $obj->panes) + $obj->border_height;
    die "Not enough height.\n" if $obj->effective_height <= 0;
    return $obj;
}

sub page_out {
    my $obj = shift;
    my $name = shift;
    my $column_out = $obj->_column_out;
    for ($obj->current_page = 0; @_; $obj->current_page++) {
	my @columns = grep { @$_ } do {
	    if ($obj->fillrows) {
		xpose map { [ splice @_, 0, $obj->panes ] } 1 .. $obj->effective_height;
	    } else {
		map { [ splice @_, 0, $obj->effective_height ] } 1 .. $obj->panes;
	    }
	};
	$column_out->({ names => [($name) x scalar @columns] }, @columns);
    }
    return $obj;
}

sub color_border {
    my $obj = shift;
    $obj->color('BORDER', $obj->get_border(@_));
}

sub _parse_labels {
    my $hash = shift;
    return 0 unless %$hash;
    my %result;
    while (my($key, $s) = each %$hash) {
	next unless defined $s and $s ne '';
	my $offset;
	if ($s =~ s/@(\d+)$//) {
	    $offset = $1 + 0;
	}
	$s =~ s/%n/%1\$d/g;
	$s =~ s/%p/%2\$d/g;
	$s =~ s/%f/%3\$s/g;
	$s =~ s/%F/%4\$s/g;
	$result{lc $key} = [ $offset, $s ];
    }
    %result ? \%result : 0;
}

# Overlay labels onto a border line string.
# $fs/$fe: fill region start/end.
# $ml/$mr: border margin accessible via @0.
# $n/$p: pane number / page number for sprintf expansion.
# $file: filename (path as given) - used as %3$s (basename) and %4$s (path as given).
sub _overlay_labels {
    my($obj, $str, $fs, $fe, $ml, $mr, $n, $p, $file, $left, $center, $right) = @_;
    use File::Basename qw(basename);
    use Text::ANSI::Fold::Util qw(ansi_substr);
    my $base = defined $file ? basename($file) : '';
    for my $item (
	[ $left,   sub { $fs - $ml + ($_[0] // $ml) } ],
	[ $right,  sub { $fe + $mr - ($_[0] // $mr) - $_[1] } ],
	[ $center, sub { $fs + int(($fe - $fs - $_[1]) / 2) } ],
    ) {
	my($spec, $pos_fn) = @$item;
	next unless $spec;
	my $fmt = $spec->[1];
	next unless defined $fmt && $fmt ne '';
	my $text = $fmt =~ /%/ ? sprintf($fmt, $n, $p, $base, $file // '') : $fmt;
	my $lw = ansi_width($text);
	my $label = $obj->color('BORDER_LABEL', $text);
	$str = ansi_substr($str, $pos_fn->($spec->[0], $lw), $lw, $label);
    }
    $str;
}

sub _column_out {
    my $obj = shift;

    my %bd = map { $_ => $obj->get_border($_) } qw(top bottom);

    my $bl  = $obj->{_bl}  //= _parse_labels($obj->label);
    my $pbl = $obj->{_pbl} //= _parse_labels($obj->page_label);

    # pre-build pane label closures per pane index
    my(@pane_top, @pane_bottom, @page_top, @page_bottom);
    my($bw_l, $bw_c, $bw_r);
    if ($bl || $pbl) {
	$bw_l = ansi_width($obj->get_border('left',   0));
	$bw_c = ansi_width($obj->get_border('center', 0));
	$bw_r = ansi_width($obj->get_border('right',  0));
	my $span = $obj->{span};
	for my $set ([ \@pane_top, \@page_top, qw(nw n ne) ],
		     [ \@pane_bottom, \@page_bottom, qw(sw s se) ]) {
	    my($pane_list, $page_list, @keys) = @$set;
	    if ($bl) {
		my @g = map { $bl->{$_} } @keys;
		if (grep { $_ } @g) {
		    my $fp = $bw_l;
		    for my $i (0 .. $obj->panes - 1) {
			my($fs, $fe) = ($fp, $fp + $span);
			push @$pane_list, sub {
			    $obj->_overlay_labels($_[0], $fs, $fe, $bw_l, $bw_r,
				$_[1] + $i + 1, $_[2], $_[3], @g);
			};
			$fp += $span + $bw_c;
		    }
		}
	    }
	    if ($pbl) {
		my @g = map { $pbl->{$_} } @keys;
		if (grep { $_ } @g) {
		    push @$page_list, sub {
			my $w = ansi_width($_[0]);
			$obj->_overlay_labels($_[0], 1, $w - 1, 1, 1,
			    $_[1] + 1, $_[2], $_[3], @g);
		    };
		}
	    }
	}
    }

    my $has_labels = @pane_top || @pane_bottom || @page_top || @page_bottom;

    # pre-build border strings for 3 positions (top=0, middle=1, bottom=2)
    my %border;
    for my $pos (0, 1, 2) {
	$border{$pos} = {
	    left   => $obj->color_border('left',   $pos),
	    center => $obj->color_border('center', $pos),
	    right  => $obj->color_border('right',  $pos),
	};
    }

    my $print_border = sub {
	my($side, $pos, $span, $npanes, $n0, $p, $names,
	   $pane_labels, $page_labels) = @_;
	return unless $bd{$side};
	my $bd = $border{$pos};
	my $line = join '',
	    $bd->{left},
	    join($bd->{center},
		 map { $obj->color('BORDER', $bd{$side} x $_) } @$span),
	    $bd->{right};
	if (@$pane_labels) {
	    my $i = 0;
	    for (@{$pane_labels}[0 .. $npanes - 1]) {
		$line = $_->($line, $n0, $p, $names->[$i++] // '');
	    }
	}
	$line = $_->($line, $n0, $p, $names->[0] // '') for @$page_labels;
	print $line, "\n";
    };

    sub {
	my $opt = ref $_[0] eq 'HASH' ? shift : {};
	my @span = $opt->{span} ? @{$opt->{span}} : (($obj->{span}) x @_);
	my $page = $obj->current_page // 0;
	my $npanes = scalar @_;

	my($n0, $p) = $has_labels
	    ? ($page * ($obj->panes // 1), $page + 1) : ();
	my $names = $opt->{names} // [];

	$print_border->('top', 0, \@span, $npanes, $n0, $p, $names,
			 \@pane_top, \@page_top);

	# content rows
	my $max = max map $#{$_}, @_;
	for my $i (0 .. $max) {
	    my $pos = !$bd{top} && $i == 0 ? 0
		    : !$bd{bottom} && $i == $max ? 2
		    : 1;
	    my $bd = $border{$pos};
	    my @span = @span;