/t/ttf.t

  1#!/usr/bin/perl -w
  2use strict;
  3use warnings;
  4use SDL;
  5use SDL::Config;
  6use SDL::Color;
  7use SDL::Surface;
  8use SDL::Overlay;
  9use SDL::Rect;
 10use SDL::Video;
 11use SDL::PixelFormat;
 12
 13BEGIN {
 14	use FindBin;
 15	use Test::More;
 16	use lib 't/lib';
 17	use SDL::TestTool;
 18
 19	if ( !SDL::Config->has('SDL_ttf') ) {
 20		plan( skip_all => 'SDL_ttf support not compiled' );
 21	}
 22}
 23
 24use SDL::TTF ':all';
 25use SDL::TTF::Font;
 26use SDL::RWOps;
 27use SDL::Version;
 28use Encode;
 29
 30use File::Spec;
 31my $font_filename = File::Spec->catfile(
 32        $FindBin::Bin, '..', 'share', 'GenBasR.ttf'
 33);
 34
 35my $videodriver = $ENV{SDL_VIDEODRIVER};
 36$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
 37
 38my $lv = SDL::TTF::linked_version();
 39my $cv = SDL::TTF::compile_time_version();
 40
 41isa_ok( $lv, 'SDL::Version', '[linked_version] returns a SDL::Version object' );
 42isa_ok(
 43	$cv, 'SDL::Version',
 44	'[compile_time_version] returns a SDL::Version object'
 45);
 46printf(
 47	"got version: %d.%d.%d/%d.%d.%d\n",
 48	$lv->major, $lv->minor, $lv->patch, $cv->major, $cv->minor, $cv->patch
 49);
 50
 51is( TTF_HINTING_NORMAL,   0, 'TTF_HINTING_NORMAL should be imported' );
 52is( TTF_HINTING_NORMAL(), 0, 'TTF_HINTING_NORMAL() should also be available' );
 53is( TTF_HINTING_LIGHT,    1, 'TTF_HINTING_LIGHT should be imported' );
 54is( TTF_HINTING_LIGHT(),  1, 'TTF_HINTING_LIGHT() should also be available' );
 55is( TTF_HINTING_MONO,     2, 'TTF_HINTING_MONO should be imported' );
 56is( TTF_HINTING_MONO(),   2, 'TTF_HINTING_MONO() should also be available' );
 57is( TTF_HINTING_NONE,     3, 'TTF_HINTING_NONE should be imported' );
 58is( TTF_HINTING_NONE(),   3, 'TTF_HINTING_NONE() should also be available' );
 59is( TTF_STYLE_NORMAL,     0, 'TTF_STYLE_NORMAL should be imported' );
 60is( TTF_STYLE_NORMAL(),   0, 'TTF_STYLE_NORMAL() should also be available' );
 61is( TTF_STYLE_BOLD,       1, 'TTF_STYLE_BOLD should be imported' );
 62is( TTF_STYLE_BOLD(),     1, 'TTF_STYLE_BOLD() should also be available' );
 63is( TTF_STYLE_ITALIC,     2, 'TTF_STYLE_ITALIC should be imported' );
 64is( TTF_STYLE_ITALIC(),   2, 'TTF_STYLE_ITALIC() should also be available' );
 65is( TTF_STYLE_UNDERLINE,  4, 'TTF_STYLE_UNDERLINE should be imported' );
 66is( TTF_STYLE_UNDERLINE(), 4,
 67	'TTF_STYLE_UNDERLINE() should also be available'
 68);
 69is( TTF_STYLE_STRIKETHROUGH, 8, 'TTF_STYLE_STRIKETHROUGH should be imported' );
 70is( TTF_STYLE_STRIKETHROUGH(), 8,
 71	'TTF_STYLE_STRIKETHROUGH() should also be available'
 72);
 73
 74is( SDL::TTF::was_init(),              0,     "[was_init] returns false" );
 75is( SDL::TTF::init(),                  0,     "[init] succeeded" );
 76is( SDL::TTF::was_init(),              1,     "[was_init] returns true" );
 77is( SDL::TTF::quit(),                  undef, "[quit] ran" );
 78is( SDL::TTF::was_init(),              0,     "[was_init] returns false" );
 79is( SDL::TTF::init(),                  0,     "[init] succeeded" );
 80is( SDL::TTF::byte_swapped_unicode(0), undef, "[ttf_byte_swapped_unicode] on" );
 81is( SDL::TTF::byte_swapped_unicode(1), undef,
 82	"[ttf_byte_swapped_unicode] off"
 83);
 84my $font = SDL::TTF::open_font( $font_filename, 22 );
 85isa_ok( $font, 'SDL::TTF::Font', "[open_font]" );
 86isa_ok(
 87	SDL::TTF::open_font_index( $font_filename, 8, 0 ),
 88	'SDL::TTF::Font', "[open_font_index]"
 89);
 90my $file = SDL::RWOps->new_file( $font_filename, 'r' );
 91isa_ok( $file, 'SDL::RWOps', "[new_file]" );
 92isa_ok(
 93	SDL::TTF::open_font_RW( $file, 0, 12 ),
 94	'SDL::TTF::Font', "[open_font_RW]"
 95);
 96$file = SDL::RWOps->new_file( $font_filename, 'r' );
 97isa_ok(
 98	SDL::TTF::open_font_index_RW( $file, 0, 16, 0 ),
 99	'SDL::TTF::Font', "[open_font_index_RW]"
100);
101
102# get_font_style returns the style as a bitmask
103
104my $style = SDL::TTF::get_font_style($font);
105
106is( $style, TTF_STYLE_NORMAL,  "[get_font_style] returns TTF_STYLE_NORMAL"
107);
108is( SDL::TTF::set_font_style( $font, TTF_STYLE_BOLD ),
109	undef, "[set_font_style] to TTF_STYLE_BOLD"
110);
111
112$style = SDL::TTF::get_font_style($font);
113
114ok( $style & TTF_STYLE_BOLD , "[get_font_style] returns TTF_STYLE_BOLD"
115);
116is( SDL::TTF::set_font_style( $font, TTF_STYLE_ITALIC ),
117	undef, "[set_font_style] to TTF_STYLE_ITALIC"
118);
119
120$style =  SDL::TTF::get_font_style($font);
121ok( $style & TTF_STYLE_ITALIC, "[get_font_style] returns TTF_STYLE_ITALIC"
122);
123
124is( SDL::TTF::set_font_style( $font, TTF_STYLE_UNDERLINE ),
125	undef, "[set_font_style] to TTF_STYLE_UNDERLINE"
126);
127
128$style =  SDL::TTF::get_font_style($font);
129
130ok( TTF_STYLE_UNDERLINE, "[get_font_style] returns TTF_STYLE_UNDERLINE"
131);
132is( SDL::TTF::set_font_style( $font, TTF_STYLE_NORMAL ),
133	undef, "[set_font_style] to TTF_STYLE_NORMAL"
134);
135is( SDL::TTF::get_font_style($font),
136	TTF_STYLE_NORMAL, "[get_font_style] returns TTF_STYLE_NORMAL"
137);
138
139SKIP:
140{
141	skip( "Version 2.0.10 (or better) needed", 10 ) if $cv < 2.0.10 || $lv < 2.0.10;
142	my $font_outline = SDL::TTF::get_font_outline($font);
143	ok( $font_outline >= 0, "[get_font_outline] is $font_outline" );
144	$font_outline++;
145	SDL::TTF::set_font_outline( $font, $font_outline );
146	pass "[set_font_outline] to $font_outline";
147	is( SDL::TTF::get_font_outline($font),
148		$font_outline, "[get_font_outline] is $font_outline"
149	);
150	SKIP:
151	{
152		skip( "Font hinting is buggy in SDL_ttf", 3 );
153		is( SDL::TTF::get_font_hinting($font),
154			TTF_HINTING_NORMAL, "[get_font_hinting] is TTF_HINTING_NORMAL"
155		);
156		SDL::TTF::set_font_hinting( $font, TTF_HINTING_LIGHT );
157		pass "[set_font_hinting] to TTF_HINTING_LIGHT";
158		is( SDL::TTF::get_font_hinting($font),
159			TTF_HINTING_LIGHT, "[get_font_hinting] is TTF_HINTING_LIGHT"
160		);
161	}
162	my $kerning_allowed = SDL::TTF::get_font_kerning($font);
163	like(
164		$kerning_allowed, '/^[01]$/',
165		"[get_font_kerning] is " . ( $kerning_allowed ? 'allowed' : 'not allowed' )
166	);
167	SDL::TTF::set_font_kerning( $font, 0 );
168	pass "[set_font_kerning to not allowed] ";
169	$kerning_allowed = SDL::TTF::get_font_kerning($font);
170	is( $kerning_allowed, 0,
171		"[get_font_kerning] is " . ( $kerning_allowed ? 'allowed' : 'not allowed' )
172	);
173	ok( SDL::TTF::glyph_is_provided( $font, "\0M" ) > 0,
174		"[glyph_is_provided] is true for character 'M'"
175	);
176}
177
178my $font_height = SDL::TTF::font_height($font);
179ok( $font_height, "[font_height] is $font_height" );
180
181my $font_ascent = SDL::TTF::font_ascent($font);
182like(
183	$font_ascent, '/^[-]?\d+$/',
184	"[font_ascent] offset from the baseline to the top of the font is $font_ascent"
185);
186
187my $font_descent = SDL::TTF::font_descent($font);
188like(
189	$font_descent, '/^[-]?\d+$/',
190	"[font_descent] offset from the baseline to the bottom of the font is $font_descent"
191);
192
193my $font_line_skip = SDL::TTF::font_line_skip($font);
194like(
195	$font_line_skip, '/^[-]?\d+$/',
196	"[font_line_skip] recommended spacing between lines of text is $font_line_skip"
197);
198
199my $font_faces = SDL::TTF::font_faces($font);
200ok( $font_faces, "[font_faces] font has $font_faces faces" );
201
202my $font_face_is_fixed_width = SDL::TTF::font_face_is_fixed_width($font);
203like(
204	$font_face_is_fixed_width, '/^[01]$/',
205	"[font_face_is_fixed_width] is $font_face_is_fixed_width"
206);
207
208my $font_face_family_name = SDL::TTF::font_face_family_name($font);
209ok( $font_face_family_name,
210	"[font_face_family_name] is $font_face_family_name"
211);
212
213my $font_face_style_name = SDL::TTF::font_face_style_name($font);
214ok( $font_face_style_name, "[font_face_style_name] is $font_face_style_name" );
215
216my @glyph_metrics = @{ SDL::TTF::glyph_metrics( $font, "\0M" ) };
217is( scalar @glyph_metrics,
218	5,
219	"[glyph_metrics] (minx, maxx, miny, maxy, advance) = (" . join( ', ', @glyph_metrics ) . ")"
220);
221
222my ( $width, $height ) = @{ SDL::TTF::size_text( $font, 'Hallo World!' ) };
223ok( $width > 0 && $height > 0, "[size_text] width=$width height=$height" );
224
225( $width, $height ) = @{ SDL::TTF::size_utf8( $font, "Hallo World!" ) };
226ok( $width > 0 && $height > 0, "[size_utf8] width=$width height=$height" );
227SKIP:
228{
229	skip( 'Unicode::String is needed for this', 2 )
230		unless eval 'use Unicode::String qw(latin1 utf8); 1';
231	my $unicode = latin1("Hallo World!");
232	( $width, $height ) = @{ SDL::TTF::size_unicode( $font, $unicode->utf16be ) };
233	ok( $width > 0 && $height > 0,
234		"[size_unicode] width=$width height=$height"
235	);
236}
237
238SKIP:
239{
240	skip( 'We need video support for this', 15 )
241		unless SDL::TestTool->init(SDL_INIT_VIDEO);
242
243	my $display = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE );
244
245	my $y          = 0;
246	my $text_fg    = SDL::Color->new( 0xFF, 0xFF, 0xFF );
247	my $utf8_fg    = SDL::Color->new( 0x80, 0x80, 0xFF );
248	my $glyph_fg   = SDL::Color->new( 0x80, 0xFF, 0x80 );
249	my $unicode_fg = SDL::Color->new( 0xFF, 0x80, 0x80 );
250	my $bg         = SDL::Color->new( 0x80, 0x80, 0x80 );
251	my $black      = SDL::Video::map_RGB( $display->format, 0x00, 0x00, 0x00 );
252	SDL::Video::fill_rect( $display, SDL::Rect->new( 0, 0, 640, 480 ), $black );
253
254	my $font = SDL::TTF::open_font( $font_filename, 24 );
255	my $render_text_solid = SDL::TTF::render_text_solid( $font, 'render_text_solid', $text_fg );
256	isa_ok( $render_text_solid, 'SDL::Surface', "[render_text_solid] ".SDL::get_error() );
257	SDL::Video::blit_surface(
258		$render_text_solid, SDL::Rect->new( 0, 0, 640, 480 ),
259		$display, SDL::Rect->new( 5, $y += 27, 640, 480 )
260	);
261
262	my $render_text_shaded = SDL::TTF::render_text_shaded(
263		$font, 'render_text_shaded', $text_fg,
264		$bg
265	);
266	isa_ok( $render_text_shaded, 'SDL::Surface', "[render_text_shaded]" );
267	SDL::Video::blit_surface(
268		$render_text_shaded, SDL::Rect->new( 0, 0, 640, 480 ),
269		$display, SDL::Rect->new( 5, $y += 27, 640, 480 )
270	);
271
272	my $render_text_blended = SDL::TTF::render_text_blended( $font, 'render_text_blended', $text_fg );
273	isa_ok( $render_text_blended, 'SDL::Surface', "[render_text_blended]" );
274	SDL::Video::blit_surface(
275		$render_text_blended, SDL::Rect->new( 0, 0, 640, 480 ),
276		$display, SDL::Rect->new( 5, $y += 27, 640, 480 )
277	);
278
279	my $render_utf8_solid = SDL::TTF::render_utf8_solid( $font, "render_utf8_solid", $utf8_fg );
280	isa_ok( $render_utf8_solid, 'SDL::Surface', "[render_utf8_solid]" );
281	SDL::Video::blit_surface(
282		$render_utf8_solid, SDL::Rect->new( 0, 0, 640, 480 ),
283		$display, SDL::Rect->new( 5, $y += 27, 640, 480 )
284	);
285
286	my $render_utf8_shaded = SDL::TTF::render_utf8_shaded(
287		$font, "render_utf8_shaded", $utf8_fg,
288		$bg
289	);
290	isa_ok( $render_utf8_shaded, 'SDL::Surface', "[render_utf8_shaded]" );
291	SDL::Video::blit_surface(
292		$render_utf8_shaded, SDL::Rect->new( 0, 0, 640, 480 ),
293		$display, SDL::Rect->new( 5, $y += 27, 640, 480 )
294	);
295
296	my $render_utf8_blended = SDL::TTF::render_utf8_blended( $font, "render_utf8_blended", $utf8_fg );
297	isa_ok( $render_utf8_blended, 'SDL::Surface', "[render_utf8_blended]" );
298	SDL::Video::blit_surface(
299		$render_utf8_blended, SDL::Rect->new( 0, 0, 640, 480 ),
300		$display, SDL::Rect->new( 5, $y += 27, 640, 480 )
301	);
302
303	my $render_glyph_solid = SDL::TTF::render_glyph_solid( $font, 'r', $glyph_fg );
304	isa_ok( $render_glyph_solid, 'SDL::Surface', "[render_glyph_solid]" );
305	SDL::Video::blit_surface(
306		$render_glyph_solid, SDL::Rect->new( 0, 0, 640, 480 ),
307		$display, SDL::Rect->new( 5, $y += 27, 640, 480 )
308	);
309
310	my $render_glyph_shaded = SDL::TTF::render_glyph_shaded( $font, 'r', $glyph_fg, $bg );
311	isa_ok( $render_glyph_shaded, 'SDL::Surface', "[render_glyph_shaded]" );
312	SDL::Video::blit_surface(
313		$render_glyph_shaded, SDL::Rect->new( 0, 0, 640, 480 ),
314		$display, SDL::Rect->new( 5, $y += 27, 640, 480 )
315	);
316
317	my $render_glyph_blended = SDL::TTF::render_glyph_blended( $font, 'r', $glyph_fg );
318	isa_ok( $render_glyph_blended, 'SDL::Surface', "[render_glyph_blended]" );
319	SDL::Video::blit_surface(
320		$render_glyph_blended, SDL::Rect->new( 0, 0, 640, 480 ),
321		$display, SDL::Rect->new( 5, $y += 27, 640, 480 )
322	);
323
324	SKIP:
325	{
326		skip( 'Unicode::String is needed for this', 3 )
327			unless eval 'use Unicode::String qw(latin1); 1';
328		my $unicode              = latin1("render_unicode_solid");
329		my $render_unicode_solid = SDL::TTF::render_unicode_solid(
330			$font, $unicode->utf16be,
331			$unicode_fg
332		);
333		isa_ok(
334			$render_unicode_solid, 'SDL::Surface',
335			"[render_unicode_solid]"
336		);
337		SDL::Video::blit_surface(
338			$render_unicode_solid, SDL::Rect->new( 0, 0, 640, 480 ),
339			$display, SDL::Rect->new( 5, $y += 27, 640, 480 )
340		);
341
342		$unicode = latin1("render_unicode_shaded");
343		my $render_unicode_shaded = SDL::TTF::render_unicode_shaded(
344			$font,
345			"\xFF\xFE" . $unicode->utf16le,
346			$unicode_fg, $bg
347		);
348		isa_ok(
349			$render_unicode_shaded, 'SDL::Surface',
350			"[render_unicode_shaded]"
351		);
352		SDL::Video::blit_surface(
353			$render_unicode_shaded,
354			SDL::Rect->new( 0, 0, 640, 480 ),
355			$display, SDL::Rect->new( 5, $y += 27, 640, 480 )
356		);
357
358		$unicode = latin1("render_unicode_blended");
359		my $render_unicode_blended = SDL::TTF::render_unicode_blended(
360			$font, $unicode->utf16be,
361			$unicode_fg
362		);
363		isa_ok(
364			$render_unicode_blended, 'SDL::Surface',
365			"[render_unicode_blended]"
366		);
367		SDL::Video::blit_surface(
368			$render_unicode_blended,
369			SDL::Rect->new( 0, 0, 640, 480 ),
370			$display, SDL::Rect->new( 5, $y += 27, 640, 480 )
371		);
372	}
373
374	SDL::Video::update_rect( $display, 0, 0, 0, 0 );
375
376	SDL::delay(2000);
377}
378
379END {
380
381	if ($videodriver) {
382		$ENV{SDL_VIDEODRIVER} = $videodriver;
383	} else {
384		delete $ENV{SDL_VIDEODRIVER};
385	}
386
387	done_testing;
388}