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

# This program demonstrates using Font::FreeType with Image::Magick.
# It uses the font metrics to position glyphs next to each other as
# a typesetting engine would, and renders them both by compositing a
# bitmap of each glyph onto the output image (using the bitmap_magick()
# convenience method) and by drawing the outline using ImageMagick
# drawing functions.

# TODO - use kerning.

use Font::FreeType;
use Image::Magick;
use List::Util qw( sum );

my $text = "\xC2g.";     # 'Ag.', with a circumflex over the 'A'
my $size = 72;
my $dpi = 600;
my $border = 23;

die "Usage: $0 font-filename output-filename.png\n"
  unless @ARGV == 2;

my ($font_filename, $output_filename) = @ARGV;
my $face = Font::FreeType->new->face($font_filename);
$face->set_char_size($size, $size, $dpi, $dpi);

# Find the glyphs of the string.
my @glyphs = map { $face->glyph_from_char_code(ord $_) } split //, $text;

# Work out how big the text will be.
my $width = sum map { $_->horizontal_advance } @glyphs;
$width -= $glyphs[0]->left_bearing;
$width -= $glyphs[-1]->right_bearing;
my $height = $face->height;
$width += $border * 2;
$height += $border * 2;

my $img = Image::Magick->new(size => "${width}x$height");
$img->Read('xc:white');
$img->Set(stroke => '#0000AA');

my $origin_y = -$face->descender + $border;
my ($text_x, $text_y) = (-$glyphs[0]->left_bearing + $border, $origin_y);

my (undef, $adj_base_y) = adjust_position(0, 0);
my (undef, $adj_top_y) = adjust_position(0, $face->ascender);
my (undef, $adj_btm_y) = adjust_position(0, $face->descender);
$img->Draw(primitive => 'line', points => "0,$adj_base_y $width,$adj_base_y",
           stroke => '#FF0000');
$img->Draw(primitive => 'line', points => "0,$adj_top_y $width,$adj_top_y",
           stroke => '#00FF00');
$img->Draw(primitive => 'line', points => "0,$adj_btm_y $width,$adj_btm_y",
           stroke => '#00FF00');

foreach (@glyphs) {
    my ($adj_x, $adj_y) = adjust_position(0, 0);

    my ($bmp_img, $bmp_left, $bmp_top) = $_->bitmap_magick;
    $bmp_img->Modulate(brightness => 23);   # Light grey, not black.
    $img->Composite(image => $bmp_img, compose => 'Difference',
                    x => $adj_x + $bmp_left, y => $adj_y - $bmp_top);

    my $curr_pos;
    $_->outline_decompose(
        move_to => sub {
            my ($x, $y) = @_;
            ($x, $y) = adjust_position($x, $y);
            $curr_pos = "$x,$y";
        },
        line_to => sub {
            my ($x, $y) = @_;
            ($x, $y) = adjust_position($x, $y);
            $img->Draw(primitive => 'line', points => "$curr_pos $x,$y");
            $curr_pos = "$x,$y";
        },
        cubic_to => sub {
            my ($x, $y, $cx1, $cy1, $cx2, $cy2) = @_;
            ($x, $y) = adjust_position($x, $y);
            ($cx1, $cy1) = adjust_position($cx1, $cy1);
            ($cx2, $cy2) = adjust_position($cx2, $cy2);
            $img->Draw(primitive => 'bezier',
                       points => "$curr_pos $cx1,$cy1 $cx2,$cy2 $x,$y");
            $curr_pos = "$x,$y";
        },
    );

    $img->Draw(primitive => 'line', points => "$adj_x,0 $adj_x,$height",
               stroke => '#CCCC00');

    $text_x += $_->horizontal_advance;
}

my ($adj_x, undef) = adjust_position(0, 0);
$img->Draw(primitive => 'line', points => "$adj_x,0 $adj_x,$height",
           stroke => '#CCCC00');

$img->Write($output_filename);


# Y coordinates need to be flipped over, and both x and y adjusted to the
# position of the character.
sub adjust_position
{
    my ($x, $y) = @_;
    $x += $text_x;
    $y = $height - $y - $text_y;
    return ($x, $y);
}

# vi:ts=4 sw=4 expandtab