Initial Commit

database/perl/vendor/lib/Imager/Font/Image.pm

@@ -0,0 +1,168 @@
+package Imager::Font::Image;
+use 5.006;
+use strict;
+use Imager::Color;
+use File::Basename;
+use File::Spec;
+
+our @ISA = qw(Imager::Font);
+our $VERSION = "1.000";
+
+sub NWIDTH   () { 0 }
+sub PWIDTH   () { 2 }
+sub GDESCENT () { 1 }
+sub GASCENT  () { 3 }
+sub DESCENT  () { 4 }
+sub ASCENT   () { 5 }
+
+
+our %REQUIRED_FIELDS = (
+	Image_spec     => 1,
+	Font_size      => 1,
+	Global_ascent  => 1,
+	Global_descent => 1,);
+
+# Required fields
+# Fontmetrics:
+# Font global data:
+#   image name
+#   font size
+#   max glyph height
+#   max glyph width
+#
+# The per character data is:
+#   left edge   (inclusive)
+#   right edge  (exclusive)
+#   top edge    (inclusive)
+#   bottom edge (exclusive)
+#   left adjustment
+#   forward shift
+#   baseline adjustment (from top)
+#
+# The left adjustment is the starting
+# offset into the glyph, the forward shift
+# is the actual forward movement of the
+# imaginary cursor.
+
+# To calculate the size of a string use:
+#  sum (forward_shift_i) + left_adjustment_0 + width_last - left_adjustment_last - forward_shift_last
+
+# example font spec file:
+
+# IAGRFONT
+# # This is an imager font definition file.  This is a comment
+# Image_spec = foo.png
+# Font_size  = 12
+# Global_ascent = 10
+# Global_descent = -2
+# # Per character data
+# FM_65 = 20 40 30 50 3 15
+# # Code for 'A' left edge = 20, right = 40, top = 30, bottom 50, leading = 3, forward = 15.
+# The left adjustment is the starting
+# offset into the glyph, the forward shift
+# is the actual forward movement of the
+# imaginary cursor.
+
+# To calculate the size of a string use:
+#  sum (forward_shift_i) + left_adjustment_0 + width_last - left_adjustment_last - forward_shift_last
+
+
+
+sub parse_fontspec_file {
+  my ($self, $file) = @_;
+  local *FH;
+  return unless open(FH, "<$file");
+
+  my %req = %REQUIRED_FIELDS;
+
+  while(<FH>) {
+    next if m/^\#/;
+    if (m/^\s*?(\S+?)\s*=\s*(.+?)\s*$/) {
+      # Check for a required field:
+      my $char = $1;
+      my $metric = $2;
+      if ($req{$char}) {
+	$self->{$char} = $metric;
+	delete $req{$1};
+      } else {
+	next unless $char =~ s/^FM_(\d+)$/$1/;
+	next unless $metric =~ m/(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)$/;
+	$self->{fm}->{$char} = [$1, $2, $3, $4, $5, $6];
+      }
+    }
+  }
+  close(FH);
+  return $self;
+}
+
+
+
+sub new {
+  my $self = bless {}, shift;
+  my %opts = (color=>Imager::Color->new(255, 0, 0, 0), @_);
+
+  unless ($opts{file}) {
+    $Imager::ERRSTR = "No font file specified";
+    return;
+  }
+  unless ($self->parse_fontspec_file($opts{file})) {
+    $Imager::ERRSTR = "Font file $opts{file} not found or bad";
+    return;
+  }
+
+  my $img = Imager->new();
+  my $img_filename = File::Spec->catfile( dirname($opts{'file'}),
+					  $self->{Image_spec} );
+
+  unless ($img->open(%opts, file=>$img_filename)) {
+    $Imager::ERRSTR = "Font IMAGE file $img_filename not found or bad: ".
+      $img->errstr();
+    return;
+  }
+
+  $self->{image} = $img;
+  $self->{size} = $self->{Font_size};
+  return $self;
+}
+
+sub get_glyph_data {
+  my ($self, $glyph_code) = @_;
+  return unless exists $self->{fm}->{$glyph_code};
+  return @{$self->{fm}->{$glyph_code}};
+}
+
+# copy_glyph
+#
+# $x, $y is left, baseline for glyphs.
+#
+
+sub copy_glyph {
+  my ($self, $glyph_code, $target_img, $x, $y) = @_;
+
+  my @gdata = $self->get_glyph_data($glyph_code) or return;
+
+  $target_img->rubthrough(src=>$self->{image},
+			  tx => $x + $gdata[4],
+			  ty => $y -  $self->{Global_ascent},,
+			  src_minx => $gdata[0],
+			  src_maxx => $gdata[1],
+			  src_miny => $gdata[2],
+			  src_maxy => $gdata[3]);
+}
+
+sub _draw {
+  my ($self, %opts) = @_;
+
+  my $x = $opts{'x'};
+  my $y = $opts{'y'};
+
+  my @glyphs = unpack("C*", $opts{string});
+  my $img = $opts{image};
+
+  my $glyph;
+  for $glyph (@glyphs) {
+    my @gmetrics = $self->get_glyph_data($glyph) or next;
+    $self->copy_glyph($glyph, $img, $x, $y);
+    $x += $gmetrics[5];
+  }
+}