view release on metacpan or  search on metacpan

lib/App/Greple/under.pm  view on Meta::CPAN

=head1 SEE ALSO

L<App::Greple>

=head1 AUTHOR

Kazumasa Utashiro

=head1 LICENSE

Copyright ©︎ 2024-2025 Kazumasa Utashiro.

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

use Exporter 'import';
our @EXPORT_OK = qw(%config &config &finalize);
our %EXPORT_TAGS = (all => \@EXPORT_OK);

use App::Greple::Common qw(@color_list);
use Term::ANSIColor::Concise qw(ansi_code);
use Text::ANSI::Fold;
use Text::ANSI::Fold::Util qw(ansi_width);
use Hash::Util qw(lock_keys);
use Data::Dumper;

use Getopt::EX::Config qw(config);

my $config = Getopt::EX::Config->new(
    type              => 'overline',
    space             => ' ',
    sequence          => '',
    'custom-colormap' => 1,
    'show-colormap'   => 0,
);

sub finalize {
    our($mod, $argv) = @_;
    $config->deal_with(
	$argv,
	map("$_=s", qw(type space sequence)),
	map("$_!" , qw(custom-colormap show-colormap)),
    );
    if (not $config->{'custom-colormap'}) {
	$mod->setopt('--use-custom-colormap' => '$<ignore>');
    }
}

sub prologue {
    if ($config->{"show-colormap"}) {
	prepare();
	print "@color_list\n";
	exit 0;
    }
}

$Term::ANSIColor::Concise::NO_RESET_EL = 1;
Text::ANSI::Fold->configure(expand => 1);

my %marks  = (
    eighth   => [ "\N{UPPER ONE EIGHTH BLOCK}" ],
    half     => [ "\N{UPPER HALF BLOCK}" ],
    overline => [ "\N{OVERLINE}" ],
    macron   => [ "\N{MACRON}" ],
    caret    => [ "^" ],
    ring     => [ "\N{NBSP}\N{COMBINING RING ABOVE}" ],
    sign     => [ qw( + - ~ ) ],
    number   => [ "0" .. "9" ],
    alphabet => [ "a" .. "z", "A" .. "Z" ],
    block => [
	"\N{UPPER ONE EIGHTH BLOCK}",
	"\N{UPPER HALF BLOCK}",
	"\N{FULL BLOCK}",
    ],
    vertical => [
	"\N{BOX DRAWINGS LIGHT VERTICAL}",
	"\N{BOX DRAWINGS LIGHT DOUBLE DASH VERTICAL}",
	"\N{BOX DRAWINGS LIGHT TRIPLE DASH VERTICAL}",
	"\N{BOX DRAWINGS LIGHT QUADRUPLE DASH VERTICAL}",
	"\N{BOX DRAWINGS HEAVY VERTICAL}",
	"\N{BOX DRAWINGS HEAVY DOUBLE DASH VERTICAL}",
	"\N{BOX DRAWINGS HEAVY TRIPLE DASH VERTICAL}",
	"\N{BOX DRAWINGS HEAVY QUADRUPLE DASH VERTICAL}",
    ],
    up => [
	"\N{BOX DRAWINGS LIGHT UP}",
	"\N{BOX DRAWINGS LIGHT UP AND HORIZONTAL}",
	"\N{BOX DRAWINGS UP LIGHT AND HORIZONTAL HEAVY}",
	"\N{BOX DRAWINGS HEAVY UP}",
	"\N{BOX DRAWINGS HEAVY UP AND HORIZONTAL}",
	"\N{BOX DRAWINGS UP HEAVY AND HORIZONTAL LIGHT}",
	"\N{BOX DRAWINGS UP SINGLE AND HORIZONTAL DOUBLE}",
	"\N{BOX DRAWINGS UP DOUBLE AND HORIZONTAL SINGLE}",
	"\N{BOX DRAWINGS DOUBLE UP AND HORIZONTAL}",
    ],
);

my $re;
my %index;
my @marks;

sub prepare {
    @color_list == 0 and die "color table is not available.\n";

    my @ansi = map { ansi_code($_) } @color_list;
    my @ansi_re = map { s/\\\e/\\e/gr } map { quotemeta($_) } @ansi;
    %index = map { $ansi[$_] => $_ } keys @ansi;
    my $reset_re = qr/(?:\e\[[0;]*[mK])+/;
    $re = do {
	local $" = '|';
	qr/(?<ansi>@ansi_re) (?<text>[^\e]*) (?<reset>$reset_re)/x;
    };
    if (my $s = $config->{sequence}) {
	@marks = grep { ! /\A\s\z/ } $s =~ /\X/g;
    }
    elsif (my $mark = $marks{$config->{type}}) {
	@marks = $mark->@*;
    }