1use strict;
2use warnings;
3use open ':std', ':encoding(utf8)';
4
5use Test::More;
6use Prima::sys::Test;
7use Prima::Application;
8use open ':std', ':encoding(utf8)';
9
10my $x;
11
12sub t
13{
14	my $f = shift;
15
16	$x->set_font({
17		name     => $f->{name},
18		height   => $f->{height} || 10,
19		pitch    => $f->{pitch},
20		encoding => $f->{encoding},
21	});
22
23	my $ok = 1;
24	for ( qw( height size direction)) {
25	       my $fx = $x-> font-> $_();
26	       $x-> font( $_ => $x-> font-> $_() * 3 + 12);
27	       my $fx2 = $x-> font-> $_();
28	       SKIP: {
29	           if ( $fx2 == $fx || $x->font->name ne $f->{name}) {
30	               skip "$_", 1;
31	               next;
32	           }
33	           $x-> font( $_ => $fx);
34	           $ok &= is( $x-> font-> $_(), $fx, "$_ / $f->{name}");
35	       };
36	}
37
38	# width is a bit special, needs height or size
39	for (qw( height size)) {
40		my $fh = $x-> font-> $_();
41		$x-> font( $_ => $fh ); # size can be fractional inside
42		my $fw = $x-> font-> width;
43		my $fn = $x-> font-> name;
44		$x-> font( $_ => $fh, width => $fw * 3 + 12);
45		my $fw2 = $x-> font-> width;
46		SKIP: {
47		    if ( $fw2 == $fw || $x->font->name ne $f->{name}) {
48		        skip "width / $f->{name}", 1;
49		        next;
50		    }
51		    $x-> font( $_ => $fh, width => $fw, name => $fn );
52		    $ok &= is( $x-> font-> width, $fw, "width by $_ / $f->{name}");
53		};
54	}
55
56
57	# style
58	my $fx = $x-> font-> style;
59	my $newfx = ~$fx;
60	$x-> font( style => $newfx);
61	my $fx2 = $x-> font-> style;
62	SKIP : {
63	    if ( $fx2 == $fx || $x->font->name ne $f->{name}) {
64	        skip "style", 1;
65	    }
66	    $x-> font( style => $fx);
67	    is( $x-> font-> style, $fx, "style / $f->{name}");
68	};
69
70	# wrapping
71	SKIP : {
72		$x-> font-> height( 16);
73		my ($a,$b,$c) = @{$x->get_font_abc(ord('e'),ord('e'))};
74		my $w = $a + $b + $c;
75		skip "text wrap $f->{name}", 1 if $w <= 1; # some non-latin or symbol font
76		cmp_ok( scalar @{$x-> text_wrap( "eeee eeee eeee eeee eeee", $w * 5)}, '>', 4, "text wrap $f->{name}");
77	}
78
79	return $ok;
80}
81
82my $filter = @ARGV ? qr/$ARGV[0]/ : qr/./;
83my $bad_guys = qr/(
84	Color\sEmoji|     # fontconfig doesn't support this .ttc, reports crazy numbers and cannot display it
85	Pebble            # no glyphs in the font?
86)/x;
87
88$x = Prima::DeviceBitmap-> create( type => dbt::Bitmap, width => 8, height => 8);
89my @fonts;
90for my $f ( @{$::application->fonts} ) {
91	next if $f->{name} =~ /$bad_guys/;
92	next unless $f->{name} =~ /$filter/;
93	push @fonts, $f;
94}
95
96plan tests => scalar(@fonts) * 7;
97
98for my $f ( @fonts ) {
99	if (!t($f) && Prima::Application-> get_system_info-> {apc} == apc::Unix) {
100		Prima::options(debug => 'f');
101		t($f);
102		Prima::options(debug => '0');
103	}
104}
105$x-> destroy;
106
107done_testing;
108