/t_backcompat/testfonttool.pl

http://github.com/PerlGameDev/SDL · Perl · 104 lines · 83 code · 20 blank · 1 comment · 20 complexity · 3b8775ebc2580711c3b00d232d9d518f MD5 · raw file

  1. #!/usr/bin/env perl
  2. use strict;
  3. use SDL;
  4. use SDLx::App;
  5. use SDL::Event;
  6. use SDL::Tool::Font;
  7. use SDL::Color;
  8. my ( %options, $app, $mode );
  9. die "usage: $0 [-hw] [-fullscreen] [-width 640] [-height 480] [-bpp 24]\n"
  10. if ( SDL::in( $ARGV[0], qw/ -h -? --help/ ) );
  11. chdir 'test' if -d 'test';
  12. die "$0 must be run in the SDL_perl/test/ directory!"
  13. unless ( -d 'data' );
  14. for ( 0 .. @ARGV - 1 ) {
  15. $options{ $ARGV[$_] } = $ARGV[ $_ + 1 ] || 1;
  16. }
  17. $options{-flags} = SDL_SWSURFACE;
  18. $options{-flags} |= SDL_HWPALETTE if ( $options{-hw} );
  19. $options{-flags} |= SDL_FULLSCREEN if ( $options{-fullscreen} );
  20. $options{-title} = $0;
  21. $options{-width} ||= 800;
  22. $options{-height} ||= 600;
  23. $options{-depth} ||= $options{-bpp} || 24;
  24. $app = SDLx::App->new(%options);
  25. my %ttfonts = (
  26. 'aircut3.ttf' => 0,
  27. 'electrohar.ttf' => 0,
  28. );
  29. my %sfonts = (
  30. '24P_Arial_NeonYellow.png' => 0,
  31. '24P_Copperplate_Blue.png' => 0,
  32. );
  33. my @fonts;
  34. for ( reverse keys %ttfonts ) {
  35. for $mode (qw/ -normal -bold -italic -underline /) {
  36. if ( -e "data/$_" ) {
  37. print STDERR "Loading $_\n";
  38. $ttfonts{"$_$mode"} = SDL::Tool::Font->new(
  39. $mode => 1,
  40. -ttfont => "data/$_",
  41. -size => 20,
  42. -fg => $SDL::Color::black,
  43. -bg => $SDL::Color::black
  44. );
  45. push @fonts, $ttfonts{"$_$mode"};
  46. }
  47. }
  48. }
  49. %ttfonts = reverse %ttfonts;
  50. for ( reverse keys %sfonts ) {
  51. if ( -e "data/$_" ) {
  52. print STDERR "Loading $_\n";
  53. $sfonts{$_} = SDL::Tool::Font->new( -sfont => "data/$_" );
  54. push @fonts, $sfonts{$_};
  55. }
  56. }
  57. %sfonts = reverse %sfonts;
  58. sub DrawFonts {
  59. $app->fill( 0, $SDL::Color::white );
  60. my ( $x, $y ) = @_;
  61. for my $font (@fonts) {
  62. $font->print(
  63. $app, $x, $y,
  64. "SDLperl font test. ",
  65. "This is " . ( $ttfonts{$font} || $sfonts{$font} )
  66. );
  67. $y += 40;
  68. }
  69. $app->flip();
  70. }
  71. DrawFonts( 10, 10 );
  72. $app->loop(
  73. { SDL_KEYDOWN() => sub {
  74. my ($event) = @_;
  75. $app->warp( $options{-width} / 2, $options{-height} / 2 )
  76. if ( $event->key_sym() == SDLK_SPACE );
  77. $app->fullscreen() if ( $event->key_sym() == SDLK_f );
  78. exit(0) if ( $event->key_sym() == SDLK_ESCAPE );
  79. },
  80. SDL_QUIT() => sub {
  81. exit(0);
  82. }
  83. }
  84. );