#   ――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――
#   File: iosevka-fonts-all-fontconfig.pl
#   Copyright 🄯 2016—2023 Van de Bugger.
#   SPDX-License-Identifier: FSFAP
#   ――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――――

# Generates Fonconfig files for Iosevka fonts.

use v5.30.0;
use warnings;
use utf8;

use FindBin;

BEGIN { require "$FindBin::Bin/iosevka-fonts-all.pm" or die( $@ or $! ); Iosevka::Util->import; };

# Monospace Iosevka are high priority fonts: I want Iosevka monospace to be a default monospace
# font. Quasi-proportional Iosevka are low-priority fonts: they do not work as general-perpose
# proportional fonts.
my %prio = (
    # Generic family name
    #            => fonconfig priority
    'monospace'  => 55,
    'sans-serif' => 64,
    'serif'      => 64,
);

#   ------------------------------------------------------------------------------------------------
#   Functions
#   ------------------------------------------------------------------------------------------------

# Encode special HTML characters.
sub encode($) {
    my ( $text ) = @_;
    state %subst = (
        '&' => "&",
        '<' => "&lt;",
        '>' => "&gt;",
        '"' => "&quot;",
        "'" => "&apos;",
    );
    $text =~ s{([&<>"'])}{ $subst{ $1 } // ( "&#" . ord( $1 ) . ";" ) }ge;
    return $text;
};

# Create HTML element.
sub elem($@) {
    my ( $name, @content ) = @_;
    my $attrs = ( ( @content > 0 && ref( $content[ 0 ] ) eq 'HASH' ) ? shift( @content ) : {} );
    return
        "<$name" .
        join( "", map( { " $_=\"" . encode( $attrs->{ $_ } ) . "\"" } sort( keys( %$attrs ) ) ) ) .
        ">" .
        ( @content > 1 ? "\n" : "" ) .
        indent( join( "\n", @content ), @content > 1 ? 4 : 0 ) .
        ( @content > 1 ? "\n" : "" ) .
        "</$name>";
};

# Create comment.
sub comm(@) {
    my ( @content ) = @_;
    return
        "<!--" .
        ( @content > 1 ? "\n" : " " ) .
        indent( join( "\n", @content ), @content > 1 ? 4 : 0 ) .
        ( @content > 1 ? "\n" : " " ) .
        "-->";
};

# Create fontconfig configuration.
sub config(@) {
    my ( @content ) = @_;
    return
        "<?xml version=\"1.0\"?>\n" .
        "<!DOCTYPE fontconfig SYSTEM \"urn:fontconfig:fonts.dtd\">\n" .
        elem( 'fontconfig', @content ) . "\n";
};

# Create font alias.
sub alias($;$$) {
    my ( $family, $accept, $default ) = @_;
    $family = cat( "Iosevka", $family );
    $accept = cat( "Iosevka", $accept ) if $accept;
    $default //= generic( $family );
    return elem( 'alias',
        elem( 'family', $family ),
        $accept ? elem( 'accept', elem( 'family', $accept ) ) : (),
        elem( 'default', elem( 'family', $default ) ),
    );
};

sub write_file($$$) {
    my ( $n, $family, $content ) = @_;
    my $path = path( sprintf( "%02d-%02d-%s.conf", $prio{ generic( $family ) }, $n, $family ) );
    $path->spew_utf8( $content );
};

#   ------------------------------------------------------------------------------------------------
#   Variables
#   ------------------------------------------------------------------------------------------------

my %spacings = (
    # Uniform Iosevka spacing name
    #    => fontconfig spacing name
    prop => 'proportional',
    full => 'dual',
    term => 'dual',
    mono => 'mono',
    hard => 'charcell',  # Is it correct?
);

#   ------------------------------------------------------------------------------------------------
#   Parse command line
#   ------------------------------------------------------------------------------------------------

my %opts;
get_options(
    map(
        { (
            "$_=s" =>
                sub {
                    my ( $opt, $arg ) = @_;
                    $opts{ $opt } = $arg;
                },
        ) }
        @Families
    ),
);
not @ARGV or die "Too many arguments\n";

#   ------------------------------------------------------------------------------------------------
#   "iosevka-common.conf" file
#   ------------------------------------------------------------------------------------------------
{
    my @elems;
    push( @elems,
        elem( 'description', { domain => 'fontconfig-conf' },
            "Define Iosevka font families compatibility."
        ),
        comm( "Aliases for original Iosevka font family names" ),
        $opts{ 'prop-sans' } ? alias( "Aile",       "Prop Sans" ) : (),
        $opts{ 'prop-slab' } ? alias( "Etoile",     "Prop Slab" ) : (),
        $opts{ 'full-sans' } ? alias( "",           "Full Sans" ) : (),
        $opts{ 'full-slab' } ? alias( "",           "Full Slab" ) : (),
        $opts{ 'term-sans' } ? alias( "Term",       "Term Sans" ) : (),
        $opts{ 'hard-sans' } ? alias( "Fixed",      "Hard Sans" ) : (),
        $opts{ 'hard-slab' } ? alias( "Fixed Slab", "Hard Slab" ) : (),
    );
    #~ push( @elems, comm( "TODO" ) );
    #~ for my $s ( 0 .. @spacings - 1 ) {
        #~ my $spacing = $spacings[ $s ];
        #~ for my $serif ( @serifs ) {
            #~ if ( $args{ "$spacing-$serif" } ) {
                #~ my $family = tc( cat( $spacing, $serif ) );
                #~ push( @elems,
                    #~ alias(
                        #~ $family,
                        #~ $spacings[ $s + 1 ] ? tc( cat( $spacings[ $s + 1 ], $serif ) ) : ()
                    #~ )
                #~ );
            #~ };
        #~ }; # $serif
    #~ }; # $spacings
    write_file( 0, "iosevka-common", config( @elems ) );
}

#   ------------------------------------------------------------------------------------------------
#   Configuration files for specific families
#   ------------------------------------------------------------------------------------------------
my $sp = 0; # Index of current spacing value.
for my $spacing ( @Spacings ) {
    ++ $sp;
    my $sr = 0; # Index of current serif value.
    for my $serif ( @Serifs ) {
        ++ $sr;
        $opts{ "$spacing-$serif" } or next;
        my $family = tc( cat( "Iosevka", $spacing,  $serif ) );
        my @elems;
        push( @elems,
            elem( 'description', { domain => 'fontconfig-conf' },
                "Rename Iosevka fonts to make font names uniform."
            ),
        );
        # It is not a problem if config file contains matches for font variants missed in the font
        # family.
        for my $weight ( @Weights ) {
        for my $width  ( @Widths  ) {
        for my $slope  ( @Slopes  ) {
            my $style    = tc( cat( $weight, $width, $slope ) );
            my $fullname = cat( $family, $style );
            my $badname  =
                # Font full name compiled into Iosevka font file.
                # They omit regular weight, normal width, and uprigt slope.
                tc( cat( $family, $weight, $width, $slope ) )
                    =~ s{ (Regular|Normal|Upright)}{}gr;
            push( @elems,
                elem( 'match', { target => 'scan' },
                    elem( 'test', { name => 'fullname' },
                        elem( 'string', $badname ),
                    ),
                    elem( 'edit',
                        { name => 'family', mode => 'assign' },
                        elem( 'string', $family ),
                    ),
                    elem( 'edit',
                        { name => 'style', mode => 'assign' },
                        elem( 'string', $style ),
                    ),
                    elem( 'edit',
                        { name => 'fullname', mode => 'assign' },
                        elem( 'string', $fullname ),
                    ),
                    elem( 'edit',
                        { name => 'width', mode => 'assign' },
                        elem( 'const', $width ),
                    ),
                    # If spacing is not set, Fontconfig calculates it. It seems it does it almost
                    # properly. The only difference is hard spacing: Fontconfig detects it as
                    # monospace, not charcell. I am not sure how it is important. Just in case,
                    # let's specify all spacings manually:
                    elem( 'edit',
                        { name => 'spacing', mode => 'assign' },
                        elem( 'const', $spacings{ $spacing } ),
                    ),
                ),
            );
        }; # $slope
        }; # $width
        }; # $weight
        push( @elems,
            elem( 'alias',
                elem( 'family', generic( $family ) ),
                elem( 'prefer', elem( 'family', $family ) ),
            ),
        );
        write_file( 10 * $sp + $sr, rpmname( $family ), config( @elems ) );
    }; # $serif
}; # $spacing

# end of file #