#!/usr/bin/perl -w
#
# vcsdump - dump (colored) Linux console into curses capable terminal
#
# Usage: vcsdump < /dev/vcsa0
# Hints: 
#    - the output screen should be at least same size as the 
#      console you read from
#
# Author: Hanno Hecker <vetinari@ankh-morp.org>
#
# Licence: GPL version 2 and just version 2, not any later version.
#
# Version: 
my $version = '1.5';
# 
# pod-Documentation at the end
#
use strict;
use Curses;
use Getopt::Std;
use Text::Iconv;
use constant A_NONE => 0;
my ($input);
my ($input_charset,$output_charset);

if (exists $ENV{LANG} && $ENV{LANG} =~ /\.UTF-?8$/i) {
    $output_charset = 'UTF-8';
} else {
    $output_charset = 'ISO-8859-15';
}
$input_charset = 'IBM437';

$0 =~ s#.*/##;

sub usage {
    return <<_END;
$0: usage: $0 [-v|-h]
$0: usage: $0 [OPTIONS] [[-f] DEVICE]
  $0 dumps (colored) Linux console into curses capable terminal
  Options:
    -v:      show version
    -h:      show help/usage
    -t:      "textmode" on, default if STDOUT is not a tty
    -r CHR:  in "textmode" use CHR for non printable characters (def: #)
    -i ICHR: input charset, default: IBM437
    -o OCHR: output charset, default: ISO-8859-15 or UTF-8 depending on 
             \$ENV{LANG}
    DEVICE:  use this DEVICE as device, use ``-- DEVICE'' or ``-f DEVICE''
             to protect files starting with a ``-''.
_END
}

my %opts = ();
my $textmode = 0;
my $replace  = '#';
my ($win,$dev);

getopts('hvtr:f:i:o:', \%opts) or die usage();
if (exists $opts{'h'}) {
    print usage();
    exit 0;
} 
if (exists $opts{'v'}) {
    print "$0 version $version\n";
    exit 0;
}

if (exists $opts{'i'}) {
    $input_charset = $opts{'i'};
}
if (exists $opts{'o'}) {
    $output_charset = $opts{'o'};
}
$input = Text::Iconv->new($input_charset, $output_charset);
if ($output_charset eq 'UTF-8') {
    binmode STDOUT, ':utf8';
}

if (exists $opts{'t'} || not -t STDOUT) {
    $textmode = 1;
}

if (exists $opts{'f'}) {
    $dev = $opts{'f'};
} else {
    $dev = shift @ARGV;
    ($dev = '-') unless defined $dev;
}

if (exists $opts{'r'}) {
    $replace = $opts{'r'};
}

open STDIN, $dev
    or die "$0: Could not (re)open STDIN: $!\n";

unless ($textmode) {
    $win = new Curses;
    $win->clear;
    unless (has_colors) {
        die "Terminal has no color support...\n";
    } 
    start_color;
}
my $pair   = 1;
my $buffer = '';
my $res    = read STDIN, $buffer, 4;
unless ($res == 4) {
    die "Need at least 4 byte for screen resolution";
}

my %colors = (0 => COLOR_BLACK,
              1 => COLOR_BLUE,   # red on /dev/vcsaX
              2 => COLOR_GREEN, 
              3 => COLOR_CYAN,   # yellow on /dev/vcsaX
              4 => COLOR_RED,    # blue on /dev/vcsaX
              5 => COLOR_MAGENTA,
              6 => COLOR_YELLOW, # cyan on /dev/vcsaX
              7 => COLOR_WHITE,
              # same order as above, just with "bold" attribute
              8 => COLOR_BLACK,  
              9 => COLOR_BLUE,  
             10 => COLOR_GREEN, 
             11 => COLOR_CYAN,  
             12 => COLOR_RED,    
             13 => COLOR_MAGENTA,
             14 => COLOR_YELLOW, 
             15 => COLOR_WHITE, 
            );
my %graphic = (
                  4 => ACS_DIAMOND,
                 16 => ACS_RARROW,
                 17 => ACS_LARROW,
                 24 => ACS_UARROW,
                 25 => ACS_DARROW,
                 95 => ACS_S9,
                126 => ACS_S1,
                176 => ACS_BOARD,
                177 => ACS_CKBOARD,
                179 => ACS_VLINE,
                180 => ACS_RTEE,
                191 => ACS_URCORNER,
                192 => ACS_LLCORNER,
                193 => ACS_BTEE,
                194 => ACS_TTEE,
                195 => ACS_LTEE,
                196 => ACS_HLINE,
                197 => ACS_PLUS,
                206 => ACS_LANTERN,
                217 => ACS_LRCORNER,
                218 => ACS_ULCORNER,
                219 => ACS_BLOCK,
                241 => ACS_PLMINUS,
                248 => ACS_DEGREE,
                254 => ACS_BULLET,
             );

my $height = ord(substr $buffer, 0, 1);
my $width  = ord(substr $buffer, 1, 1);

my ($char,$attr,$cp,@pairs,$ord_char);
my ($row,$col) = (0,0);

while (read STDIN, $buffer, 2) {
    my ($fg,$bg);
    ($char,$attr) = split //, $buffer, 2;
    if ($textmode) {
        $char =~ s/^[^[:print:]]$/$replace/;
        print $char;
    } else {
        $attr     = ord($attr);
        $ord_char = ord($char);
        $char     = $input->convert($char) || $char;
        # print STDERR "CHAR=$char\n";
        $fg = ($attr & 0x0F) >> 0;
        $bg = ($attr & 0xF0) >> 4; 

        if ($fg >= 8) {
            $attr = A_BOLD;
        } else {
            $attr = A_NONE;
        }

        $fg = $colors{$fg};
        $bg = $colors{$bg};

        if (defined $pairs[$fg]->[$bg]) {
            $cp = $pairs[$fg]->[$bg];
        } else {
            init_pair $pair, $fg, $bg;
            $cp = COLOR_PAIR($pair);
            $pairs[$fg]->[$bg] = $cp;
            ++$pair;
        }

        $win->attron($cp|$attr);
        if (exists $graphic{$ord_char}) {
            $win->addch($row, $col, $graphic{$ord_char});
        } else {
            $win->addstr($row, $col, $char);
        }
        $win->attroff($cp|$attr);
    }
    ++$col;
    if ($col >= $width) {
        $col = 0;
        ++$row;
        print "\n" if $textmode;
    }
}
$win->refresh unless $textmode;
reset_shell_mode;
print "\n";

# end :)

=head1 NAME

vcsdump - dump (colored) Linux console into curses capable terminal

=head1 SYNOPSIS

B<vcsdump> I<E<lt>/dev/vcsaX>

B<vcsdump> [-t] [-i IN_CHARSET] [-o OUT_CHARSET] [-r CHAR] [[-f] DEVICE]

=head1 OPTIONS

=over 6

=item -v

show version

=item -h 

show help

=item -t

text mode, i.e. non-curses mode. Dumps all printable charachters to
STDOUT and replaces all non printable by ``#''. This is the default if 
STDOUT is not on a terminal.

=item -r CHAR

use CHAR as the replace character instead of ``#'' in text mode.

=item -i IN_CHARSET

use IN_CHARSET as input charachter set, defaults to ``IBM437''

=item -o OUT_CHARSET

use OUT_CHARSET as output charachter set, defaults to ``ISO-8859-15'' 
or ``UTF-8'', depending on the settings of $LANG.

=item [-f] DEVICE

use this file as device, use ``-f DEVICE'' to protect files starting with 
a ``-''.

=back

=head1 DESCRIPTION

B<vcsdump> reads a dump of /dev/vcsaX from stdin and prints it to the
current terminal. It converts the input for the use with ncurses(3). If
you have troubles displaying UTF-8 charachters on your UTF capable output 
terminal, try something like I<export LD_PRELOAD=/usr/lib/libncursesw.so.5> 
to use the "wide charachter" output of ncurses.

=head1 HINTS

The output screen should be at least same size as the console you 
read from ;-).

=head1 DOWNLOAD 

L<http://ankh-morp.org/code/misc/vcsdump.pl>

=head1 AUTHOR

Hanno Hecker E<lt>vetinari@ankh-morp.orgE<gt>

=head1 SEE ALSO

L<vcs(4)>, L<ncurses(3)>

=cut

# vim: ts=4 sw=4 expandtab