#!/usr/bin/perl -w
use strict;

$|++;

my $VERSION = '0.05';

#----------------------------------------------------------------------------

=head1 NAME

cpanreps-imlib - script to create table heading images.

=head1 SYNOPSIS

  perl cpanreps-imlib [--dir=<dir>] [--blank=<file>] [--list=<file>]

=head1 DESCRIPTION

Given a set of titles, will create an image for each, which consists of the
text in white on a transparent background, aligned vertically reading
downwards.

Note: the ttf-freefont package is required to use the default font.

=cut

# -------------------------------------
# Library Modules

use File::Path;
use Getopt::ArgvFile default=>1;
use Getopt::Long;
use Image::Imlib2;
use IO::File;

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

my %options;

my %headings = (
    'distribution' => 'Distribution',
    'perlversion'  => 'Perl Version'
);

# -------------------------------------
# Program

##### INITIALISE #####

init_options();

##### MAIN #####

Image::Imlib2->set_cache_size(0);

my $blank = "$options{dir}/$options{blank}";
if(!-e $blank) {
    my $image = Image::Imlib2->new(20, 120);

    # Enable the alpha channel support
    $image->has_alpha(1);

    # save out
    $image->save($blank);
}

for my $file (keys %headings) {
    my $text = $headings{$file};
    my $target = "$options{dir}/$file.png";
    #next    if(-e $target);

    # create a new image
    #my $image = Image::Imlib2->new(20, 120);
    my $image = Image::Imlib2->load($blank);
    $image->add_font_path("/usr/share/fonts/truetype/freefont");
    $image->load_font('FreeSansBold/10');

    # Enable the alpha channel support
    $image->has_alpha(1);

    #$image->set_color(255, 127, 0, 255);
    #$image->fill_rectangle(0, 0, 20, 120);

    $image->set_color(255, 255, 255, 255);
    $image->draw_text(0, 5, $text, TEXT_TO_DOWN, 90);

    $image->image_orientate(2);

    # save out
    $image->save($target);
    $image = undef;
}

# -------------------------------------
# Subroutines

sub init_options {
    GetOptions( \%options,
        'dir|d=s',
        'blank|b=s',
        'list|l=s',
        'help|h',
        'version|v'
    );

    help(1) if($options{help});
    help(0) if($options{version});

    $options{dir}   ||= 'headings';
    $options{blank} ||= 'blank.png';
    mkpath($options{dir});

    # each line is a separate heading
    if($options{list} && -r $options{list}) {
        my $fh = IO::File->new($options{list},'r') or die "Cannot read list file [$options{list}]: $!\n";
        while(<$fh>) {
            chomp;
	    my ($file,$name) = split(',');
	    $file =~ s/[^\w]+//g;
            $headings{$file} = $name || uc $file;
        }
    }
}

sub help {
    my $full = shift;

    if($full) {
        print <<HERE;

Usage: $0 [-d directory] [-b file] [-l file] [-h] [-v]

  -d directory  where images are written to (default = ./headings)
  -b file       blank image to use (default = blank.png)
  -l file       file containing list of image details (one image per line)
  -h            this help screen
  -v            program version

NOTE: If the blank image doesn't exist, one will be created automatically.

HERE

    }

    print "$0 v$VERSION\n\n";
    exit(0);
}

__END__

=head1 BUGS, PATCHES & FIXES

There are no known bugs at the time of this release. However, if you spot a
bug or are experiencing difficulties, that is not explained within the POD
documentation, please send bug reports and patches to the RT Queue (see below).

Fixes are dependant upon their severity and my availablity. Should a fix not
be forthcoming, please feel free to (politely) remind me.

RT: http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-WWW-Testers

=head1 SEE ALSO

L<CPAN::WWW::Testers::Generator>
L<CPAN::Testers::WWW::Statistics>

F<http://www.cpantesters.org/>,
F<http://stats.cpantesters.org/>

=head1 AUTHOR

  Original author:    Barbie       <barbie@cpan.org>   2008-present

=head1 COPYRIGHT AND LICENSE

  Copyright (C) 2008-2009 Barbie <barbie@cpan.org>

  This module is free software; you can redistribute it and/or
  modify it under the same terms as Perl itself.

=cut