bl コマンド

bl.pl

#!/usr/bin/env perl

use strict;
use warnings;
use utf8;
use Curses;
use Getopt::Long;
use POSIX;
use Time::HiRes qw/usleep/;

my %opts;
Getopt::Long::Configure('bundling');
GetOptions(
  a => \$opts{a},  # XXX: Unimplemented.
  l => \$opts{l},  # ditto.
  F => \$opts{F},
) or exit -1;

POSIX::setlocale(POSIX::LC_CTYPE, 'ja_JP.UTF-8');
$SIG{INT} = $SIG{HUP} = 'IGNORE';

{
  my @aas = (
    '┌ ( ┌ ^ o^) ┐',
    '┌ ( └ ^ o^) ┐',
    '┌ ( ┘ ^ o^) ┐',
    '┌ ( ┐ ^ o^) ┐',
    '┌ ( ┐ ^ o^) ┐',
    '└ ( ┐ ^ o^) ┘',
    '  (┘┐ ^ o^) ┘',
    '  (┐┐ ^ o^) ┐',
    '┌ ( ┌ ^ o^) ┐',
  );

  my @lines = ('', 'ﾎ', 'ﾓｫ', '…', '…');

  sub homooh_iterator {
    my $aa_state = int rand(0+@aas);
    my $line_state = int rand(0+@lines);
    my $line_acc = join '', @lines[0 .. $line_state - 1];
    sub {
      $line_acc .= $lines[$line_state++];
      my $result = $aas[$aa_state++] . $line_acc;
      $aa_state %= @aas;
      if ($line_state % @lines == 0) {
        $line_acc = '';
        $line_state = 0;
      }
      return $result;
    };
  }
}

initscr;
noecho;
leaveok(stdscr, 1);
scrollok(stdscr, 0);

my $iter = homooh_iterator;
my $y = $opts{F} ?  LINES() - 1 : int(LINES() / 2);
my $inv_dy = $opts{F} ? (int(2 * COLS() / LINES()) || 1) : 0;
for my $x (0 .. COLS() - erase) {
  erase;
  my $aa = $iter->();
  my $num_columns = $x + length $aa;
  substr($aa, COLS() - $num_columns) = '' if COLS() < $num_columns;
  move($y, $x);
  addstr($aa);
  refresh;
  --$y if $opts{F} and $x % $inv_dy == 0;
  usleep(100_000);
}

endwin;