ckp — Perl BDF terminal clock

A self-contained Perl port of jcdc2.py (the ck shell alias) from ~/git/new_banner/. It renders the current time with a BDF bitmap font, centred on the terminal and refreshed once a second. With --message (-m) it instead prints arbitrary text as a one-shot banner and exits. Lives at ~/git/new_banner/jcdc2.pl.

Default rendering is half-block (2x pixel density) using the 2x2 quadrant block glyphs; output is byte-identical to the Python renderer (xbanner_bdf.msg()). For terminals whose font lacks those glyphs there is a full-block mode (--full, only needs U+2588) and an ASCII mode (--char '#'). It uses no Curses module — just POSIX termios and raw ANSI escapes — so it needs no CPAN modules at all.

Requirements / portability

Everything it uses is core Perl (strict, warnings, utf8, Getopt::Long, POSIX). To run it on another machine you need only three things:

1. A modern system Perl (5.x). No cpanm, no local::lib, no perl5/ tree.

2. At least one BDF font file — the only data dependency. Copy whichever .bdf you point -f at, e.g. src/spleen-1.9.1/spleen-32x64.bdf. Just the one file; the whole src/ tree is not needed.

3. A UTF-8 terminal. The default half-block mode needs the quadrant block glyphs (▘ ▝ ▀ ▚ █ …); if your terminal font lacks them, use --full (only U+2588 █) or --char '#' (pure ASCII). Set the locale to UTF-8 (LANG=…UTF-8) for the half/full block modes.

Portability caveat: the terminal-size ioctl uses the Linux constant TIOCGWINSZ = 0x5413. On macOS/BSD that value differs, so term_size() fails and falls back to 24×80 — the clock still runs, just possibly mis-centred. Everything else (POSIX termios, ANSI escapes) is portable across Unix. Native Windows won't work (needs a Unix tty); WSL is fine.

Usage

# same as the `ck` alias (half-block, 2x density)
perl jcdc2.pl -f /home/john/src/spleen-1.9.1/spleen-32x64.bdf

# custom strftime format
perl jcdc2.pl -f FONT --format '%H:%M'

# one-shot banner of arbitrary text (like the old `banner` command)
perl jcdc2.pl -f FONT -m 'Hello'

# full-block mode (only needs U+2588) for terminals missing quadrant glyphs
perl jcdc2.pl -f FONT --full

# pure-ASCII mode (also combines with -m)
perl jcdc2.pl -f FONT -m 'Hi' --char '#'

# print one frame of the clock as plain text (no ANSI) — for testing / piping
perl jcdc2.pl -f FONT --once

Quit the live clock with q or Ctrl-C; it restores the cursor and terminal state on exit (via an END block, so it restores even on die/signal).

Options

An alias to match ck: alias ckp='perl /home/john/git/new_banner/jcdc2.pl -f /home/john/src/spleen-1.9.1/spleen-32x64.bdf'.

How it works

The BDF parser reads each glyph's BITMAP hex rows into a bit array (big-endian). Half-block rendering groups pixels in 2×2 blocks; each 4-bit group indexes a 16-entry map of Unicode block-element codepoints (bit 0 = top-left, 1 = top-right, 2 = bottom-left, 3 = bottom-right), halving both dimensions. Full-block rendering (--full / --char) emits one cell per pixel instead. The main loop redraws only changed lines, repositions with ANSI escapes, and waits up to one second on select(STDIN) so a keypress quits immediately while a timeout ticks the clock.

Ctrl-C handling: raw_mode() clears ISIG (as well as ICANON/ECHO), so Ctrl-C is delivered as byte 0x03 and read as a keystroke rather than raising SIGINT — matching the Python original which disabled VINTR. A SIGINT/TERM/HUP handler and an END block are also installed as belt-and-braces, so the terminal is always restored.

Source

#!/usr/bin/env perl
#
# jcdc2.pl — Perl port of jcdc2.py: a live terminal clock that renders the
# time with a BDF bitmap font using half-block Unicode characters (2x pixel
# density), centred on screen and refreshed once a second.
#
# Unlike the Python version this uses no Curses module — just POSIX termios
# for cbreak/no-echo and raw ANSI escape sequences — so it has no CPAN deps.
#
#   perl jcdc2.pl -f /home/john/src/spleen-1.9.1/spleen-32x64.bdf
#   perl jcdc2.pl -f FONT --format '%H:%M'
#   perl jcdc2.pl -f FONT -m 'Hello'
#
# Quit with 'q' or Ctrl-C.

use strict;
use warnings;
use utf8;
use Getopt::Long qw(GetOptions);
use POSIX qw(strftime);

binmode STDOUT, ':encoding(UTF-8)';

# 16-entry map: a 2x2 group of pixels (4 bits) -> Unicode block-element char.
# bit 0 = top-left, 1 = top-right, 2 = bottom-left, 3 = bottom-right.
my @CMAP = (
    32, 9624, 9629, 9600, 9622, 9612, 9630, 9627,
    9623, 9626, 9616, 9628, 9604, 9625, 9631, 9608,
);

# ---------------------------------------------------------------------------
# BDF font loading
# ---------------------------------------------------------------------------

# Returns a hashref: { width => W, height => H, chars => { enc => [ [bits...], ... ] } }
sub load_font {
    my ($path) = @_;
    open my $fh, '<', $path or die "Cannot open font '$path': $!\n";

    my %font = (width => 0, height => 0, chars => {});
    my ($in_bitmap, $enc, @rows);

    while (my $line = <$fh>) {
        $line =~ s/\s+\z//;
        my ($kw, @args) = split /\s+/, $line;
        $kw //= '';

        if ($kw eq 'FONTBOUNDINGBOX') {
            @font{qw(width height)} = @args[0, 1];
        }
        elsif ($kw eq 'STARTCHAR') {
            ($enc, @rows) = (undef);
        }
        elsif ($kw eq 'ENCODING') {
            $enc = $args[0];
        }
        elsif ($kw eq 'BITMAP') {
            $in_bitmap = 1;
        }
        elsif ($kw eq 'ENDCHAR') {
            $in_bitmap = 0;
            $font{chars}{$enc} = [@rows] if defined $enc;
        }
        elsif ($in_bitmap) {
            push @rows, hexrow_to_bits($line);
        }
    }
    close $fh;
    die "Font '$path' has no FONTBOUNDINGBOX\n" unless $font{width};
    return \%font;
}

# One BDF bitmap row (hex string) -> arrayref of 0/1 bits, big-endian.
sub hexrow_to_bits {
    my ($hex) = @_;
    my @bits;
    for my $i (0 .. length($hex) / 2 - 1) {
        my $byte = hex(substr($hex, $i * 2, 2));
        push @bits, ($byte >> $_) & 1 for reverse 0 .. 7;
    }
    return \@bits;
}

sub bit {
    my ($rows, $y, $x) = @_;
    return 0 if $y < 0 || $y >= @$rows;
    my $row = $rows->[$y];
    return 0 if $x < 0 || $x >= @$row;
    return $row->[$x];
}

# ---------------------------------------------------------------------------
# Rendering — half-block, mirrors xbanner_bdf.msg()
# ---------------------------------------------------------------------------

sub render {
    my ($font, $str) = @_;
    my ($W, $H) = @{$font}{qw(width height)};
    my $space = $font->{chars}{32} // [];

    # Glyph rows for each character of the string.
    my @glyphs = map { $font->{chars}{ord $_} // $space } split //, $str;

    my $twidth  = int(($W * length($str) + 1) / 2);
    my $theight = int(($H + 1) / 2);

    my @lines;
    for my $y (0 .. $theight - 1) {
        my $y1 = $y * 2;
        my $line = '';
        for my $x (0 .. $twidth - 1) {
            my $x1 = $x * 2;
            my $xc = int($x1 / $W);
            my $xo = $x1 % $W;
            my $g  = $glyphs[$xc];
            my $gl = 0;
            for my $i (0 .. 3) {
                $gl |= bit($g, $y1 + ($i >> 1), $xo + ($i & 1)) << $i;
            }
            $line .= chr($CMAP[$gl]);
        }
        push @lines, $line;
    }
    return @lines;
}

# Full-block rendering: one terminal cell per font pixel, using only $on and
# space. For terminals whose font lacks the 2x2 quadrant block glyphs.
sub render_full {
    my ($font, $str, $on) = @_;
    my ($W, $H) = @{$font}{qw(width height)};
    my $space = $font->{chars}{32} // [];
    my @glyphs = map { $font->{chars}{ord $_} // $space } split //, $str;

    my @lines;
    for my $y (0 .. $H - 1) {
        my $line = '';
        for my $g (@glyphs) {
            $line .= bit($g, $y, $_) ? $on : ' ' for 0 .. $W - 1;
        }
        push @lines, $line;
    }
    return @lines;
}

# ---------------------------------------------------------------------------
# Terminal handling
# ---------------------------------------------------------------------------

my @saved_termios;
my $in_raw = 0;

sub term_size {
    # struct winsize: rows, cols, xpixel, ypixel (unsigned shorts).
    my $winsize = '';
    my $TIOCGWINSZ = 0x5413;                       # Linux
    if (ioctl(STDOUT, $TIOCGWINSZ, $winsize)) {
        my ($rows, $cols) = unpack 'S4', $winsize;
        return ($rows, $cols) if $rows && $cols;
    }
    return (24, 80);
}

sub raw_mode {
    require POSIX;
    my $t = POSIX::Termios->new;
    $t->getattr(fileno(STDIN)) or return;
    my $lflag = $t->getlflag;
    $saved_termios[0] = $lflag;
    # Clear ISIG too, so Ctrl-C is delivered as byte 0x03 rather than a signal
    # (matches jcdc2.py disabling VINTR) — we read it as a keystroke and quit.
    $t->setlflag($lflag & ~(POSIX::ICANON() | POSIX::ECHO() | POSIX::ISIG()));
    $t->setcc(POSIX::VMIN(),  0);
    $t->setcc(POSIX::VTIME(), 0);
    $t->setattr(fileno(STDIN), POSIX::TCSANOW());
    $in_raw = 1;
}

sub restore_mode {
    return unless @saved_termios;
    my $t = POSIX::Termios->new;
    $t->getattr(fileno(STDIN)) or return;
    $t->setlflag($saved_termios[0]);
    $t->setcc(POSIX::VMIN(),  1);
    $t->setcc(POSIX::VTIME(), 0);
    $t->setattr(fileno(STDIN), POSIX::TCSANOW());
    @saved_termios = ();
}

sub cleanup {
    return unless $in_raw;      # never emit escapes in --once / non-tty mode
    $in_raw = 0;
    print "\e[?25h\e[2J\e[H";   # show cursor, clear, home
    restore_mode();
    STDOUT->flush;
}

# Guarantee the terminal is restored on any exit path (signal, die, normal).
END { cleanup() }

# ---------------------------------------------------------------------------
# Main
# ---------------------------------------------------------------------------

my $font_path;
my $format = '%H:%M:%S';
my $once;
my $message;
my $on;   # defined => full-block mode using this "on" character
Getopt::Long::Configure('no_ignore_case');
GetOptions(
    'font|f=s'    => \$font_path,
    'format|d=s'  => \$format,
    'message|m=s' => \$message,
    'once|1'      => \$once,
    'full|F'      => sub { $on = "\x{2588}" },   # full block, only needs U+2588
    'char=s'      => \$on,                        # e.g. --char '#' for pure ASCII
    'help|h'      => sub { print usage(); exit 0 },
) or die usage();
die usage() unless defined $font_path;

# Install exit handlers before anything slow, so an early Ctrl-C is caught
# (before raw_mode() clears ISIG, the tty still delivers it as SIGINT).
my $done    = 0;
my $resized = 1;
$SIG{INT} = $SIG{TERM} = $SIG{HUP} = sub { $done = 1 };
$SIG{WINCH} = sub { $resized = 1 };

my $font = load_font($font_path);

# Choose the renderer: half-block (default) or full-block with a chosen char.
my $frame = defined $on
    ? sub { render_full($font, $_[0], $on) }
    : sub { render($font, $_[0]) };

# --message: render the given text as a static banner and exit (like --once,
# but arbitrary text rather than the current time).
if (defined $message) {
    print "$_\n" for $frame->($message);
    exit 0;
}

if ($once) {
    print "$_\n" for $frame->(strftime($format, localtime));
    exit 0;
}

exit 0 if $done;   # quit hit during startup, before we touched the terminal

raw_mode();
print "\e[?25l\e[2J";          # hide cursor, clear
STDOUT->flush;

my @last_lines;
my ($last_y, $last_x) = (-1, -1);

while (!$done) {
    my @lines = $frame->(strftime($format, localtime));
    my ($rows, $cols) = term_size();
    my $mh = scalar @lines;
    my $mw = $mh ? length($lines[0]) : 0;
    my $sy = int(($rows - $mh) / 2);
    my $sx = int(($cols - $mw) / 2);

    if ($resized || $sy != $last_y || $sx != $last_x) {
        print "\e[2J";
        @last_lines = ();
        ($last_y, $last_x, $resized) = ($sy, $sx, 0);
    }

    my $buf = '';
    for my $i (0 .. $#lines) {
        next if defined $last_lines[$i] && $last_lines[$i] eq $lines[$i];
        my $row = $sy + $i + 1;                    # ANSI is 1-based
        my $col = $sx + 1;
        $buf .= sprintf "\e[%d;%dH%s", $row, $col, $lines[$i] if $row >= 1 && $col >= 1;
        $last_lines[$i] = $lines[$i];
    }
    print $buf if length $buf;
    STDOUT->flush;

    # Wait up to 1s for a keypress; refresh on timeout.
    my $rin = '';
    vec($rin, fileno(STDIN), 1) = 1;
    if (select(my $rout = $rin, undef, undef, 1) > 0) {
        my $key = '';
        sysread(STDIN, $key, 1);
        $done = 1 if $key eq 'q' || $key eq 'Q' || $key eq "\x03";
    }
}

cleanup();

sub usage {
    return <<'USAGE';
Usage: jcdc2.pl -f FONT.bdf [--format STRFTIME | --message TEXT] [--full | --char C]

Live terminal clock rendered with a BDF bitmap font. With --message it acts as
a one-shot banner instead.

Options:
  -f, --font PATH      Path to BDF font file (required)
  -d, --format FMT     strftime format to display (default: %H:%M:%S)
  -m, --message TEXT   Print TEXT as a static banner and exit (like --once)
  -F, --full           Full-block rendering (only needs U+2588 block), for
                       terminals lacking the 2x2 quadrant block glyphs
      --char C         Full-block rendering using character C (e.g. --char '#'
                       for pure ASCII). Implies --full.
  -1, --once           Print a single frame as plain text and exit
  -h, --help           Show this help

Default is half-block rendering (2x density) using quadrant block glyphs.
Quit with 'q' or Ctrl-C.
USAGE
}