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

=head1 NAME

text_to_image - generate images from text

=head1 SYNOPSIS

text_to_images.pl fill.gif font-face-src /usr/local/share/fonts/foo.ttf font-size 18 \
  background-color \#FFFFB3 color \#411581 content "Hello World" 

=head1 DESCRIPTION

Will attempt to follow CSS attributes to create the desired image.
The supported attributes are:

  font-face-src
  driver
  margin
  margin-*
  font-size
  color
  background-color
  color-bits
  content

=head2 Supported Attributes

CSS has no control over some things that are fixed at the time
of image generation, so we have to add new ones for that:

- format: png vs. jpeg, the file name

Supported attributes:

  font-face-src
 
=head2 Size Units

We use pixels throughout.

=head2 Font Sizes

We take css-style parameters and produce an image of that text.

In CSS and SVG, font-size is the baseline to baseline distance, with a 100% line-height.
It is basically something declared by the font itself -- it will generally exceed
maximum height and depth of any accents, and may include a nonzero "line gap" as well.

In CSS, vertical-align can be to: top, text-top, middle, text-middle, bottom, text-bottom, baseline, sub, sup.
All of these based on font characteristics (e.g. middle = baseline + half x-height), not
dependent on the actual characters that appear.
Note that vertical-align does not do the same thing as the html attribute valign.

So the top and bottom of the bounding box of some text is determined by the font.
What about the left and right edges? It is possible particularly in an italic font that portions
of the glyphs might exceed the box.

Sometimes one wants margin and padding space to be dictated by font characteristics, and sometimes
by the particular text used, which might have no characters with ascenders or descenders (e.g. "axes" vs. "Hog").

=head2 Hyphenation and Word Breaking

CSS 1 and CSS2 provide little to control hyphenation, only
white-space ( normal | pre | nowrap | pre-wrap | pre-line | inherit )
CSS3 ( http://www.w3.org/TR/css3-text/ )
offers word-break ( normal | keep-all | loose | break-strict | break-all )
and hyphenate ( none | auto ) and text-wrap ( normal | unrestricted | none | suppress ).
(XSL-FO has hyphenation control as well, but we aren't modelling based on XSL-FO.)

For an exhaustive discussion of how word breaking works in browsers today, see
http://www.cs.tut.fi/~jkorpela/html/nobr.html

Note that the PDF format does not itself do hyphenation or wrapping -- the PDF writer must do so.



=head1 TODO

imagemagick positions to baseline - so have to add bottom margin
GD positions to actual text, so baseline position depends on whether text has a descender
font face selection to match weight within font family (fc-match from fontconfig)
test for margin-top etc. being defined vs. true
color depth
charset of input
jpeg and png compression levels
image resolution (other than 72)
allow minimal box around actual drawn glyphs, or not
finish docs
usage statement for command-line args
implement gravity
letter spacing and kerning
border effects
CSS parser, perhaps libcroco: http://www.freespiders.org/projects/libcroco/





=head1 SEE ALSO

=head2 perl GD

A font can be any of GD::Font objects, TrueType font file paths, or fontconfig font patterns like "Times:italic" (http://www.fontconfig.org/wiki/)
The font size can only be set for TrueType fonts.

GD 1.x and 2.x use point sizes for fonts.
GD 1.x used pixel coordinates. GD 2.x uses point sizes. It has a define: #define GD_RESOLUTION 96
So to get a 10px font, ask for a point size of 10 * (72/96).

Coordinates are (0,0) for upper left. 

colors are r,g,b triples (decimal numbers), or are one of the symbolic names from GD::Image::color_names().

Negative color indexes disable anti-aliasing.

\n\r will literally do a line feed and return when rendering text.

  $image->png([$compression_level]
  $image->jpeg([$quality])

transparent colors

color depth


=head2 perl Image::Magick

Font positioning is to baseline.

See http://www.cit.gu.edu.au/~anthony/graphics/imagick6/fonts/

Supports many filtering effects.

No support for tracking/kerning (as with GD)

Note there is also the XML/MSL Conjure tool:
   http://www.imagemagick.org/script/conjure.php

=head2 perl Imager

See:
 http://imager.perl.org/
 http://imager.perl.org/docs/Imager/Tutorial.html
 http://imager.perl.org/docs/Imager/Font.html

No control over advance?

=head2 perl Imager::DTP

See http://iandeth.dyndns.org/mycpan/Imager-DTP/sample_viewer_en.html
and http://search.cpan.org/src/BASHI/

Does scaling, but not tracking

=head2 perl Image::PNGWriter

Perl access to the GPL pngwriter C++ api http://pngwriter.sourceforge.net/ (which uses libpng and freetype2).

No tracking.

=head2 perl Font::FreeType

Perl access to the freetype2 C api. "cpan Font::FreeType" fails tests at least for v 0.03
Does have advance support.

=head2 perl SVG.pm

See http://search.cpan.org/dist/SVG/

Does not do rasterizing to an image, just to XML.

=head2 Glyph Keeper http://kd.lab.nig.ac.jp/glyph-keeper/manual.html

A C library (zlib license) around freetype.

Only C interface? No tracking support.

=head2 PHP

See http://www.php.net/imagettftext which has an example of kerning

 for($i=0;$i<strlen($text);$i++){
       // Get single character
   $value=substr($text,$i,1);
   if($pval){ // check for existing previous character
       list($lx,$ly,$rx,$ry) = imagettfbbox($fontsize,0,$font,$pval);
       $nxpos+=$rx+3;
   }else{
       $nxpos=0;
   }
       // Add the letter to the image
   imagettftext($im, $fontsize, 0, $nxpos, $ypos, $fontcolor, $font, $value);
   $pval=$value; // save current character for next loop
 }

=head2 C and Perl iLib

See http://www.k5n.us/Ilib.php

C library with Perl module. GPL license. works only with X11 BDF fonts.

=head2 C command a2ps

http://www.gnu.org/software/a2ps/

=head2 C library Pango

http://www.pango.org/
GTK text layout and rendering librrary.
Includes hyphenation and justification support.

Pango is used by Inkscape as of version 0.39.

Perl interface with Gtk2::Pango http://gtk2-perl.sourceforge.net/doc/pod/Gtk2/Pango.html

http://docs.scribus.net/index.php?lang=en&page=hyphenator
indicates it uses the TeX algorithm, as also used in OO.

Apparently InDesign also uses the TeX hyphenation and line breaking code.

=head2 java Batik

See http://xml.apache.org/batik/

<svg xmlns="http://www.w3.org/2000/svg" width="100" height="100">
 <text x="0" y="36" style="font-size: 36.0; stroke-width:0.0072; text-anchor: middle; font-weight:bold;">
   Hello
 </text>
</svg>

=head2 C command pstext

Part of TeX


=head command text2ps

Many by that name. One is http://www.greenend.org.uk/rjk/2002/03/text2ps


=head1 SEE ALSO

 Text::Convert::ToImage
 GD::SecurityImage

=cut


my $DEBUG = $ENV{DEBUG};

use Data::Dumper;
sub debug {
    print STDERR 'DEBUG: ', @_, "\n" if $DEBUG;
}
sub warning {
    print STDERR 'WARNING: ', @_, "\n";
}

################################################################
sub image_dims {
    my ($text_width, $text_height, $ARGS) = @_;
    my $margin = $ARGS->{margin} || 0;
    die "bad args", Dumper([@_]) unless $text_width && $text_height;
    my $width = $text_width + ($ARGS->{'margin-left'}||$margin) + ($ARGS->{'margin-right'}||$margin);
    my $height = $text_height + ($ARGS->{'margin-top'}||$margin) + ($ARGS->{'margin-bottom'}||$margin);
    debug("calculated image dims of $width", 'x', "$height from text dims $text_width", 'x', $text_height);
    return ($width, $height);
}

sub text_dims {
    my ($ARGS, $metrics) = @_;
    my $text_width = $ARGS->{width} || $metrics->{text_width};
    my $text_height = $ARGS->{height} || $metrics->{em_height} || $metrics->{text_height};
    return ($text_width, $text_height);
}

sub line_height {
    my ($ARGS) = @_;
    my $lh = $ARGS->{'line-height'} || '100%';
    if ($lh =~ m/(\d+)\%/) {
	$lh = $1 / 100;
    }
    $lh = $lh * $ARGS->{'font-size'};
    debug("calculated line height=$lh");
    return $lh;
}

################################################################

use GD;

our $COLOR_NAMES = {
    black => '#000000',
    white => '#FFFFFF'
};
sub gd_color {
    my ($color) = @_;
    # $color = "#$color" if $color =~ m/^[A-F0-9]{6}$/;
    $color = $COLOR_NAMES->{$color} || $color;
    my @rgb;
    if ($color eq 'transparent') {
	@rgb = (0,0,0);
    }
    elsif ($color =~ m/\#(\w)(\w)(\w)$/i) {
	@rgb = (hex("$1$1"), hex("$2$2"), hex("$3$3")); 
    }
    elsif ($color =~ m/\#(\w\w)(\w\w)(\w\w)/) {
	@rgb = (hex($1), hex($2), hex($3));
    }
    else {
	warning("passing through color '$color'");
	return $color;
    }
    debug("parsed color '$color' into @rgb");
    return @rgb;

}
sub gd_fontsize {
    my ($pixels) = @_;
    return $pixels * 72.0 / 96.0;
}

# GD metrics are based on what was actually drawn, not the font metrics 
sub gd_get_metrics {
    my ($font_face_src, $font_size, $text, $ft_options) = @_;
    # bottom left x, y
    # bottom right x, y
    # top right x, y
    # top left x, y
    my @bounds = GD::Image->stringFT(0, $font_face_src, $font_size, 0, 0, 0, $text, $ft_options);
    my ($blx, $bly, $brx, $bry, $trx, $try, $tlx, $tly) = @bounds;
    my $metrics = {
	blx => $blx, bly => $bly, brx => $brx, bry => $bry, trx => $trx, 'try' => $try, tlx => $tlx, tly => $tly,
	text_width => $trx - $tlx,
	text_height => $bry - $try,
    };
    debug("got GD metrics: ", Dumper($metrics));
    return $metrics;
}

sub gd_draw_pos {
    my ($ARGS, $metrics) = @_;
    # string() starts from upper left, while stringFT starts from lower left? or from baseline?

    my $draw_x = ($ARGS->{'margin-left'}||$ARGS->{margin}||0) - $metrics->{blx};
       # $height; # $ARGS->{'font-size'}; # + $bounds->[7];
    my $draw_y = ($ARGS->{'margin-top'}||$ARGS->{margin}||0) - $metrics->{tly};
    debug("draw position is: draw_x=$draw_x draw_y=$draw_y from: ", Dumper($metrics));
    return ($draw_x, $draw_y);
}

sub gd_text_to_image {
    my ($outfile, $ARGS) = @_;

    my $ft_options = {
	# GD has some sort of implicit doubling
	# linespacing => 0.5 * line_height($ARGS),
	# charmap
	# resolution
	# kerning
    };

    my $font_size = gd_fontsize($ARGS->{'font-size'});

    my $metrics = gd_get_metrics($ARGS->{'font-face-src'}, $font_size, $ARGS->{content}, $ft_options);

    my ($text_width, $text_height) = text_dims($ARGS, $metrics);
    my ($image_width, $image_height) = image_dims($text_width, $text_height, $ARGS);

    # boolean 24-bit or 8-bit
    $ARGS->{'color-bits'} ||= 8;
    my $truecolor = $ARGS->{'color-bits'} >= 24 ? 'true' : undef;
    my $img = new GD::Image($image_width, $image_height, ($truecolor ? ($truecolor) : ())) || die "can't allocate image";

    # first allocated color is background
    my $bgcolor = $img->colorAllocate(gd_color($ARGS->{'background-color'}));

    # transparent background
    $img->transparent($bgcolor) if $ARGS->{'background-color'} eq 'transparent';

    my $fgcolor = $img->colorAllocate(gd_color($ARGS->{'color'}));
    if (1) {
	$img->setAntiAliased($fgcolor);
	$fgcolor = gdAntiAliased;
    }

    my ($draw_x, $draw_y) = gd_draw_pos($ARGS, $metrics);

    my @bounds = $img->stringFT($fgcolor,
				$ARGS->{'font-face-src'},
				# $fontsize_points,
				$font_size,
				0,
				$draw_x,
				$draw_y,
				$ARGS->{content}, 
				$ft_options);
    debug("got actual string GD bounds : ", Dumper([@bounds]));
    die "can't write text: $@" unless @bounds;
    gd_out($img, $outfile);
}

sub gd_out {
    my ($gd, $outfile) = @_;

    open(F, ">$outfile");

    my ($imagetype) = ($outfile =~ m,\.([^\.]+)$, ) ;
    die "no image type from outfile '$outfile'" unless $imagetype;
    debug("GD writing image type '$imagetype' to $outfile");
    if ($imagetype eq 'png') {
	# uses zlib's default compression
	print F $gd->png();
    }
    elsif ($imagetype eq 'jpeg') {
	my $jpeg_quality = '100';
	print F $gd->jpeg($jpeg_quality);
    }
    elsif ($imagetype eq 'gif') {
	print F $gd->gif();
    }
    else {die "image type '$imagetype' not supported"}
    close(F);
}

################################################################

# use Image::Magick;

sub im_new {
    require Image::Magick;
    return Image::Magick->new(@_);
}

sub im_color {
    my ($color) = @_;
    # IM doesn't support 3 letter hex
    if ($color =~ m/\#(\w)(\w)(\w)$/) {
	return "#$1$1$2$2$3$3";
    }
    return $color;
}

sub im_get_metrics {
    my ($font_face_src, $font_size, $text) = @_;
    my $dummy = im_new();
    $dummy->Read ('null:white');

    # http://www.imagemagick.org/script/perl-magick.php#misc
    # in C, GetTypeMetrics
    # TODO: need to use QueryMultilineFontMetrics for multiline text

    # There is a picture at http://redux.imagemagick.org/RMagick/doc/draw.html
    # which indicates that height is above the baseline, including the ascent and the leading above.
    # I don't think this is correct.

    # It is possible that ascent - descent > font size. That is because the fontsize
    # is just a parameter to a font, not having to match anything in particular.
    # Here is 100-pixel Helvetica:
    #   'em_width' => '100',
    #   'em_height' => '100',
    #   'text_width' => '323',
    #   'text_height_max' => '149',
    #   'ascent' => '96',
    #   'descent' => '-29'
    #   'maximum_horizontal_advance' => '102',
    # Here is 100-pixel African
    #     'em_width' => '100',
    #     'em_height' => '100',
    #     'ascent' => '84',
    #     'descent' => '-11',
    #     'text_width' => '401',
    #     'text_height_max' => '109'
    #     'maximum_horizontal_advance' => '106',
    # In one case, ascent - descent exceeds the font size (em_height), in the other it does not.
    #
    # IM (because of freetype) interprets the string drawing y to be the baseline.
    # In IM, the baseline seems to be em_height + descent from the top of the ascender.
    #
    # freetype describes things well, at http://freetype.sourceforge.net/freetype2/docs/glyphs/glyphs-3.html#section-1
    #    text_height_max = line-height = baseline-to-baseline = ascent - descent + linegap
    #    internal leading = ascent - descent - em_height
    # In the case of Helvetica
    #    text_height_max = 149 = linegap(24) + ascent(96) - descent(-29) 
    #    internal leading = 96 - -29 - 100 = 25
    #    external leading = linegap = 149 - (96 - -29) = 24
    # So this means the line-height 124%.
    # In African:
    #    text_height_max = 109 = linegap(14) + ascent(84) - descent(-11)
    #    internal leading = 84 - -11 - 100 = -5

    my @metric = $dummy->QueryFontMetrics (font => $font_face_src,
					       text => $text,
					       pointsize => $font_size);
    my $metrics = {
	em_width => $metric[0],   # pixels per em
	em_height => $metric[1],  # pixels per em
	ascent => $metric[2],
	descent => $metric[3],
	text_width => $metric[4], # depends on the text
	text_height_max => $metric[5], # depends on just the font
	maximum_horizontal_advance => $metric[6],
    };
    debug("got IM metrics: ", Dumper($metrics));
    return $metrics;
}

sub im_draw_pos {
    my ($ARGS, $metrics) = @_;
    my $draw_x = $ARGS->{'margin-left'} || $ARGS->{margin} || 0;

    # IM starts at baseline (= font size - descent)
    my $draw_y = ($ARGS->{'margin-top'}||$ARGS->{margin}||0);

    # The "line gap", aka "leading" is what is left after adding ascent and descent heights.
    # In CSS this is supposed to be split 50-50:
    #    http://css.nu/articles/line-height.html
    #    http://www.meyerweb.com/eric/css/inline-format.html
    #    http://archivist.incutio.com/viewlist/css-discuss/38730

    debug("starting position based on margin: x=$draw_x y=$draw_y");

    my $fs = $ARGS->{'font-size'};

    my $linegap = $metrics->{text_height_max} - ($metrics->{ascent} - $metrics->{descent});
    my $internal_leading = ($metrics->{ascent} - $metrics->{descent}) - $fs;
    debug("calculated linegap=$linegap internal_leading=$internal_leading");

    my $valign = 'bottom';
    # puts the top of the ascender of the glyph up at the top
    if ($valign eq 'top') {
	# The descent value is negative, so adding it makes us starts higher.
	$draw_y +=  $fs + $metrics->{descent};
	# $draw_y += $metrics->{ascent} - $linegap;
	# $draw_y += $metrics->{ascent};
    }

    # This puts the bottom of the descender on the bottom
    elsif ($valign eq 'bottom') {
	$draw_y += $fs - $linegap;
    }

    elsif ($valign eq 'center') {
	$draw_y += $fs - 0.5 * ($metrics->{descent} - $linegap);
    }

    # put baseline on bottom of image
    elsif ($valign eq 'huh') {
	$draw_y += $fs - 0.5 * ($metrics->{ascent} - $ARGS->{'font-size'});
    }   
    else {
	die "unsupported valign='$valign'";
    }
    debug("draw_x=$draw_x draw_y=$draw_y");
    return ($draw_x, $draw_y);
}


sub im_text_to_image {
    my ($outfile, $ARGS) = @_;

    my $metrics = im_get_metrics($ARGS->{'font-face-src'}, $ARGS->{'font-size'}, $ARGS->{content});

    my ($text_width, $text_height) = text_dims($ARGS, $metrics);
    my ($image_width, $image_height) = image_dims($text_width, $text_height, $ARGS);

    my $x;
    my $image = im_new() || die "can't create";
    $x = $image->Set(size => $image_width . 'x' . $image_height);
    die $x if $x;

    my $bgcolor = im_color($ARGS->{'background-color'});
    my $fgcolor = im_color($ARGS->{'color'});
    $x = $image->Read("xc:$bgcolor"); # 'transparent';
    # $x = $image->Read('gradient:#00f685-#0083f8'); 
    die $x if $x;

    # 'Center', 'North', 'South', etc.
    my $halign = $ARGS->{'text-align'} || 'left';
    # NorthEast, etc.
    my $ALIGN_GRAVITY = {center => 'Center', left => 'West', right => 'East'};
    my $gravity = $ALIGN_GRAVITY->{$halign};

    # TODO: use gravity if dims are set but margins are not (or even if margin is set?)

    my ($draw_x, $draw_y) = im_draw_pos($ARGS, $metrics);

    # Caption will wrap within size; Annotate will clip; Label will set image size
    $x = $image->Annotate(
		font => $ARGS->{'font-face-src'}, 
		antialias => 'true', 
		pointsize => $ARGS->{'font-size'}, 
		# gravity => $gravity,
		x => $draw_x,
		  y => $draw_y,
			  # or 'none' if want transparent
		fill => $fgcolor,
		# stroke => $fgcolor,
		     text => $ARGS->{content},
		     # geometry => ("+" . $ARGS->{'margin-left'} . "+" . $ARGS->{'margin-top'}),
			  );
    die $x if $x;
    $x = $image->Write(filename => $outfile);
    die $x if $x;
    debug("wrote image to '$outfile'");
}

################################################################

my $TEST_ARGS = {
    'font-face-src' => 
    '/group/uhurufoods.org/public_html/pdfs/african_orig.ttf',
    #'Times:italic',
    # '/group/uhurufoods.org/public_html/pdfs/African-mew.pfb',
    #'/group/uhurufoods.org/public_html/pdfs/African.pfa',
    #'/usr/share/texmf/fonts/type1/urw/helvetic/uhvr8a.pfb', # helvetica regular
    #'/usr/share/texmf/fonts/type1/urw/times/utmri8a.pfb', # times italic
    # AfricanOrnamentsOne.ttf,

    content => 'Homeg',

    'background-color' => '#FFFFB3',
    'color' => '#C2B9D9',
    'font-size' => '100',
#    'width' => '200',
#    'height' => '20',
#    'margin-left' => '20', 'margin-top' => '20', 'margin-bottom' => '20', 'margin-right' => '20',
	margin => 0,
    'text-align' => 'center',
    'color-bits' => '2',
};

sub test_main {
    im_text_to_image('testim.png', $TEST_ARGS);
    gd_text_to_image("testgd.png", $TEST_ARGS);
}

sub main {
    return test_main if @ARGV && $ARGV[0] eq 'test';
    die "Usage: filename font-size 14 ...\n" unless @ARGV;
    my $file = shift @ARGV;
    my $ARGS = {@ARGV};
    my $driver = $ARGS->{driver} || 'im';
    if ($driver eq 'im') {
	im_text_to_image($file, $ARGS) ;
    }
    elsif ($driver eq 'gd') {
	gd_text_to_image($file, $ARGS) ;
    }
    else {
	die "unknown driver '$driver'";
    }

}
main();