view release on metacpan or  search on metacpan

lib/App/optex/pingu.pm  view on Meta::CPAN

L<App::optex::pingu>,
L<https://github.com/kaz-utashiro/optex-pingu/>

=head2 ARTICLES

L<https://qiita.com/kaz-utashiro/items/abb436d7df349fe84e69>

=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__

# define --pingu for backward compatibility
option --pingu $<ignore>

#  LocalWords:  pingu optex asc Unicode Cyan cpanminus cpanm rc
#  LocalWords:  localhost Kazumasa Utashiro