File Coverage

blib/lib/App/optex/pingu.pm

Criterion	Covered	Total	%
statement	29	63	46.0
branch	0	12	0.0
condition	0	7	0.0
subroutine	10	15	66.6
pod	0	4	0.0
total	39	101	38.6

package App::optex::pingu;

my $VERSION = '0.03';

use v5.14;
use warnings;
use utf8;
use Carp;
use open IO => 'utf8', ':std';
use Data::Dumper;

=encoding utf8

=head1 NAME

pingu - optex make-everything-pingu filter

=head1 SYNOPSIS

B -Mpingu --pingu I

=head1 DESCRIPTION

This B module is greatly inspired by L command and
make every command pingu not only L.  As for original
command, see L section.  All honor for this idea should go
to the original author.

=begin html



=end html

=begin html



=end html

This module is a quite good example to demonstrate L command
features.

=head1 OPTION

=over 7

=item B<--pingu>

Make command pingu.

=item B<--pingu-image>=I

Set image file.  File is searched at current directory and module
directory.  Standard B image is stored as B.  If
string C is specified, module search the file in the following
order.

    ./pingu
    ./pingu.asc
    module-dir/pingu
    module-dir/pingu.asc

=item B<--pingu-char>

Specify replacement character.  Default is Unicode C
(U+2588: █).

=item B<--pingu-interval>=I

Set interval time between printing each lines.  Default is zero.

=back

=head1 IMAGE FILE FORMAT

=over 4

=item ASCII

Each [C] character is converted to specified letter
with color which the character itself describe.  Upper-case character
represent normal ANSI color and lower-case means high-intensity color.

    R  r  Red
    G  g  Green
    B  b  Blue
    C  c  Cyan
    M  m  Magenta
    Y  y  Yellow
    K  k  Black
    W  w  White

Line start with C<#> is treated as a comment.

Default pingu image:

     ...        .     ...   ..    ..     .........
     ...     ....          ..  ..      ... .....  .. ..
     ...    .......      ...         ... . ..... kkkkkkk
    .....  ........ .kkkkkkkkkkkkkkk.....  ... kkkkkkkkkk.  .
     .... ........kkkkkkkkkkkkkkkkkkkkk.  ... kkkkkkkkkkk
          ....... kkwwwwkkkkkkkkkkkkkkkk.... kkkkkkkkkkkk
    .    .  .... kkwwkkwwkkkkkkkkkkwwwwkk... kkkkkkkkkkk
       ..   ....kkkkwwwwkkrrrrrrkkwwkkwwk.. .kkkkkkkkkkk
        .       kkkkkkkkrrrrrrrrrrkwwwwkk.   .kkkkkkkkkk
       ....     .kkkkkkkkrrrrrrrrkkkkkkkk.      kkkkkkkk
      .....      .  kkkkkkkkkkkkkkkkkkkk.        kkkkkkk.
    ......     .. . kkkkkkkkkkkkkkkkkk . .      .kkkkkkk
    ......       kkkkkkkkkkkkkkkkkkkkk  .      .kkkkkkk
    ......   .kkkkkkkkkkkkkkkkkkyywwkkkkk  ..  kkkkkkk
    ...    . kkkkkkkkkkkkkkkkywwwwwwwwwkkkkkkkkkkkkkk.
           kkkkkkkkkkkkkkkkywwwwwwwwwwwwwkkkkkkkkk .
          kkkkkkkkkkkkkkkywwwwwwwwwwwwwwwwkk    .
         kkkkkkkkkkkkkkkywwwwwwwwwwwwwwwwwww  ........
      .kkkkkkkkkkkkkkkkywwwwwwwwwwwwwwwwwwww    .........
     .kkkkkkkkkkkkkkkkywwwwwwwwwwwwwwwwwwwwww       .... . .

=back

Other file format is not supported yet.

Coloring is done by L module.  See its document
for detail.

=head1 INSTALL

Use L command:

    cpanm App::optex::pingu

=head1 PINGU ALIAS

You can set shell alias B to call L command through
B.

    alias pingu='optex -Mpingu --pingu ping'

However, there is more sophisticated way to use B alias
function.  Next command will make symbolic link C<< pingu->optex >> in
F<~/.optex.d/bin> directory:

    $ optex --ln pingu

Executing this symbolic link, optex will call system installed
B command.  So make an alias in F<~/.optex.d/config.toml> to
call L command instead:

    [alias]
        pingu = "ping -Mpingu --pingu"

=head1 MAKING NEW PING OPTION

You can add, say, B<--with-pingu> option to the original L
command.  Make a symbolic link C<< ping->optex >> in F<~/.optex.d/bin>
directory:

    $ optex --ln ping

And create an rc file F<~/.optex.d/ping.rc> for B:

    option --with-pingu -Mpingu --pingu

Then pingu will show up when you use B<--with-pingu> option to execute
L command:

    $ ping --with-pingu localhost -c15

If you want to enable this option always (really?), put next line in
your F<~/.optex.d/ping.rc>:

    option default --with-pingu

=head1 SEE ALSO

L

L,
L

L,
L

=head1 AUTHOR

Kazumasa Utashiro

=head1 LICENSE

Copyright 2022 Kazumasa Utashiro.

You can redistribute it and/or modify it under the same terms
as Perl itself.

=cut

use File::Share qw(dist_dir);
use List::Util qw(first);
use Getopt::EX::Colormap qw(colorize);
use Time::HiRes qw(usleep);

my $image_dir = $ENV{OPTEX_PINGU_IMAGEDIR} //= dist_dir 'App-optex-pingu';

our %param = (
    char => '█',
    repeat => 1,
    interval => 0,
    );

my %reader = (
    asc => \&read_asc,
    );

sub get_image {
    my $name = shift;
    my $file = do {
	first { -s }
	map {
	    my $dir = $_;
	    map { "${dir}${name}$_" } '', '.asc';
	} '', "$image_dir/";
    };
    die "$name: image file not found.\n" unless $file;
    my $type = ($file =~ /\.(\w+$)/)[0] || 'asc';
    my $reader = $reader{$type} // $reader{'asc'};
    $reader->($file);
}

sub read_asc {
    my $file = shift;
    open my $fh, '<', $file or die "$file: $!\n";
    local $_ = do { local $/; <$fh> };
    s/^#.*\n//mg;
    s{ (?(?
	colorize($+{col}, $param{char} x length($+{str}))
    }xgie;
    /.+/g;
}

sub pingu {
    @_ = map { utf8::is_utf8($_) ? $_ : decode('utf8', $_) } @_;
    my %opt = @_;
    my $name = $opt{name} || 'pingu';
    my @image = get_image($name);
    my $i = 0;
    my $sleep = $param{interval} > 0 ? $param{interval} * 1000000 : 0;
    while (<>) {
	print $image[$i++ % @image], $_;
	usleep $sleep if $sleep > 0;
    }
}

sub set {
    while (my($k, $v) = splice(@_, 0, 2)) {
	exists $param{$k} or next;
	$param{$k} = $v;
    }
    ();
}

1;

__DATA__