#!/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;
}