view release on metacpan or  search on metacpan

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

package App::optex::scroll;
use 5.024;
use warnings;

use Carp;
use Data::Dumper;
use IO::Handle;
use Term::ReadKey;
use Term::ANSIColor::Concise qw(:all);
use List::Util qw(first pairmap);
use Scalar::Util;
*is_number = \&Scalar::Util::looks_like_number;

our $VERSION = "0.9902";

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

my %opt = (
    line     => 10,
    wait     => \(our $wait = 1),
    debug    => \(our $debug = undef),
    timeout  => \(our $timeout = 0.1),
    interval => 0,
);

sub hash_to_spec {
    pairmap {
	$a = "$a|${\(uc(substr($a, 0, 1)))}";
	my $ref = ref $b;
	if    (not defined $b)   { "$a!"  }
	elsif ($ref eq 'SCALAR') { "$a!"  }
	elsif (is_number($b))    { "$a=i" }
	else                     { "$a=s" }
    } shift->%*;
}

sub flush {
    STDERR->printflush(@_);
}

sub set_region {
    flush join('',
	       csi_code('DECSC'),
	       csi_code('STBM', @_),
	       csi_code('DECRC'));
}

END {
    close STDOUT if $wait;
    set_region();
}

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";
	}
    }
    my $i = first { $argv->[$_] eq '--' } keys @$argv;
    if (defined $i and $argv->[0] !~ /^-M/) {
	splice @$argv, $i, 1; # remove '--'
	if (local @ARGV = splice @$argv, 0, $i) {
	    use Getopt::Long qw(GetOptionsFromArray);
	    Getopt::Long::Configure qw(bundling);