#!/usr/bin/env perl

use 5.032;
use warnings;
use autodie ':all';

use List::Util 'shuffle';
use Path::Tiny;

die "Usage: $0 name\n" unless @ARGV == 1;

my $name = $ARGV[0];
my ($base, $size, $orient) = split /_/, $name;

my %bits_for = (s => 16, m => 32, l => 48, b => 96);
die "Unknown size '$size'" unless exists $bits_for{$size};
my $bits = $bits_for{$size};

my $matrix = create_matrix($bits);
my $oriented = orient_matrix($orient, $matrix);
my $hexes = gen_hex_values($oriented);
write_xbm($name, $hexes, $bits);

sub create_matrix {
    my ($bits) = @_;

    my $matrix = [];

    for (0 .. $bits - 1) {
        push $matrix->@*, [shuffle((0)x$_, (1)x($bits-$_))];
    }

    return $matrix;
}

sub orient_matrix {
    my ($orient, $matrix) = @_;

    my $oriented = [];

    for ($orient) {
        /^n$/ && do {
            push $oriented->@*, $matrix->[$_] for reverse 0 .. $matrix->$#*;
            last;
        };
        /^s$/ && do {
            push $oriented->@*, $matrix->[$_] for 0 .. $matrix->$#*;
            last;
        };
        /^e$/ && do {
            for my $x (0 .. $matrix->$#*) {
                my $col = [];

                for my $y (0 .. $matrix->[$x]->$#*) {
                    push $col->@*, $matrix->[$y][$x];
                }

                push $oriented->@*, $col;
            }

            last;
        };
        /^w$/ && do {
            for my $x (0 .. $matrix->$#*) {
                my $col = [];

                for my $y (reverse 0 .. $matrix->[$x]->$#*) {
                    push $col->@*, $matrix->[$y][$x];
                }

                push $oriented->@*, $col;
            }

            last;
        };
        die "Unknown orientation '$orient'";
    }

    return $oriented;
}

sub gen_hex_values {
    my ($matrix) = @_;

    my $vector = [];
    push $vector->@*, $matrix->[$_]->@* for 0 .. $matrix->$#*;

    my $hexes = [];

    for (my $i = 0; $i <= $vector->$#*; $i += 8) {
        push $hexes->@*, map $_ eq '00' ? '0x00' : $_,
            sprintf '%#0.2x', eval '0b' . join '', $vector->@[$i .. $i+7];
    }

    return $hexes;
}

sub write_xbm {
    my ($name, $hexes, $size) = @_;

    my $index = '0000';
    my $dir = '.';
    my @files;

    {
        opendir(my $dh, $dir);
        @files = grep /^\Q$name\E_\d{4}/, readdir $dh;
        closedir $dh;
    }

    if (@files) {
        $index = (sort { $b cmp $a } map /^\Q$name\E_(\d{4})/, @files)[0];
        ++$index;
    }

    my $indexed_name = $name . '_' . $index;
    my $xbm_file = $indexed_name . '.xbm';
    my $xbm_path = path($dir, $xbm_file);

    {
        open my $fh, '>', $xbm_path;
        $fh->say("#define ${indexed_name}_width $size");
        $fh->say("#define ${indexed_name}_height $size");
        $fh->say("static unsigned char ${indexed_name}_bits[] = { " . join(', ', $hexes->@*) . ' };');
    }

    return;
}

##</code><code>##

#define fade_m_w_0000_width 32
#define fade_m_w_0000_height 32
static unsigned char fade_m_w_0000_bits[] = { 0x01, 0xc8, 0x27, 0xef, 0x20, 0x21, 0xfe, 0xdf, 0x22, 0x8f, 0x7a, 0xff, 0x00, 0x51, 0xdf, 0x7f, 0x02, 0xc7, 0xaf, 0xff, 0x10, 0x89, 0xaf, 0xff, 0x11, 0x22, 0x8a, 0xff, 0x01, 0x4f, 0xe7, 0xdf, 0x02, 0x1b, 0x5f, 0xbf, 0x90, 0x8d, 0x29, 0xbf, 0x04, 0x02, 0xff, 0x7f, 0x06, 0x2a, 0x7f, 0xff, 0x04, 0x45, 0x33, 0xbf, 0x00, 0x04, 0xf1, 0x77, 0x00, 0x04, 0xf8, 0xff, 0x08, 0x72, 0x97, 0xff, 0x01, 0x2c, 0xb5, 0xfb, 0x42, 0x11, 0x57, 0xb7, 0x03, 0x24, 0x53, 0xbf, 0x05, 0x1a, 0xce, 0xcf, 0x04, 0x33, 0xdc, 0x3f, 0x08, 0x02, 0x03, 0xff, 0x10, 0xac, 0xdb, 0xef, 0x48, 0xb2, 0x0f, 0x7f, 0x29, 0x59, 0x2f, 0xf7, 0x02, 0x53, 0x7f, 0xef, 0x00, 0x5d, 0xf4, 0x7f, 0x00, 0x24, 0x7d, 0xdb, 0x00, 0x13, 0x2f, 0xdf, 0x09, 0x54, 0x35, 0xfd, 0x04, 0xa9, 0xcb, 0x7f, 0x00, 0x86, 0x9c, 0xff };