File Coverage

blib/lib/App/optex/pingu.pm

Criterion	Covered	Total	%
statement	41	80	51.2
branch	0	26	0.0
condition	0	6	0.0
subroutine	14	22	63.6
pod	0	5	0.0
total	55	139	39.5

package App::optex::pingu;

my $VERSION = '1.03';

use v5.24;
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 VERSION

Version 1.03

=head1 SYNOPSIS

B -Mpingu [ options -- ] 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<-->[B]B

Produce images.  Enabled by default.

=item B<--image>=I

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

    ./pingu
    ./pingu.asc4
    ./pingu.asc2
    ./pingu.asc
    module-dir/pingu
    module-dir/pingu.asc4
    module-dir/pingu.asc2
    module-dir/pingu.asc

=begin comment

=item B<--char>=I

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

=end comment

=item B<--interval>=I

Specifies the interval time in seconds between outputting each line.
Default is 0.1 seconds.

=back

=head1 IMAGE FILE FORMAT

=over 4

=item ASCII (C<.asc>)

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.

C:

     ...        .     ...   ..    ..     .........
     ...     ....          ..  ..      ... .....  .. ..
     ...    .......      ...         ... . ..... 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       .... . .

=begin html



=end html

=begin html



=end html

=item ASCII2 (C<.asc2>)

Each pixel is represented by two blocks, one in the upper half and one
in the lower half, with each color represented by two lines of data.

C:

     ...    .......      ...         ... . .....  kkkkk
     ...    .......      kkkkkkk     ... . ..... kkkkkkk
    .....  ........ . kkkkkkkkkkkkk .....  ...  kkkkkkkkk.  .
    .....  ........ kkkkkkkkkkkkkkkkk....  ... kkkkkkkkkk.  .
     .... ........ kkkkkkkkkkkkkkkkkkk .  ... kkkkkkkkkkkk
     .... ........kkkkkkkkkkkkkkkkkkkkk.  ... kkkkkkkkkkkk
          ....... kkkwwkkkkkkkkkkkkkkkkk.... kkkkkkkkkkkkk
          .......kkkwwwwkkkkkkkkkkkkkkkk.... kkkkkkkkkkkk
    .    .  .... kkwwKKwwkkkkkkkkkkkwwkkk...kkkkkkkkkkkkk
    .    .  ....kkkwwKKwwkkkkkkkkkkwwwwkk...kkkkkkkkkkkkk
       ..   ....kkkkwwwwkkkkkkkkkkwwKKwwkk. .kkkkkkkkkkkk
       ..   ....kkkkkwwkkkkrrrrkkkwwKKwwkk. .kkkkkkkkkkk
        .       kkkkkkkkkrrrrrrrrkkwwwwkkk   .kkkkkkkkkk
        .        kkkkkkkrrrrrrrrrrkkwwkkkk   . kkkkkkkkk
       ....     .kkkkkkkrrrrrrrrrrkkkkkkk.      kkkkkkkk
       ....     . kkkkkkkrrrrrrrrkkkkkkkk.      kkkkkkkk
      .....      . kkkkkkkkrrrrkkkkkkkkk.        kkkkkkk.
      .....      .  kkkkkkkkkkkkkkkkkkkk.        kkkkkkk.
    ......     .. .  kkkkkkkkkkkkkkkkkk. .      .kkkkkkk
    ......     .. . kkkkkkkkkkkkkkkkk  . .      .kkkkkk
    ......        kkkkkkkkkkkkkkkkkkkk  .      .kkkkkkk
    ......      kkkkkkkkkkkkkkkkkkkkkkk .      .kkkkkkk
    ......   . kkkkkkkkkkkkkkkkkyyykkkkk   ..  kkkkkkk
    ......   .kkkkkkkkkkkkkkkkyyyWWWWkkkk  .. kkkkkkkk
    ...    . kkkkkkkkkkkkkkkkyyWWWWWWWkkkkk  kkkkkkkk.
    ...    .kkkkkkkkkkkkkkkkyyWWWWWWWWWkkkkkkkkkkkkk .
           kkkkkkkkkkkkkkkkyyWWWWWWWWWWWkkkkkkkkkk .
           kkkkkkkkkkkkkkkyyWWWWWWWWWWWWWkkkkkkkk  .
          kkkkkkkkkkkkkkkyyWWWWWWWWWWWWWWWkkkkk .
         kkkkkkkkkkkkkkkkyWWWWWWWWWWWWWWWWWkk   .

=begin html



=end html

=begin html



=end html

=item ASCII4 (C<.asc4>)

Each pixel is made by four blocks, with each color represented by 2x2
characters.

C:

    ............            kkkkkkkkkkkkkk          ......  ..  ..........   k
    ............  ..  kkkkkkkkkkkkkkkkkkkkkkkkkk  ..........    ......    kkkk
    ............  kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk........    ......  kkkkkk
    ..........  kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk  ..    ......  kkkkkkkk
    ..........kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk..    ...... kkkkkkkkk
    ........ kkkkkkwwwwwwkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk........  kkkkkkkkkk
    ........kkkkkwwwwwwwwwwkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk....... kkkkkkkkkkk
    ...... kkkkkwwwwKKKKwwwwkkkkkkkkkkkkkkkkkkkkkwwwwwwkkkkk......kkkkkkkkkkkk
    ......kkkkkkwwwwKKKKwwwwkkkkkkkkkkkkkkkkkkkwwwwwwwwwwkkkk.....kkkkkkkkkkkk
    ......kkkkkkkwwwwwwwwwwkkkkkkkkkkkkkkkkkkkwwwwKKKKwwwwkkk ..  .kkkkkkkkkkk
    ......kkkkkkkkkwwwwwwkkkkkkkrrrrrrrrkkkkkkwwwwKKKKwwwwkkkk..  ..kkkkkkkkkk
           kkkkkkkkkkkkkkkkkrrrrrrrrrrrrrrrrkkkwwwwwwwwwwkkkkk      ..kkkkkkkk
           kkkkkkkkkkkkkkkrrrrrrrrrrrrrrrrrrrrkkkwwwwwwkkkkkkk      ..  kkkkkk
          ..kkkkkkkkkkkkkkrrrrrrrrrrrrrrrrrrrrkkkkkkkkkkkkkkk.           kkkkk
          ..  kkkkkkkkkkkkkkrrrrrrrrrrrrrrrrkkkkkkkkkkkkkkkk..            kkkk
            ..  kkkkkkkkkkkkkkkkrrrrrrrrkkkkkkkkkkkkkkkkkkk.               kkk
            ..    kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk ..                kk
        ....  ..    kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk ..  ..            ..kk
        ....  .. kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk    ..  ..            .kkk
              kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk    ..            .. kkk
           kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk  ..            ..kkkk
    ..  kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkyyyyyykkkkkkkkkk      ....     kkkkk
    ..kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkyyyyyyWWWWWWWWkkkkkkkkk   ....   kkkkkkk
    kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkyyyyWWWWWWWWWWWWWWkkkkkkkkkk     kkkkkkkkk
    kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkyyyyWWWWWWWWWWWWWWWWWWkkkkkkkkkkkkkkkkkkkkkk
    kkkkkkkkkkkkkkkkkkkkkkkkkkkkyyyyWWWWWWWWWWWWWWWWWWWWWWkkkkkkkkkkkkkkkkkkkk
    kkkkkkkkkkkkkkkkkkkkkkkkkkyyyyWWWWWWWWWWWWWWWWWWWWWWWWWWkkkkkkkkkkkkkkkk
    kkkkkkkkkkkkkkkkkkkkkkkkkyyyWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWkkkkkkkkkkk ..
    kkkkkkkkkkkkkkkkkkkkkkkkyyyWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWkkkkkk    ..
    kkkkkkkkkkkkkkkkkkkkkkkyyyWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWkkk  ........

=back

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"

=head1 MAKING NEW PING OPTION

You can add, say, B<--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 --pingu -Mpingu

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

    $ ping --pingu localhost -c15

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

    option default --pingu

=head1 SEE ALSO

L

L,
L

L,
L

=head2 ARTICLES

L

=head1 AUTHOR

Kazumasa Utashiro

=head1 LICENSE

Copyright ©︎ 2022-2024 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 pairmap);
use Time::HiRes qw(usleep);
use Scalar::Util;
use Hash::Util qw(lock_keys);
*is_number = \&Scalar::Util::looks_like_number;

use App::optex::pingu::Picture;

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

our %opt = (
    pingu    => \(our $pingu = 1),
    image    => 'pingu',
    char     => '█',
    repeat   => 1,
    interval => 0.1,
    );
lock_keys %opt;

sub hash_to_spec {
    pairmap {
	my $ref = ref $b;
	if    (not defined $b)   { "$a!"  }
	elsif ($ref eq 'SCALAR') { "$a!"  }
	elsif (is_number($b))    { "$a=f" }
	else                     { "$a=s" }
    } shift->%*;
}

use App::optex::util::filter qw(io_filter);

sub finalize {
    our($mod, $argv) = @_;
    #
    # private option handling
    #
    if (@$argv and $argv->[0] !~ /^-M/ and
	defined(my $i = first { $argv->[$_] eq '--' } keys @$argv)) {
	splice @$argv, $i, 1; # remove '--'
	if (local @ARGV = splice @$argv, 0, $i) {
	    use Getopt::Long qw(GetOptionsFromArray);
	    Getopt::Long::Configure qw(bundling);
	    GetOptions \%opt, hash_to_spec \%opt or die "Option parse error.\n";
	}
    }
    io_filter(\&pingu, STDOUT => 1);
}

sub get_image {
    my $name = shift;
    my $file = do {
	first { -s }
	map {
	    my $dir = $_;
	    map { "${dir}${name}$_" } '', '.asc4', '.asc2', '.asc';
	} '', "$image_dir/";
    };
    die "$name: image file not found.\n" unless $file;
    App::optex::pingu::Picture::load($file);
}

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

sub set {
    while (my($k, $v) = splice(@_, 0, 2)) {
	exists $opt{$k} or die "$k: invaid paraeter.\n";
	$opt{$k} = $v;
    }
    ();
}

1;

__DATA__