- support has_chars() method for Freetype 1.x
- fixed log message for i_ft2_has_chars()
- fixed some broken checking for UTF8 in FT2 code
+ - handle UTF8 strings passed to T1 low-level functions
+ - handle flags for underline, strikethrough and overline for T1
+ low-level output functions
+ - OO interfaces to UTF8 and flags, for now leaving the flags as
+ specific to Imager::Font::Type1
=================================================================
undef_int
-i_t1_cp(im,xb,yb,channel,fontnum,points,str,len,align)
+i_t1_cp(im,xb,yb,channel,fontnum,points,str_sv,len_ignored,align,utf8=0,flags="")
Imager::ImgRaw im
int xb
int yb
int channel
int fontnum
float points
- char* str
- int len
+ SV* str_sv
int align
+ int utf8
+ char* flags
+ PREINIT:
+ char *str;
+ STRLEN len;
+ CODE:
+#ifdef SvUTF8
+ if (SvUTF8(str_sv))
+ utf8 = 1;
+#endif
+ str = SvPV(str_sv, len);
+ RETVAL = i_t1_cp(im, xb,yb,channel,fontnum,points,str,len,align,
+ utf8,flags);
+ OUTPUT:
+ RETVAL
+
void
-i_t1_bbox(fontnum,point,str,len)
+i_t1_bbox(fontnum,point,str_sv,len_ignored,utf8=0,flags="")
int fontnum
float point
- char* str
- int len
+ SV* str_sv
+ int utf8
+ char* flags
PREINIT:
+ char *str;
+ STRLEN len;
int cords[6];
+ int i;
PPCODE:
- i_t1_bbox(fontnum,point,str,len,cords);
- EXTEND(SP, 4);
- PUSHs(sv_2mortal(newSViv(cords[0])));
- PUSHs(sv_2mortal(newSViv(cords[1])));
- PUSHs(sv_2mortal(newSViv(cords[2])));
- PUSHs(sv_2mortal(newSViv(cords[3])));
- PUSHs(sv_2mortal(newSViv(cords[4])));
- PUSHs(sv_2mortal(newSViv(cords[5])));
+#ifdef SvUTF8
+ if (SvUTF8(str_sv))
+ utf8 = 1;
+#endif
+ str = SvPV(str_sv, len);
+ i_t1_bbox(fontnum,point,str,len,cords,utf8,flags);
+ EXTEND(SP, 6);
+ for (i = 0; i < 6; ++i)
+ PUSHs(sv_2mortal(newSViv(cords[i])));
undef_int
-i_t1_text(im,xb,yb,cl,fontnum,points,str,len,align)
+i_t1_text(im,xb,yb,cl,fontnum,points,str_sv,len_ignored,align,utf8=0,flags="")
Imager::ImgRaw im
int xb
int yb
Imager::Color cl
int fontnum
float points
- char* str
- int len
+ SV* str_sv
int align
+ int utf8
+ char* flags
+ PREINIT:
+ char *str;
+ STRLEN len;
+ CODE:
+#ifdef SvUTF8
+ if (SvUTF8(str_sv))
+ utf8 = 1;
+#endif
+ str = SvPV(str_sv, len);
+ RETVAL = i_t1_text(im, xb,yb,cl,fontnum,points,str,len,align,
+ utf8,flags);
+ OUTPUT:
+ RETVAL
#endif
- Compile with memory debugging enabled and fix all leaks
-- dynaload.c is strongly tied to perl
-
- Add mycalloc() memory allocation wrappers.
- should we overload <=> or cmp for Imager::Color objects?
#include <stdio.h>
#include <stdlib.h>
-
-
-
-
-
/*
=head1 NAME
#ifdef HAVE_LIBT1
-
+static int t1_get_flags(char const *flags);
+static char *t1_from_utf8(char const *in, int len, int *outlen);
/*
=item i_init_t1(t1log)
int
i_t1_new(char *pfb,char *afm) {
int font_id;
+
mm_log((1,"i_t1_new(pfb %s,afm %s)\n",pfb,(afm?afm:"NULL")));
font_id = T1_AddFont(pfb);
if (font_id<0) {
mm_log((1,"i_t1_new: requesting afm file '%s'.\n",afm));
if (T1_SetAfmFileName(font_id,afm)<0) mm_log((1,"i_t1_new: afm loading of '%s' failed.\n",afm));
}
+
return font_id;
}
*/
undef_int
-i_t1_cp(i_img *im,int xb,int yb,int channel,int fontnum,float points,char* str,int len,int align) {
+i_t1_cp(i_img *im,int xb,int yb,int channel,int fontnum,float points,char* str,int len,int align, int utf8, char const *flags) {
GLYPH *glyph;
int xsize,ysize,x,y;
i_color val;
+ int mod_flags = t1_get_flags(flags);
unsigned int ch_mask_store;
if (im == NULL) { mm_log((1,"i_t1_cp: Null image in input\n")); return(0); }
- glyph=T1_AASetString( fontnum, str, len, 0, T1_KERNING, points, NULL);
+ if (utf8) {
+ int worklen;
+ char *work = t1_from_utf8(str, len, &worklen);
+ glyph=T1_AASetString( fontnum, work, worklen, 0, mod_flags, points, NULL);
+ myfree(work);
+ }
+ else {
+ glyph=T1_AASetString( fontnum, str, len, 0, mod_flags, points, NULL);
+ }
if (glyph == NULL)
return 0;
*/
void
-i_t1_bbox(int fontnum,float points,char *str,int len,int cords[6]) {
+i_t1_bbox(int fontnum,float points,char *str,int len,int cords[6], int utf8,char const *flags) {
BBox bbox;
BBox gbbox;
+ int mod_flags = t1_get_flags(flags);
mm_log((1,"i_t1_bbox(fontnum %d,points %.2f,str '%.*s', len %d)\n",fontnum,points,len,str,len));
T1_LoadFont(fontnum); /* FIXME: Here a return code is ignored - haw haw haw */
- bbox = T1_GetStringBBox(fontnum,str,len,0,T1_KERNING);
+ if (utf8) {
+ int worklen;
+ char *work = t1_from_utf8(str, len, &worklen);
+ bbox = T1_GetStringBBox(fontnum,work,worklen,0,mod_flags);
+ myfree(work);
+ }
+ else {
+ bbox = T1_GetStringBBox(fontnum,str,len,0,mod_flags);
+ }
gbbox = T1_GetFontBBox(fontnum);
mm_log((1,"bbox: (%d,%d,%d,%d)\n",
*/
undef_int
-i_t1_text(i_img *im,int xb,int yb,i_color *cl,int fontnum,float points,char* str,int len,int align) {
+i_t1_text(i_img *im,int xb,int yb,i_color *cl,int fontnum,float points,char* str,int len,int align, int utf8, char const *flags) {
GLYPH *glyph;
int xsize,ysize,x,y,ch;
i_color val;
unsigned char c,i;
+ int mod_flags = t1_get_flags(flags);
if (im == NULL) { mm_log((1,"i_t1_cp: Null image in input\n")); return(0); }
- glyph=T1_AASetString( fontnum, str, len, 0, T1_KERNING, points, NULL);
+ if (utf8) {
+ int worklen;
+ char *work = t1_from_utf8(str, len, &worklen);
+ glyph=T1_AASetString( fontnum, work, worklen, 0, mod_flags, points, NULL);
+ myfree(work);
+ }
+ else {
+ glyph=T1_AASetString( fontnum, str, len, 0, mod_flags, points, NULL);
+ }
if (glyph == NULL)
return 0;
return 1;
}
+/*
+=item t1_get_flags(flags)
+
+Processes the characters in I<flags> to create a mod_flags value used
+by some T1Lib functions.
+
+=cut
+ */
+static int
+t1_get_flags(char const *flags) {
+ int mod_flags = T1_KERNING;
+
+ while (*flags) {
+ switch (*flags++) {
+ case 'u': case 'U': mod_flags |= T1_UNDERLINE; break;
+ case 'o': case 'O': mod_flags |= T1_OVERLINE; break;
+ case 's': case 'S': mod_flags |= T1_OVERSTRIKE; break;
+ /* ignore anything we don't recognize */
+ }
+ }
+
+ return mod_flags;
+}
+
+/*
+=item t1_from_utf8(char const *in, int len, int *outlen)
+
+Produces an unencoded version of I<in> by dropping any Unicode
+character over 255.
+
+Returns a newly allocated buffer which should be freed with myfree().
+Sets *outlen to the number of bytes used in the output string.
+
+=cut
+*/
+
+static char *
+t1_from_utf8(char const *in, int len, int *outlen) {
+ char *out = mymalloc(len+1);
+ char *p = out;
+ unsigned long c;
+
+ while (len) {
+ c = i_utf8_advance(&in, &len);
+ if (c == ~0UL) {
+ myfree(out);
+ i_push_error(0, "invalid UTF8 character");
+ return 0;
+ }
+ /* yeah, just drop them */
+ if (c < 0x100) {
+ *p++ = (char)c;
+ }
+ }
+ *p = '\0';
+ *outlen = p - out;
+
+ return out;
+}
#endif /* HAVE_LIBT1 */
undef_int i_init_t1( int t1log );
int i_t1_new( char *pfb, char *afm );
int i_t1_destroy( int font_id );
-undef_int i_t1_cp( i_img *im, int xb, int yb, int channel, int fontnum, float points, char* str, int len, int align );
-undef_int i_t1_text( i_img *im, int xb, int yb, i_color *cl, int fontnum, float points, char* str, int len, int align );
-void i_t1_bbox( int fontnum, float point, char *str, int len, int cords[6] );
+undef_int i_t1_cp( i_img *im, int xb, int yb, int channel, int fontnum, float points, char* str, int len, int align, int utf8, char const *flags );
+undef_int i_t1_text( i_img *im, int xb, int yb, i_color *cl, int fontnum, float points, char* str, int len, int align, int utf8, char const *flags );
+void i_t1_bbox( int fontnum, float point, char *str, int len, int cords[6], int utf8, char const *flags );
void i_t1_set_aa( int st );
void close_t1( void );
my $self = shift;
my %input = @_;
t1_set_aa_level($input{aa});
+ my $flags = '';
+ $flags .= 'u' if $input{underline};
+ $flags .= 's' if $input{strikethrough};
+ $flags .= 'o' if $input{overline};
if (exists $input{channel}) {
Imager::i_t1_cp($input{image}{IMG}, $input{'x'}, $input{'y'},
$input{channel}, $self->{id}, $input{size},
- $input{string}, length($input{string}), $input{align});
+ $input{string}, length($input{string}), $input{align},
+ $input{utf8}, $flags);
} else {
Imager::i_t1_text($input{image}{IMG}, $input{'x'}, $input{'y'},
$input{color}, $self->{id}, $input{size},
$input{string}, length($input{string}),
- $input{align});
+ $input{align}, $input{utf8}, $flags);
}
return $self;
sub _bounding_box {
my $self = shift;
my %input = @_;
+ my $flags = '';
+ $flags .= 'u' if $input{underline};
+ $flags .= 's' if $input{strikethrough};
+ $flags .= 'o' if $input{overline};
return Imager::i_t1_bbox($self->{id}, $input{size}, $input{string},
- length($input{string}));
+ length($input{string}), $input{utf8}, $flags);
}
1;
Imager::init(t1log=>1);
+Currently specific to Imager::Font::Type1, you can use the following
+flags when drawing text or calculating a bounding box:
+
+=over
+
+=item underline
+
+Draw the text with an underline.
+
+=item overline
+
+Draw the text with an overline.
+
+=item strikethrough
+
+Draw the text with a strikethrough.
+
+=back
+
+Obviously, if you're calculating the bounding box the size of the line
+is included in the box, and the line isn't drawn :)
+
=head1 AUTHOR
Addi, Tony
+#!perl -w
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl test.pl'
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
-
-BEGIN { $| = 1; print "1..6\n"; }
+use strict;
+my $loaded;
+BEGIN { $| = 1; print "1..18\n"; }
END {print "not ok 1\n" unless $loaded;}
use Imager qw(:all);
use Imager::Color;
+require "t/testtools.pl";
$loaded = 1;
-print "ok 1\n";
+okx(1, "loaded");
#$Imager::DEBUG=1;
init_log("testout/t30t1font.log",1);
-if (!(i_has_format("t1")) ) {
- for (2..6) {
- print "ok $_ # skip t1lib unavailable or disabled\n";
- }
-} else {
+my $deffont = './fontfiles/dcr10.pfb';
- print "# has t1\n";
+my $fontname_pfb=$ENV{'T1FONTTESTPFB'}||$deffont;
+my $fontname_afm=$ENV{'T1FONTTESTAFM'}||'./fontfiles/dcr10.afm';
- $fontname_pfb=$ENV{'T1FONTTESTPFB'}||'./fontfiles/dcr10.pfb';
- $fontname_afm=$ENV{'T1FONTTESTAFM'}||'./fontfiles/dcr10.afm';
- if (! -f $fontname_pfb) {
- print "# cannot find fontfile for truetype test $fontname_pfb\n";
- skip();
- }
+if (!(i_has_format("t1")) ) {
+ skipx(17, "t1lib unavailable or disabled");
+}
+elsif (! -f $fontname_pfb) {
+ skipx(17, "cannot find fontfile for truetype test $fontname_pfb");
+}
+elsif (! -f $fontname_afm) {
+ skipx(17, "cannot find fontfile for truetype test $fontname_afm");
+} else {
- if (! -f $fontname_afm) {
- print "# cannot find fontfile for truetype test $fontname_afm\n";
- skip();
- }
+ print "# has t1\n";
- i_init_fonts();
i_t1_set_aa(1);
- $fnum=Imager::i_t1_new($fontname_pfb,$fontname_afm); # this will load the pfb font
- if ($fnum<0) { die "Couldn't load font $fontname_pfb"; }
+ my $fnum=Imager::i_t1_new($fontname_pfb,$fontname_afm); # this will load the pfb font
+ unless (okx($fnum >= 0, "load font $fontname_pfb")) {
+ skipx(6, "without the font I can't do a thing");
+ exit;
+ }
- $bgcolor=Imager::Color->new(255,0,0,0);
- $overlay=Imager::ImgRaw::new(200,70,3);
+ my $bgcolor=Imager::Color->new(255,0,0,0);
+ my $overlay=Imager::ImgRaw::new(200,70,3);
- i_t1_cp($overlay,5,50,1,$fnum,50.0,'XMCLH',5,1)
- or print "not ";
- print "ok 2\n";
+ okx(i_t1_cp($overlay,5,50,1,$fnum,50.0,'XMCLH',5,1), "i_t1_cp");
i_line($overlay,0,50,100,50,$bgcolor,1);
- @bbox=i_t1_bbox(0,50.0,'XMCLH',5);
- print "bbox: ($bbox[0], $bbox[1]) - ($bbox[2], $bbox[3])\n";
+ my @bbox=i_t1_bbox(0,50.0,'XMCLH',5);
+ okx(@bbox == 6, "i_t1_bbox");
+ print "# bbox: ($bbox[0], $bbox[1]) - ($bbox[2], $bbox[3])\n";
open(FH,">testout/t30t1font.ppm") || die "cannot open testout/t35t1font.ppm\n";
binmode(FH); # for os2
- $IO = Imager::io_new_fd( fileno(FH) );
+ my $IO = Imager::io_new_fd( fileno(FH) );
i_writeppm_wiol($overlay,$IO);
close(FH);
$bgcolor=Imager::Color::set($bgcolor,200,200,200,0);
- $backgr=Imager::ImgRaw::new(280,150,3);
+ my $backgr=Imager::ImgRaw::new(280,300,3);
i_t1_set_aa(2);
- i_t1_text($backgr,10,100,$bgcolor,$fnum,150.0,'test',4,1)
- or print "not ";
-
- print "ok 3\n";
+ okx(i_t1_text($backgr,10,100,$bgcolor,$fnum,150.0,'test',4,1), "i_t1_text");
+
+ # "UTF8" tests
+ # for perl < 5.6 we can hand-encode text
+ # since T1 doesn't support over 256 chars in an encoding we just drop
+ # chars over \xFF
+ # the following is "A\xA1\x{2010}A"
+ #
+ my $text = pack("C*", 0x41, 0xC2, 0xA1, 0xE2, 0x80, 0x90, 0x41);
+ my $alttext = "A\xA1A";
+ my @utf8box = i_t1_bbox($fnum, 50.0, $text, length($text), 1);
+ okx(@utf8box == 6, "utf8 bbox element count");
+ my @base = i_t1_bbox($fnum, 50.0, $alttext, length($alttext), 0);
+ okx(@base == 6, "alt bbox element count");
+ my $maxdiff = $fontname_pfb eq $deffont ? 0 : $base[2] / 3;
+ print "# (@utf8box vs @base)\n";
+ okx(abs($utf8box[2] - $base[2]) <= $maxdiff,
+ "compare box sizes $utf8box[2] vs $base[2] (maxerror $maxdiff)");
+
+ # hand-encoded UTF8 drawing
+ okx(i_t1_text($backgr, 10, 140, $bgcolor, $fnum, 32, $text, length($text), 1,1), "draw hand-encoded UTF8");
+
+ okx(i_t1_cp($backgr, 80, 140, 1, $fnum, 32, $text, length($text), 1, 1),
+ "cp hand-encoded UTF8");
+
+ # ok, try native perl UTF8 if available
+ if ($] >= 5.006) {
+ my $text;
+ # we need to do this in eval to prevent compile time errors in older
+ # versions
+ eval q{$text = "A\xA1\x{2010}A"}; # A, a with ogonek, HYPHEN, A in our test font
+ #$text = "A".chr(0xA1).chr(0x2010)."A"; # this one works too
+ okx(i_t1_text($backgr, 10, 180, $bgcolor, $fnum, 32, $text, length($text), 1),
+ "draw UTF8");
+ okx(i_t1_cp($backgr, 80, 180, 1, $fnum, 32, $text, length($text), 1),
+ "cp UTF8");
+ @utf8box = i_t1_bbox($fnum, 50.0, $text, length($text), 0);
+ okx(@utf8box == 6, "native utf8 bbox element count");
+ okx(abs($utf8box[2] - $base[2]) <= $maxdiff,
+ "compare box sizes native $utf8box[2] vs $base[2] (maxerror $maxdiff)");
+ eval q{$text = "A\xA1\xA2\x01\x1F\x{0100}A"};
+ okx(i_t1_text($backgr, 10, 220, $bgcolor, $fnum, 32, $text, 0, 1, 0, "uso"),
+ "more complex output");
+ }
+ else {
+ skipx(5, "perl too old to test native UTF8 support");
+ }
+
open(FH,">testout/t30t1font2.ppm") || die "cannot open testout/t35t1font.ppm\n";
binmode(FH);
$IO = Imager::io_new_fd( fileno(FH) );
i_writeppm_wiol($backgr, $IO);
close(FH);
- $rc=i_t1_destroy($fnum);
- if ($fnum <0) { die "i_t1_destroy failed: rc=$rc\n"; }
-
- print "ok 4\n";
+ my $rc=i_t1_destroy($fnum);
+ unless (okx($rc >= 0, "i_t1_destroy")) {
+ print "# i_t1_destroy failed: rc=$rc\n";
+ }
print "# debug: ",join(" x ",i_t1_bbox(0,50,"eses",4) ),"\n";
print "# debug: ",join(" x ",i_t1_bbox(0,50,"llll",4) ),"\n";
unlink "t1lib.log"; # lose it if it exists
init(t1log=>0);
- print -e("t1lib.log") ? "not ok 5\n" : "ok 5\n";
+ okx(!-e("t1lib.log"), "disable t1log");
init(t1log=>1);
- print -e("t1lib.log") ? "ok 6\n" : "not ok 6\n";
+ okx(-e("t1lib.log"), "enable t1log");
init(t1log=>0);
unlink "t1lib.log";
}
# (It may become useful if the test is moved to ./t subdirectory.)
my $loaded;
-BEGIN { $| = 1; print "1..16\n"; }
+BEGIN { $| = 1; print "1..20\n"; }
END {print "not ok 1\n" unless $loaded;}
use Imager;
require "t/testtools.pl";
$img->box(box=>\@bbox, color=>$green);
+ # "utf8" support
+ $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
+ okx($img->string(font=>$font, text=>$text, 'x'=>100, 'y'=>50, utf8=>1,
+ overline=>1),
+ "draw 'utf8' hand-encoded text");
+
+ okx($img->string(font=>$font, text=>$text, 'x'=>140, 'y'=>50, utf8=>1,
+ underline=>1, channel=>2),
+ "channel 'utf8' hand-encoded text");
+
+ if($] >= 5.006) {
+ eval q{$text = "A\x{2010}A"};
+ okx($img->string(font=>$font, text=>$text, 'x'=>180, 'y'=>50,
+ strikethrough=>1),
+ "draw native UTF8 text");
+ okx($img->string(font=>$font, text=>$text, 'x'=>220, 'y'=>50, channel=>1),
+ "channel native UTF8 text");
+ }
+ else {
+ skipx(2, "perl too old for native utf8");
+ }
+
okx($img->write(file=>"testout/t36oofont1.ppm", type=>'pnm'),
"write t36oofont1.ppm")
or print "# ",$img->errstr,"\n";
} else {
- skipx(4, "T1lib missing or disabled");
+ skipx(8, "T1lib missing or disabled");
}
if (i_has_format("tt") and -f $fontname_tt) {
float* T_ARRAY
undef_int T_IV_U
HASH T_HVREF
+utf8_str T_UTF8_STR
#############################################################################
INPUT
T_PTR_NULL
projects / imager.git / commitdiff