texture

#!/usr/bin/env perl
# Texture utilities

use strict;
use warnings;

use constant FG_CHAR => ':';

sub print_help {
    my ($file) = @_;
    print $file <<HELP;
Usage: $0 <sub-command> [arguments]
TS3D texture utilities.
Sub-commands:
  help              Print this help.
  table             Print a table of characters corresponding to texture pixels.
  view <file>...    Print colorized versions of the texture files given.
  animate <file>... Print one cycle of each animation of each entity file given.

Animations only run once, but you can loop them like this:

  yes "<entity file>" | xargs $0 animate

HELP
}

sub error {
    say STDERR "$0: @_";
}

sub file_text {
    my ($file) = @_;
    local $/;
    return <$file>;
}

sub quick_sleep {
    my ($duration) = @_;
    select undef, undef, undef, $duration;
}

sub dir_name {
    local ( $0, $1 );
    my ($dir) = @_;
    return $dir =~ m,(.*/)[^/]+/*$, ? $1 : $dir =~ m,^/, ? '/' : '.';
}

sub clear_screen {
    print "\e[H\e[J";
}

sub off_style { return "\e[0m"; }

sub pix_color {
    my ($pix) = @_;
    my $code = ord($pix) - ord(' ') - 1;
    if ( $code >= 0 && $code < 64 ) {
        my $fg = $code >> 3;
        my $bg = $code & 0b111;
        return "\e[3${fg};4${bg}m";
    }
    return '';
}

sub colorize_txtr {
    my ($path) = @_;
    if ( open( my $file, "<", $path ) ) {
        my $print      = '';
        my $last_color = '';
        while ( defined( my $pix = getc($file) ) ) {
            my $color = pix_color($pix);
            $print .= $color || off_style() if $color ne $last_color;
            $print .= $color ? FG_CHAR : $pix;
            $last_color = $color;
        }
        close($file);
        print $print;
    }
    else {
        error("Can't open file $path");
    }
}

sub animate_ent {
    if ( !exists(&JSON::decode_json) && !eval('require JSON;') ) {
        error('No JSON parser available');
        error('Try installing the "JSON" perl module with CPAN');
        return;
    }
    my ($path) = @_;
    my $texture_path = dir_name($0) . '/data/textures/';
    if ( open( my $file, "<", $path ) ) {
        my ( $text, $json );
        eval {
            $text = file_text($file);
            $json = JSON::decode_json($text);
        } or do {
            error("Can't parse file $path as JSON");
            return;
        };
        my $frames = $json->{'frames'};
        if (@$frames) {
            foreach my $frame (@$frames) {
                my ( $file, $duration );
                if (@$frame) {
                    $file     = $frame->[0];
                    $duration = $frame->[1];
                }
                else {
                    $file = $frame;
                }
                $duration = defined($duration) ? $duration : 1;
                clear_screen();
                colorize_txtr( $texture_path . $file );
                quick_sleep( $duration * 0.03 );
            }
        }
    }
    else {
        error("Can't open file $path");
    }
}

my $subcmd;
if ( $#ARGV >= 0 ) {
    $subcmd = $ARGV[0];
}
else {
    print_help(*STDERR);
    exit 1;
}
if ( $subcmd eq 'view' ) {
    for ( my $a = 1 ; $a <= $#ARGV ; ++$a ) {
        colorize_txtr( $ARGV[$a] );
    }
}
elsif ( $subcmd eq 'animate' ) {
    for ( my $a = 1 ; $a <= $#ARGV ; ++$a ) {
        animate_ent( $ARGV[$a] );
    }
}
elsif ( $subcmd eq 'table' ) {
    my $ascii = ' ';
    for ( my $y = 0 ; $y < 8 ; ++$y ) {
        for ( my $x = 0 ; $x < 8 ; ++$x ) {
            $ascii = chr( ord($ascii) + 1 );
            printf( "%s%s%s%s   ",
                $ascii, pix_color($ascii), FG_CHAR, off_style() );
        }
        print "\n";
    }
}
elsif ( $subcmd eq 'help' ) {
    print_help(*STDOUT);
}
else {
    error('Invalid sub-command');
    print_help(*STDERR);
    exit 1;
}