/t/ttf.t

http://github.com/PerlGameDev/SDL · Perl · 388 lines · 336 code · 50 blank · 2 comment · 8 complexity · 8ae14d9b5a9bfd947b5412e943b127ef MD5 · raw file

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