console-cyrillic 0.9-17 / usr / bin / displayfont

#!/usr/bin/perl -w

# $Id: displayfont,v 2.3 1999-01-27 16:15:29+03 slobin Exp $

# displayfont - display linux console font
# see bottom of file for more documentation

use strict;

use vars qw(%opt);

sub GIO_UNIMAP () { 0x4B66 }
sub PIO_UNIMAP () { 0x4B67 }
sub PIO_UNIMAPCLR () { 0x4B68 }

sub GIO_FONTX () { 0x4B6B }
sub PIO_FONTX () { 0x4B6C }

sub ENOMEM () { 12 }

sub getunimap
{
    my $desc = pack("SSP", 0, 0, undef);
    ioctl(CONSOLE, GIO_UNIMAP, $desc) && return (0, "");
    $! == ENOMEM || die "1st GIO_INIMAP: $!\n";
    my ($count) = unpack("S", $desc);
    my $size = $count * 4;
    my $data = pack("x$size");
    $desc = pack("SSP", $count, 0, $data);
    ioctl(CONSOLE, GIO_UNIMAP, $desc) || die "2nd GIO_UNIMAP: $!\n";
    my ($count1) = unpack("S", $desc);
    $count == $count1 || die "unimap count changed from $count to $count1\n";
#   $size = $count * 4;
#   ($count, undef, $data) = unpack("SSP$size", $desc);
    return ($count, $data);
}

sub putunimap
{
    my ($count, $data) = @_;
    return if $count == 0;
    my $init = pack("SSS", 0, 0, 0);
    ioctl(CONSOLE, PIO_UNIMAPCLR, $init) || die "PIO_UNIMAPCLR: $!\n";
    my $desc = pack("SSP", $count, 0, $data);
    ioctl(CONSOLE, PIO_UNIMAP, $desc) || die "PIO_UNIMAP: $!\n";
}

sub getfontx
{
    my $count = 512;
    my $height = 32;
    my $data = pack("x16384");
    my $desc = pack("SSP", $count, $height, $data);
    ioctl(CONSOLE, GIO_FONTX, $desc) || die "GIO_FONTX: $!\n";
    ($count, $height) = unpack("SS", $desc);
#   my $size = $count * 32;
#   ($count, $height, $data) = unpack("SSP$size", $desc);
    return ($count, $height, $data);
}
    
sub putfontx
{
    my ($count, $height, $data) = @_;
    my $desc = pack("SSP", $count, $height, $data);
    ioctl(CONSOLE, PIO_FONTX, $desc) || die "PIO_FONTX: $!\n";
}
    
sub getfontname
{
    my @prefixes = ("", "/usr/share/consolefonts/", "/usr/lib/kbd/consolefonts/");
    my @suffixes = ("", ".psf", ".cp", ".fnt", ".psfu");    
    my $stem = shift;
    my $filename;
    @prefixes = ("") if $stem =~ /\//;
    FILE:
    foreach my $suffix (@suffixes) {
        foreach my $prefix (@prefixes) {
            $filename = $prefix . $stem . $suffix;
            last FILE if -e $filename;
            $filename = $stem;
        }
    }
    return $filename;
}

sub linear
{
    my ($font, $offset, $height, $count) = @_;
    my $limit = $offset + $height * $count;
    my $dummy = "\0" x (32 - $height);
    my $data = "";
    for (my $i = $offset; $i < $limit; $i += $height) {
        $data .= substr($font, $i, $height) . $dummy;
    }
    return $data;
}
    
sub extractunimap
{
    my ($glyphcount, $rawdata) = @_;
    my $glyph = 0;
    my $count = 0;
    my $data = "";
    foreach my $code (unpack("v*", $rawdata)) {
        if ($code != 0xFFFF) {
            $data .= pack("SS", $code, $glyph);
            $count++;
        } else {
            last if ++$glyph >= $glyphcount;
        }
    }
    return ($count, $data);
}
    
sub normalize
{
    my $font = shift;
    my $size = length($font);
    my ($magic, $mode, $height) = unpack("SCC", $font);
    if ($magic == 0x0436) {
        my $count = 256 << ($mode & 1);
        my $offset = 4;
        my $data = linear($font, $offset, $height, $count);
        if ($mode & 2) {
            my $tail = substr($font, $offset + $height * $count);
            my ($unimapcount, $unimapdata) = extractunimap($count, $tail);
            return ($count, $height, $data, $unimapcount, $unimapdata);
        } else {
            return ($count, $height, $data, 0, "");
        }
    } elsif ($size == 9780) {
        my $count = 256;
        my $offset = 0;
        $offset = 7732, $height = 8 if $opt{"8"};
        $offset = 4142, $height = 14 if $opt{"14"};
        $offset = 40, $height = 16 if $opt{"16"};
        die "Use -8, -14 or -16 for this font\n" if $offset == 0;
        my $data = linear($font, $offset, $height, $count);
        return ($count, $height, $data, 0, "");
    } else {
        my $count = 256;
        my $offset = 0;
        die "Bad font file size\n" if ($size % $count) != 0;
        $height = $size / $count;
        die "Font file too long\n" if $height > 32;
        my $data = linear($font, $offset, $height, $count);
        return ($count, $height, $data, 0, "");
    }
}    

sub displayfont
{
    my ($code, $utf8);
    print "\e7";    # Save state
    print "\e%G";   # UTF-8 mode ON
    foreach my $i (0..15) {
        foreach my $j (0..31) {
            $code = 0xF000 + 16 * $j + $i;
            $utf8 = chr((($code & 0xF000) >> 12) | 0xE0)
                  . chr((($code & 0x0FC0) >> 6)  | 0x80)
                  . chr((($code & 0x003F)     )  | 0x80);
            print " $utf8";
        } 
        print "\n";
    }
    print "\e%@";   # UTF-8 mode OFF
    print "\e[s";   # Save cursor location
    print "\e8";    # Restore state
    print "\e[u";   # Restore cursor location
}

sub waitforuserinput
{
    print STDERR "Press Enter...";
    <STDIN>;
}

sub synopsis
{
    die "Usage: displayfont [-8|14|16] [-k[eep]] [font]\n";
}

# main

use Getopt::Long;

my $ok = GetOptions(\%opt, "8", "14", "16", "keep");

synopsis() unless $ok && $#ARGV <= 0;

if ($#ARGV == 0) {
    my $fontname = getfontname($ARGV[0]);
    die "$fontname: is a directory\n" if -d $fontname;
    open(FONT, $fontname) || die "$fontname: $!\n";
    my $font = do {local $/ = undef; <FONT> };
    close(FONT);
    my ($fontcount, $fontheight, $fontdata, $unimapcount, $unimapdata) = normalize($font);
    open(CONSOLE, ">/dev/console") || die "/dev/console: $!\n";
    my ($oldunimapcount, $oldunimapdata) = getunimap();
    my ($oldfontcount, $oldfontheight, $oldfontdata) = getfontx();
    putfontx($fontcount, $fontheight, $fontdata);
    putunimap($unimapcount, $unimapdata);
    displayfont();
    unless ($opt{"keep"}) {
        waitforuserinput();
        putfontx($oldfontcount, $oldfontheight, $oldfontdata);
        putunimap($oldunimapcount, $oldunimapdata);
    }
    close(CONSOLE);
} else {
    displayfont();
}
__END__

=head1 NAME

displayfont - display linux console font

=head1 SYNOPSIS

B<displayfont> [B<-8>|B<-14>|B<-16>] [B<-k>[B<eep>]] [B<font>]

=head1 DESCRIPTION

The B<displayfont> program displays given B<font> on console; if B<font> is
omitted, displays current font. All characters are shown, regardless of their
possible special meaning. The program hardly attempts to restore original
console state, font and unicode mapping after usage. 512-character fonts are
handled as well.

=head1 OPTIONS

=over

=item B<-8>, B<-14>, B<-16>

Select font size for files in codepage format (B<.cp>).

=item B<-keep>

Do not restore original font and unicode mapping. May be abbreviated to B<-k>.

=back

=head1 SEE ALSO

L<console(4)>, L<setfont(8)>, L<showfont> (no such manpage?).

=head1 BUGS

Linux-specific; was not tested on non-i386 systems.

=head1 AUTHOR

Cyril Slobin <slobin@iname.com>

        Public Domain
        Made on Earth

=cut