#!/usr/bin/perl
# vi:ts=4 sw=4 et:
use strict;
use warnings;
# Pfad zu System's GD::Simple einbinden
use lib qw( /usr/lib/perl5/5.10.1/i686-linux);
use GD::Simple;

use File::Spec::Functions qw( catfile );
use File::Basename qw( basename );

#> global variables
#> ----------------------------------------------------------------------------

# in diesen Verzeichnis wird rekursiv nach .ttf Dateien gesucht
my @font_dirs = qw(
    /usr/share/fonts
    /home/webster
);

# Hiermit werden nur definierte Dateien aus den Treffern verwendet
my @font_files = qw(
    arial.ttf
    verdana.ttf
    INFECTED.ttf
);

my $image_file = '/tmp/gd-simple.png';
my $text       = 'Franz rast im verwahrlosten Taxi durch die Stadt.';

my ( $x, $y ) = ( 20, 20 );
my $fontsize  = 14;

my $gd;
my @fonts;

#> sub routines
#> ----------------------------------------------------------------------------

sub _fetch_fonts {
    my ( $dirsR, $fontsR ) = @_;
    my @wanted = @$fontsR;

    # quickhack; abs. Pfade zu *.ttf ermitteln; 
    my @fonts = qx{ /usr/bin/find @$dirsR -iname "*.ttf" };
    chomp @fonts;

    # soll's was bestimmtes sein?
    if ( @wanted ) {
        my %seen;
        @seen{@wanted} = ();
        # suchen, unerwuenschtes rauswerfen
        @fonts = grep { exists $seen{ basename( $_ ) } } @fonts;
    }
    
    die "(E) no fonts found/matched...\n" if !@fonts;

    return @fonts;
}

sub init {
    @fonts = _fetch_fonts( \@font_dirs, \@font_files ); 
    $gd = GD::Simple->new(800, $fontsize * 3 * @fonts );
    $gd->fontsize($fontsize);
}

sub fill_image {
    my $i = 0;
    for my $font ( undef, @fonts ) {

        # erste Ausgabe mit Standard-Font
        $gd->font( $font ) if 0 != $i;

        # Dateipfad als Ausgabe; vordefinierter Text für Standard-Font
        my $str = sprintf "%3d: %s", $i++, $font || $text ;

        # Positionieren
        $gd->moveTo( $x, $y );
        $y += int($fontsize*1.5 + 0.5);

        # Debug output auf STDERR
        warn "$str\n";

        $gd->string( $str ) or warn "->string() failed: $@\n";
    }

}

sub write_file {
    my ( $file ) = @_;
    # schreibe Datei
    open my $wh, '>', $file     or die "open $file: $!\n";
    print $wh $gd->png          or die "write to $file: $!\n";
    close $wh                   or die "close $file: $!\n";
}

#> main script
#> ----------------------------------------------------------------------------

init();
fill_image();
write_file( $image_file );

__END__