/lib/SDLx/TTF.pm

http://github.com/PerlGameDev/SDL · Perl · 61 lines · 44 code · 17 blank · 0 comment · 4 complexity · 2e8415dfc0f59c959dad4a917ecff3f6 MD5 · raw file

  1. package SDLx::TTF;
  2. use strict;
  3. use warnings;
  4. use Carp;
  5. use SDL;
  6. use SDL::TTF;
  7. use SDL::TTF::Font;
  8. our $VERSION = 2.548;
  9. sub new
  10. {
  11. my ($class, $font) = @_;
  12. my $self = {};
  13. unless ( SDL::Config->has('SDL_ttf') ) {
  14. Carp::cluck("SDL_ttf support has not been compiled");
  15. }
  16. unless ( SDL::TTF::was_init() )
  17. {
  18. Carp::cluck ("Cannot init TTF: " . SDL::get_error() ) unless SDL::TTF::init() == 0;
  19. $self->{inited} = 1;
  20. $self->{style} = {
  21. normal => TTF_STYLE_NORMAL,
  22. bold => TTF_STYLE_BOLD,
  23. italic => TTF_STYLE_ITALIC,
  24. underline => TTF_STYLE_UNDERLINE,
  25. strikethrough => TTF_STYLE_STRIKETHROUGH
  26. };
  27. }
  28. my $ttf_font;
  29. unless ( $ttf_font = SDL::TTF::open_font($font, $size ))
  30. {
  31. Carp::cluck ("Cannot make a TTF font from location ($font) or size($size), due to: ". SDL::get_error );
  32. }
  33. $self->{ttf_font} = $ttf_font;
  34. if ( $style && ( my $t_style = $self->{style}->{$style} ) )
  35. {
  36. SDL::TTF::set_font_style($ttf_font, $t_style);
  37. }
  38. return bless $self, $class;
  39. }
  40. sub DESTROY {
  41. my $self = shift;
  42. SDL::TTF::quit if $self->{inited};
  43. }
  44. 1;