415323e0380aac861acf910c8199366d5e118748
[imager.git] / t / t38ft2font.t
1 #!perl -w
2 # Before `make install' is performed this script should be runnable with
3 # `make test'. After `make install' it should work as `perl test.pl'
4
5 ######################### We start with some black magic to print on failure.
6
7 # Change 1..1 below to 1..last_test_to_print .
8 # (It may become useful if the test is moved to ./t subdirectory.)
9
10 BEGIN { $| = 1; print "1..10\n"; }
11 END {print "not ok 1\n" unless $loaded;}
12 use Imager qw(:all);
13 $loaded = 1;
14 print "ok 1\n";
15
16 init_log("testout/t38ft2font.log",1);
17
18 sub skip { 
19   for (2..10) {
20     print "ok $_ # skip no Freetype2 library\n";
21   }
22   malloc_state();
23   exit(0);
24 }
25
26 if (!(i_has_format("ft2")) ) { skip(); } 
27 print "# has ft2\n";
28
29 $fontname=$ENV{'TTFONTTEST'}||'./fontfiles/dodge.ttf';
30
31 if (! -f $fontname) {
32   print "# cannot find fontfile for truetype test $fontname\n";
33   skip();       
34 }
35
36 i_init_fonts();
37 #     i_tt_set_aa(1);
38
39 $bgcolor=i_color_new(255,0,0,0);
40 $overlay=Imager::ImgRaw::new(200,70,3);
41
42 $ttraw=Imager::Font::FreeType2::i_ft2_new($fontname, 0);
43
44 $ttraw or print Imager::_error_as_msg(),"\n";
45 #use Data::Dumper;
46 #warn Dumper($ttraw);
47
48 @bbox=Imager::Font::FreeType2::i_ft2_bbox($ttraw, 50.0, 0, 'XMCLH');
49 print "#bbox: ($bbox[0], $bbox[1]) - ($bbox[2], $bbox[3])\n";
50
51 Imager::Font::FreeType2::i_ft2_cp($ttraw,$overlay,5,50,1,50.0,50, 'XMCLH',1,1, 0, 0);
52 i_draw($overlay,0,50,100,50,$bgcolor);
53
54 open(FH,">testout/t38ft2font.ppm") || die "cannot open testout/t38ft2font.ppm\n";
55 binmode(FH);
56 my $IO = Imager::io_new_fd(fileno(FH));
57 i_writeppm_wiol($overlay, $IO);
58 close(FH);
59
60 print "ok 2\n";
61
62 dotest:
63
64 $bgcolor=i_color_set($bgcolor,200,200,200,0);
65 $backgr=Imager::ImgRaw::new(500,300,3);
66
67 #     i_tt_set_aa(2);
68 Imager::Font::FreeType2::i_ft2_text($ttraw,$backgr,100,150,NC(255, 64, 64),200.0,50, 'MAW',1,1,0, 0);
69 Imager::Font::FreeType2::i_ft2_settransform($ttraw, [0.9659, 0.2588, 0, -0.2588, 0.9659, 0 ]);
70 Imager::Font::FreeType2::i_ft2_text($ttraw,$backgr,100,150,NC(0, 128, 0),200.0,50, 'MAW',0,1, 0, 0);
71 i_draw($backgr, 0,150, 499, 150, NC(0, 0, 255));
72
73 open(FH,">testout/t38ft2font2.ppm") || die "cannot open testout/t38ft2font.ppm\n";
74 binmode(FH);
75 $IO = Imager::io_new_fd(fileno(FH));
76 i_writeppm_wiol($backgr,$IO);
77 close(FH);
78
79 print "ok 3\n";
80
81 #$fontname = 'fontfiles/arial.ttf';
82 my $oof = Imager::Font->new(file=>$fontname, type=>'ft2', 'index'=>0)
83   or print "not ";
84 print "ok 4\n";
85
86 my $im = Imager->new(xsize=>400, ysize=>250);
87
88 $im->string(font=>$oof,
89             text=>"Via OO",
90             'x'=>20,
91             'y'=>20,
92             size=>60,
93             color=>NC(255, 128, 255),
94             aa => 1,
95             align=>0) or print "not ";
96 print "ok 5\n";
97 $oof->transform(matrix=>[1, 0.1, 0, 0, 1, 0])
98   or print "not ";
99 print "ok 6\n";
100 $im->string(font=>$oof,
101             text=>"Shear",
102             'x'=>20,
103             'y'=>40,
104             size=>60,
105             sizew=>50,
106             channel=>1,
107             aa=>1,
108             align=>1) or print "not ";
109 print "ok 7\n";
110 use Imager::Matrix2d ':handy';
111 $oof->transform(matrix=>m2d_rotate(degrees=>-30));
112 #$oof->transform(matrix=>m2d_identity());
113 $im->string(font=>$oof,
114             text=>"SPIN",
115             'x'=>20,
116             'y'=>50,
117             size=>50,
118             sizew=>40,
119             color=>NC(255,255,0),
120             aa => 1,
121             align=>0, vlayout=>0)
122 and
123 $im->string(font=>$oof,
124             text=>"SPIN",
125             'x'=>20,
126             'y'=>50,
127             size=>50,
128             sizew=>40,
129             channel=>2,
130             aa => 1,
131             align=>0, vlayout=>0) or print "not ";
132 print "ok 8\n";
133
134 $oof->transform(matrix=>m2d_identity());
135 $oof->hinting(hinting=>1);
136
137 # UTF8 testing
138 # the test font (dodge.ttf) only supports one character above 0xFF that
139 # I can see, 0x2010 HYPHEN (which renders the same as 0x002D HYPHEN MINUS)
140 # an attempt at utf8 support
141 # first attempt to use native perl UTF8
142 if ($] >= 5.006) {
143   my $text;
144   # we need to do this in eval to prevent compile time errors in older
145   # versions
146   eval q{$text = "A\x{2010}A"}; # A, HYPHEN, A in our test font
147   #$text = "A".chr(0x2010)."A"; # this one works too
148   if ($im->string(font=>$oof,
149               text=>$text,
150               'x'=>20,
151               'y'=>200,
152               size=>50,
153               color=>NC(0,255,0),
154               aa=>1)) {
155     print "ok 9\n";
156   }
157   else {
158     print "not ok 9 # ",$im->errstr,"\n";
159   }
160 }
161 else {
162   print "ok 9 # skip no native UTF8 support in this version of perl\n";
163 }
164
165 # an attempt using emulation of UTF8
166 my $text = pack("C*", 0x41, 0xE2, 0x80, 0x90, 0x41);
167 #my $text = "A\xE2\x80\x90\x41\x{2010}";
168 #substr($text, -1, 0) = '';
169 if ($im->string(font=>$oof,
170                 text=>$text,
171                 'x'=>20,
172                 'y'=>230,
173                 size=>50,
174                 color=>NC(255,128,0),
175                 aa=>1, 
176                 utf8=>1)) {
177   print "ok 10\n";
178 }
179 else {
180   print "not ok 10 # ",$im->errstr,"\n";
181 }
182
183 # just a bit of fun
184 # well it was - it demostrates what happens when you combine
185 # transformations and font hinting
186 for my $steps (0..39) {
187   $oof->transform(matrix=>m2d_rotate(degrees=>-$steps+5));
188   # demonstrates why we disable hinting on a doing a transform
189   # if the following line is enabled then the 0 degrees output sticks 
190   # out a bit
191   # $oof->hinting(hinting=>1);
192   $im->string(font=>$oof,
193               text=>"SPIN",
194               'x'=>160,
195               'y'=>70,
196               size=>65,
197               color=>NC(255, $steps * 5, 200-$steps * 5),
198               aa => 1,
199               align=>0, ) or print "not ";
200 }
201
202 $im->write(file=>'testout/t38_oo.ppm')
203   or print "# could not save OO output: ",$im->errstr,"\n";