File: 30_kern.t

package info (click to toggle)
libharfbuzz-shaper-perl 0.031%2Bds-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 204 kB
  • sloc: perl: 1,282; makefile: 3
file content (71 lines) | stat: -rw-r--r-- 1,870 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
#! perl

use strict;
use warnings;
use utf8;

-d 't' && chdir 't';

use Test::More tests => 4;
BEGIN { use_ok('HarfBuzz::Shaper') };

my $hb = HarfBuzz::Shaper->new;

$hb->set_font('/usr/share/fonts/opentype/urw-base35/NimbusRoman-Regular.otf');
$hb->set_size(36);
$hb->set_text("LVAT");
my $info = $hb->shaper;
#use DDumper; DDumper($info);
my $result = [
  { ax => '17.856', ay => 0, dx => 0, dy => 0, g => 45, name => 'L' },
  { ax => '21.672', ay => 0, dx => 0, dy => 0, g => 55, name => 'V' },
  { ax => '24.048', ay => 0, dx => 0, dy => 0, g => 34, name => 'A' },
  { ax => '21.996', ay => 0, dx => 0, dy => 0, g => 53, name => 'T' },
];

ok(compare( $info, $result ), "content default kern" );

$hb->set_features( 'kern=1' );
$info = $hb->shaper;

ok(compare( $info, $result ), "content +kern feature" );

$info = $hb->shaper( [ '-kern' ] );

$result = [
  { ax => '21.996', ay => 0, dx => 0, dy => 0, g => 45, name => 'L' },
  { ax => '25.992', ay => 0, dx => 0, dy => 0, g => 55, name => 'V' },
  { ax => '25.992', ay => 0, dx => 0, dy => 0, g => 34, name => 'A' },
  { ax => '21.996', ay => 0, dx => 0, dy => 0, g => 53, name => 'T' },
];

ok(compare( $info, $result ), "content -kern feature" );

sub compare {
    my ( $ist, $soll ) = @_;
    unless ( @$ist == @$soll ) {
	diag( scalar(@$ist) . " elements, must be " . scalar(@$soll) );
	return;
    }

    for ( 0 .. @$ist-1 ) {
	my $i = $ist->[$_];
	my $j = $soll->[$_];
	unless ( $i->{g} == $j->{g} ) {
	    diag( "CId $i->{g} must be $j->{g}" );
	    return;
	}
	unless ( $i->{name} eq $j->{name} or $i->{name} eq '' ) {
	    diag( "Name $i->{name} must be $j->{name}" );
	    return;
	}
	for ( qw( ax ay dx dy ) ) {
	    next if $i->{$_} == $j->{$_};
	    unless ( abs( $i->{$_} - $j->{$_} ) <= abs($j->{$_} / 100) ) {
		diag( "$_ $i->{$_} must be $j->{$_}" );
		return;
	    }
	}
    }
    return 1;
}