void
-i_tt_bbox(handle,point,str_sv,len_ignored, utf8)
+i_tt_bbox(handle,point,str_sv,utf8)
Imager::Font::TT handle
double point
SV* str_sv
STRLEN len;
int i;
PPCODE:
+ str = SvPV(str_sv, len);
#ifdef SvUTF8
if (SvUTF8(ST(2)))
utf8 = 1;
#endif
- str = SvPV(str_sv, len);
if ((rc=i_tt_bbox(handle,point,str,len,cords, utf8))) {
EXTEND(SP, rc);
for (i = 0; i < rc; ++i) {
size_t count;
size_t i;
PPCODE:
+ i_clear_error();
+ text = SvPV(text_sv, len);
#ifdef SvUTF8
if (SvUTF8(text_sv))
utf8 = 1;
#endif
- text = SvPV(text_sv, len);
work = mymalloc(len);
count = i_tt_has_chars(handle, text, len, utf8, work);
if (GIMME_V == G_ARRAY) {
size_t len;
size_t outsize;
char name[255];
+ SSize_t count = 0;
PPCODE:
+ i_clear_error();
+ text = SvPV(text_sv, work_len);
#ifdef SvUTF8
if (SvUTF8(text_sv))
utf8 = 1;
#endif
- text = SvPV(text_sv, work_len);
len = work_len;
while (len) {
unsigned long ch;
ch = i_utf8_advance(&text, &len);
if (ch == ~0UL) {
i_push_error(0, "invalid UTF8 character");
- break;
+ XSRETURN_EMPTY;
}
}
else {
ch = *text++;
--len;
}
- EXTEND(SP, 1);
+ EXTEND(SP, count);
if ((outsize = i_tt_glyph_name(handle, ch, name, sizeof(name))) != 0) {
- PUSHs(sv_2mortal(newSVpv(name, 0)));
+ ST(count) = sv_2mortal(newSVpv(name, 0));
}
else {
- PUSHs(&PL_sv_undef);
- }
+ ST(count) = &PL_sv_undef;
+ }
+ ++count;
}
+ XSRETURN(count);
#endif
t/t31font.t General font interface tests
t/t35ttfont.t
t/t36oofont.t
+t/t37std.t Standard font tests for TT
t/t40scale.t
t/t50basicoo.t
t/t55trans.t
sub _bounding_box {
my $self = shift;
my %input = @_;
- return Imager::i_tt_bbox($self->{id}, $input{size},
- $input{string}, length($input{string}),
- $input{utf8});
+ my @result =
+ Imager::i_tt_bbox($self->{id}, $input{size}, $input{string}, $input{utf8});
+ unless (@result) {
+ Imager->_set_error(Imager->_error_as_msg);
+ return;
+ }
+
+ return @result;
}
sub utf8 { 1 }
sub has_chars {
my ($self, %hsh) = @_;
- unless (defined $hsh{string} && length $hsh{string}) {
+ unless (defined $hsh{string}) {
$Imager::ERRSTR = "No string supplied to \$font->has_chars()";
return;
}
- return Imager::i_tt_has_chars($self->{id}, $hsh{string},
- _first($hsh{'utf8'}, $self->{utf8}, 0));
+ if (wantarray) {
+ my @result = Imager::i_tt_has_chars($self->{id}, $hsh{string},
+ _first($hsh{'utf8'}, $self->{utf8}, 0));
+ unless (@result) {
+ Imager->_set_error(Imager->_error_as_msg);
+ return;
+ }
+ return @result;
+ }
+ else {
+ my $result = Imager::i_tt_has_chars($self->{id}, $hsh{string},
+ _first($hsh{'utf8'}, $self->{utf8}, 0));
+ unless (defined $result) {
+ Imager->_set_error(Imager->_error_as_msg);
+ return;
+ }
+
+ return $result;
+ }
}
sub face_name {
Imager::i_tt_face_name($self->{id});
}
+sub can_glyph_names {
+ 1;
+}
+
sub glyph_names {
my ($self, %input) = @_;
or return Imager->_set_error("no string parameter passed to glyph_names");
my $utf8 = _first($input{utf8} || 0);
- Imager::i_tt_glyph_name($self->{id}, $string, $utf8);
+ my @names = Imager::i_tt_glyph_name($self->{id}, $string, $utf8);
+ unless (@names) {
+ Imager->_set_error(Imager->_error_as_msg);
+ return;
+ }
+
+ return @names;
}
1;
my $ttraw = Imager::i_tt_new($fontname);
ok($ttraw, "create font");
- my @bbox = i_tt_bbox($ttraw,50.0,'XMCLH',6,0);
+ my @bbox = i_tt_bbox($ttraw,50.0,'XMCLH',0);
is(@bbox, 8, "bounding box");
print "#bbox: ($bbox[0], $bbox[1]) - ($bbox[2], $bbox[3])\n";
my $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
my $alttext = "A-A";
- my @utf8box = i_tt_bbox($ttraw, 50.0, $text, length($text), 1);
+ my @utf8box = i_tt_bbox($ttraw, 50.0, $text, 1);
is(@utf8box, 8, "utf8 bbox element count");
- my @base = i_tt_bbox($ttraw, 50.0, $alttext, length($alttext), 0);
+ my @base = i_tt_bbox($ttraw, 50.0, $alttext, 0);
is(@base, 8, "alt bbox element count");
my $maxdiff = $fontname eq $deffont ? 0 : $base[2] / 3;
print "# (@utf8box vs @base)\n";
"draw UTF8");
ok(i_tt_cp($ttraw, $backgr, 350, 80, 0, 14, $text, 0, 1, 0),
"cp UTF8");
- @utf8box = i_tt_bbox($ttraw, 50.0, $text, length($text), 0);
+ @utf8box = i_tt_bbox($ttraw, 50.0, $text, 0);
is(@utf8box, 8, "native utf8 bbox element count");
ok(abs($utf8box[2] - $base[2]) <= $maxdiff,
"compare box sizes native $utf8box[2] vs $base[2] (maxerror $maxdiff)");
--- /dev/null
+#!perl -w
+use strict;
+use Imager::Test qw(std_font_tests std_font_test_count);
+use Imager::Font;
+use Test::More;
+
+$Imager::formats{tt}
+ or plan skip_all => "No tt available";
+
+plan tests => std_font_test_count();
+
+my $font = Imager::Font->new(file => "fontfiles/dodge.ttf",
+ type => "tt");
+my $name_font =
+ Imager::Font->new(file => "fontfiles/ImUgly.ttf",
+ type => "tt");
+
+SKIP:
+{
+ $font
+ or skip "Cannot load font", std_font_test_count();
+ std_font_tests
+ ({
+ font => $font,
+ has_chars => [ 1, 1, 1 ],
+ glyph_name_font => $name_font,
+ glyph_names => [ qw(A uni2010 A) ],
+ });
+}