/lib/SDL/TTFont.pm

http://github.com/PerlGameDev/SDL · Perl · 185 lines · 119 code · 37 blank · 29 comment · 14 complexity · 86832de36e72db679e4dfdbbd580e9d1 MD5 · raw file

  1. #!/usr/bin/env perl
  2. #
  3. # TTFont.pm
  4. #
  5. # Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
  6. #
  7. # ------------------------------------------------------------------------------
  8. #
  9. # This library is free software; you can redistribute it and/or
  10. # modify it under the terms of the GNU Lesser General Public
  11. # License as published by the Free Software Foundation; either
  12. # version 2.1 of the License, or (at your option) any later version.
  13. #
  14. # This library is distributed in the hope that it will be useful,
  15. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  17. # Lesser General Public License for more details.
  18. #
  19. # You should have received a copy of the GNU Lesser General Public
  20. # License along with this library; if not, write to the Free Software
  21. # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  22. #
  23. # ------------------------------------------------------------------------------
  24. #
  25. # Please feel free to send questions, suggestions or improvements to:
  26. #
  27. # David J. Goehrig
  28. # dgoehrig@cpan.org
  29. #
  30. package SDL::TTFont;
  31. use strict;
  32. use warnings;
  33. use Carp;
  34. use SDL;
  35. use SDL::Surface;
  36. use vars qw/ @ISA /;
  37. @ISA = qw(SDL::Surface);
  38. our $VERSION = 2.548;
  39. sub new {
  40. my $proto = shift;
  41. my $class = ref($proto) || $proto;
  42. my $self = {};
  43. my %options;
  44. (%options) = @_;
  45. $self->{-mode} = $options{-mode} || $options{-m} || SDL::TEXT_SHADED();
  46. $self->{-name} = $options{-name} || $options{-n};
  47. $self->{-size} = $options{-size} || $options{-s};
  48. $self->{-fg} = $options{-foreground} || $options{-fg} || $SDL::Color::black;
  49. $self->{-bg} = $options{-background} || $options{-bg} || $SDL::Color::white;
  50. Carp::confess "SDL::TTFont::new requires a -name\n"
  51. unless ( $$self{-name} );
  52. Carp::confess "SDL::TTFont::new requires a -size\n"
  53. unless ( $$self{-size} );
  54. $self->{-font} = SDL::TTFOpenFont( $self->{-name}, $self->{-size} );
  55. Carp::confess "Could not open font $$self{-name}, ", SDL::GetError(), "\n"
  56. unless ( $self->{-font} );
  57. bless $self, $class;
  58. return $self;
  59. }
  60. sub DESTROY {
  61. my $self = shift;
  62. SDL::FreeSurface( $self->{-surface} ) if ( defined( $self->{-surface} ) );
  63. SDL::TTFCloseFont( $self->{-font} ) if ( defined( $self->{-font} ) );
  64. }
  65. sub print {
  66. my ( $self, $surface, $x, $y, @text ) = @_;
  67. Carp::confess "Print requies an SDL::Surface"
  68. unless ( ref($surface) && $surface->isa("SDL::Surface") );
  69. SDL::FreeSurface( $self->{-surface} ) if ( $$self{-surface} );
  70. $$self{-surface} = SDL::TTFPutString(
  71. $$self{-font}, $$self{-mode}, $$surface, $x, $y,
  72. $self->{-fg}, $self->{-bg}, join( "", @text )
  73. );
  74. Carp::confess "Could not print \"", join( "", @text ), "\" to surface, ", SDL::GetError(), "\n"
  75. unless ( $$self{-surface} );
  76. }
  77. sub width {
  78. my ( $self, @text ) = @_;
  79. my $aref = SDL::TTFSizeText( $$self{-font}, join( " ", @text ) );
  80. $$aref[0];
  81. }
  82. sub height {
  83. my ($self) = @_;
  84. SDL::TTFFontHeight( $$self{-font} );
  85. }
  86. sub ascent {
  87. my ($self) = @_;
  88. SDL::TTFFontAscent( $$self{-font} );
  89. }
  90. sub descent {
  91. my ($self) = @_;
  92. SDL::TTFFontDescent( $$self{-font} );
  93. }
  94. sub normal {
  95. my ($self) = @_;
  96. SDL::TTFSetFontStyle( $$self{-font}, SDL::TTF_STYLE_NORMAL() );
  97. }
  98. sub bold {
  99. my ($self) = @_;
  100. SDL::TTFSetFontStyle( $$self{-font}, SDL::TTF_STYLE_BOLD() );
  101. }
  102. sub italic {
  103. my ($self) = @_;
  104. SDL::TTFSetFontStyle( $$self{-font}, SDL::TTF_STYLE_ITALIC() );
  105. }
  106. sub underline {
  107. my ($self) = @_;
  108. SDL::TTFSetFontStyle( $$self{-font}, SDL::TTF_STYLE_UNDERLINE() );
  109. }
  110. sub text_shaded {
  111. my ($self) = @_;
  112. $$self{-mode} = SDL::TEXT_SHADED();
  113. }
  114. sub text_solid {
  115. my ($self) = @_;
  116. $$self{-mode} = SDL::TEXT_SOLID();
  117. }
  118. sub text_blended {
  119. my ($self) = @_;
  120. $$self{-mode} = SDL::TEXT_BLENDED();
  121. }
  122. sub utf8_shaded {
  123. my ($self) = @_;
  124. $$self{-mode} = SDL::UTF8_SHADED();
  125. }
  126. sub utf8_solid {
  127. my ($self) = @_;
  128. $$self{-mode} = SDL::UTF8_SOLID();
  129. }
  130. sub utf8_blended {
  131. my ($self) = @_;
  132. $$self{-mode} = SDL::UTF8_BLENDED();
  133. }
  134. sub unicode_shaded {
  135. my ($self) = @_;
  136. $$self{-mode} = SDL::UNICODE_SHADED();
  137. }
  138. sub unicode_solid {
  139. my ($self) = @_;
  140. $$self{-mode} = SDL::UNICODE_SOLID();
  141. }
  142. sub unicode_blended {
  143. my ($self) = @_;
  144. $$self{-mode} = SDL::UNICODE_BLENDED();
  145. }
  146. Carp::confess "Could not initialize True Type Fonts\n"
  147. if ( SDL::TTFInit() < 0 );
  148. 1;