lib/SDL/TTFont.pm

   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
  31 package SDL::TTFont;
  32
  33 use strict;
  34 use warnings;
  35 use Carp;
  36 use SDL;
  37 use SDL::Surface;
  38
  39 use vars qw/ @ISA /;
  40
  41 @ISA = qw(SDL::Surface);
  42
  43 sub new {
  44         my $proto = shift;
  45         my $class = ref($proto) || $proto;
  46         my $self = {};
  47         my %options;
  48         (%options) = @_;
  49         $self->{-mode} = $options{-mode}        || $options{-m}  || SDL::TEXT_SHADED();
  50         $self->{-name} = $options{-name}        || $options{-n};
  51         $self->{-size} = $options{-size}        || $options{-s};
  52         $self->{-fg} = $options{-foreground}    || $options{-fg} || $SDL::Color::black;
  53         $self->{-bg} = $options{-background}    || $options{-bg} || $SDL::Color::white;
  54
  55         croak "SDL::TTFont::new requires a -name\n"
  56                 unless ($$self{-name});
  57
  58         croak "SDL::TTFont::new requires a -size\n"
  59                 unless ($$self{-size});
  60
  61         $self->{-font} = SDL::TTFOpenFont($self->{-name},$self->{-size});
  62
  63         croak "Could not open font $$self{-name}, ", SDL::GetError(), "\n"
  64                 unless ($self->{-font});
  65
  66         bless $self,$class;
  67         return $self;
  68 }
  69
  70 sub DESTROY {
  71         my $self = shift;
  72         SDL::FreeSurface($self->{-surface}) if (defined ($self->{-surface}));
  73         SDL::TTFCloseFont($self->{-font}) if (defined ($self->{-font}));
  74 }
  75
  76 sub print {
  77         my ($self,$surface,$x,$y,@text) = @_;
  78
  79         croak "Print requies an SDL::Surface"
  80                 unless( ref($surface) && $surface->isa("SDL::Surface") );
  81
  82         SDL::FreeSurface($self->{-surface}) if ($$self{-surface});
  83
  84         $$self{-surface} = SDL::TTFPutString($$self{-font},$$self{-mode},
  85                 $$surface,$x,$y,${$$self{-fg}},${$$self{-bg}},join("",@text));
  86
  87         croak "Could not print \"", join("",@text), "\" to surface, ",
  88                 SDL::GetError(), "\n" unless ($$self{-surface});
  89 }
  90
  91 sub width {
  92         my ($self,@text) = @_;
  93         my $aref = SDL::TTFSizeText($$self{-font},join(" ",@text));
  94         $$aref[0];
  95 }
  96
  97 sub height {
  98         my ($self) = @_;
  99         SDL::TTFFontHeight($$self{-font});
 100 }
 101
 102 sub ascent {
 103         my ($self) = @_;
 104         SDL::TTFFontAscent($$self{-font});
 105 }
 106
 107 sub descent {
 108         my ($self) = @_;
 109         SDL::TTFFontDescent($$self{-font});
 110 }
 111
 112 sub normal {
 113         my ($self) = @_;
 114         SDL::TTFSetFontStyle($$self{-font},SDL::TTF_STYLE_NORMAL());
 115 }
 116
 117 sub bold {
 118         my ($self) = @_;
 119         SDL::TTFSetFontStyle($$self{-font},SDL::TTF_STYLE_BOLD());
 120 }
 121
 122 sub italic {
 123         my ($self) = @_;
 124         SDL::TTFSetFontStyle($$self{-font},SDL::TTF_STYLE_ITALIC());
 125
 126 }
 127
 128 sub underline {
 129         my ($self) = @_;
 130         SDL::TTFSetFontStyle($$self{-font},SDL::TTF_STYLE_UNDERLINE());
 131 }
 132
 133 sub text_shaded {
 134         my ($self) = @_;
 135         $$self{-mode} = SDL::TEXT_SHADED();
 136 }
 137
 138 sub text_solid {
 139         my ($self) = @_;
 140         $$self{-mode} = SDL::TEXT_SOLID();
 141 }
 142
 143 sub text_blended {
 144         my ($self) = @_;
 145         $$self{-mode} = SDL::TEXT_BLENDED();
 146 }
 147
 148 sub utf8_shaded {
 149         my ($self) = @_;
 150         $$self{-mode} = SDL::UTF8_SHADED();
 151 }
 152
 153 sub utf8_solid {
 154         my ($self) = @_;
 155         $$self{-mode} = SDL::UTF8_SOLID();
 156 }
 157
 158 sub utf8_blended {
 159         my ($self) = @_;
 160         $$self{-mode} = SDL::UTF8_BLENDED();
 161 }
 162
 163 sub unicode_shaded {
 164         my ($self) = @_;
 165         $$self{-mode} = SDL::UNICODE_SHADED();
 166 }
 167
 168 sub unicode_solid {
 169         my ($self) = @_;
 170         $$self{-mode} = SDL::UNICODE_SOLID();
 171 }
 172
 173 sub unicode_blended {
 174         my ($self) = @_;
 175         $$self{-mode} = SDL::UNICODE_BLENDED();
 176 }
 177
 178 croak "Could not initialize True Type Fonts\n"
 179         if ( SDL::TTFInit() < 0);
 180
 181 1;
 182
 183 __END__;
 184
 185 =head1 NAME
 186
 187 SDL::TTFont - a SDL perl extension
 188
 189 =head1 SYNOPSIS
 190
 191   $font = SDL::TTFont->new( -name => "Utopia.ttf", -size => 18 );
 192
 193 =head1 DESCRIPTION
 194
 195 L<< SDL::TTFont >> is a module for applying true type fonts to L<< SDL::Surface >>.
 196
 197 =head1 METHODS
 198
 199 =head2 new
 200
 201 Instanciates a new font surface. It accepts the following parameters:
 202
 203 =head3 -name
 204
 205 =head3 -n
 206
 207 The font filename (possibly with proper path) to be used. B<< This options is mandatory >>.
 208
 209 =head3 -size
 210
 211 =head3 -s
 212
 213 The font size (height, in pixels) to be used. B<< This option is mandatory >>.
 214
 215 =head3 -foreground
 216
 217 =head3 -fg
 218
 219 Foreground color for the font surface (i.e. the actual font color). It expects a
 220 SDL::Color value. If omitted, black is used as font color.
 221
 222 =head3 -background
 223
 224 =head3 -bg
 225
 226 Background color for the font surface (i.e. the font background color). It expects
 227 a SDL::Color value. If omitted , white is used for the background.
 228
 229 =head3 -mode
 230
 231 =head3 -m
 232
 233 Font mode. If omitted, SDL::TEXT_SHADED is used. Note that this class provides
 234 human friendly accessors for setting different modes, so you should probably use
 235 them instead. See below for further details.
 236
 237 =head2 Text Modes
 238
 239 The SDL::TTFont accepts three different types (shaded, solid, blended) for
 240 three different encodings (text, utf8, unicode).
 241
 242   $font->text_shaded;       # sets mode to SDL::TEXT_SHADED
 243   $font->text_solid;        # sets mode to SDL::TEXT_SOLID
 244   $font->text_blended;      # sets mode to SDL::TEXT_BLENDED
 245
 246   $font->utf8_shaded;       # sets mode to SDL::UTF8_SHADED
 247   $font->utf8_solid;        # sets mode to SDL::UTF8_SOLID
 248   $font->utf8_blended;      # sets mode to SDL::UTF8_BLENDED
 249
 250   $font->unicode_shaded;    # sets mode to SDL::UNICODE_SHADED
 251   $font->unicode_solid;     # sets mode to SDL::UNICODE_SOLID
 252   $font->unicode_blended;   # sets mode to SDL::UNICODE_BLENDED
 253
 254 =head2 Text Style
 255
 256 You may also smoothly change your font style by calling any of the following
 257 methods:
 258
 259   $font->normal;       # resets font styling, making text "normal"
 260   $font->bold;         # sets bold style for font
 261   $font->italic;       # sets italic style for font
 262   $font->underline;    # sets underline style for font
 263
 264
 265 =head2 Ascent/Descent values
 266
 267 Ascent is the number of pixels from the font baseline to the top of the font, while
 268 descent is the number of pixels from the font baseline to the bottom of the font.
 269
 270   $font->ascent;      # height in pixels of the font ascent
 271   $font->descent;     # height in pixels of the font descent
 272
 273 =head2 height
 274
 275   my $height = $font->height;
 276
 277 Returns the height, in pixels, of the actual rendered text. This is the
 278 average size for each glyph in the font.
 279
 280 =head2 width(@text)
 281
 282   my $width = $font->width("Choose your destiny");
 283
 284 Returns the dimensions needed to render the text. This can be used to help
 285 determine the positioning needed for text before it is rendered. It can also
 286 be used for wordwrapping and other layout effects.
 287
 288 Be aware that most fonts - notably, non-monospaced ("ms") ones - use kerning
 289 which adjusts the widths for specific letter pairs. For example, the width
 290 for "ae" will not always match the width for "a" + "e".
 291
 292 =head2 print ($surface, $top, $left, @text)
 293
 294 Directly draws text to an existing surface. Receives the target L<< SDL::Surface >>
 295 object and the relative top (y) and left (x) coordinates to put the text in.
 296 The last parameter may be a string or an array or strings with the text to be
 297 written.
 298
 299
 300 =head1 AUTHOR
 301
 302 David J. Goehrig
 303
 304 =head1 SEE ALSO
 305
 306 L<perl>, L<SDL>, L<< SDL::Surface >>