lib/SDL/Tool/Font.pm

   1 #!/usr/bin/env perl
   2 #
   3 # Font.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::Tool::Font;
  32
  33 use strict;
  34 use warnings;
  35 use Carp;
  36
  37 use SDL;
  38 use SDL::Font;
  39 use SDL::TTFont;
  40
  41 sub new {
  42         my $proto = shift;
  43         my $class = ref($proto) || $proto;
  44         my $self = {};
  45         my %option = @_;
  46
  47         verify (%option, qw/ -sfont -ttfont -size -fg -bg -foreground -background
  48                                 -normal -bold -italic -underline / ) if $SDL::DEBUG;
  49
  50         if ($option{-sfont}) {
  51                 $$self{-font} = new SDL::Font $option{-sfont};
  52         } elsif ($option{-ttfont} || $option{-t}) {
  53                 $option{-size} ||= 12;
  54                 $$self{-font} = new SDL::TTFont
  55                                         -name => $option{-ttfont} || $option{-t},
  56                                         -size => $option{-size} || $option{-s},
  57                                         -fg => $option{-foreground} || $option{-fg} ,
  58                                         -bg => $option{-background} || $option{-bg};
  59                 for (qw/ normal bold italic underline / ) {
  60                         if ($option{"-$_"}) {
  61                                 &{"SDL::TTFont::$_"}($$self{-font});
  62                         }
  63                 }
  64         } else {
  65                 croak "SDL::Tool::Font requires either a -sfont or -ttfont";
  66         }
  67         bless $self,$class;
  68         $self;
  69 }
  70
  71 sub DESTROY {
  72
  73 }
  74
  75 sub print {
  76         my ($self,$surface,$x,$y,@text) = @_;
  77         croak "Tool::Font::print requires a SDL::Surface\n"
  78                 unless ($SDL::DEBUG && $surface->isa('SDL::Surface'));
  79         if ($$self{-font}->isa('SDL::Font')) {
  80                 $$self{-font}->use();
  81                 SDL::SFont::PutString( $$surface, $x, $y, join('',@text));
  82         } else {
  83                 $$self{-font}->print($surface,$x,$y,@text);
  84         }
  85 }
  86
  87 1;
  88
  89 __END__;
  90
  91 =pod
  92
  93 =head1 NAME
  94
  95 SDL::Tool::Font - a perl extension
  96
  97 =head1 DESCRIPTION
  98
  99 L<SDL::Tool::Font> provides a unified interface for applying
 100 True Type and SFont fonts to various surfaces.
 101
 102 =head1 METHODS
 103
 104 =head2 print ( surface, x, y, text ... )
 105
 106 C<SDL::Tool::Font::print> print the given text on the supplied surface
 107 with the upper left hand corner starting at the specified coordinates.
 108
 109 =head1 AUTHOR
 110
 111 David J. Goehrig
 112
 113 =head1 SEE ALSO
 114
 115 L<perl> L<SDL::Font> L<SDL::TTFont> L<SDL::Surface>
 116
 117 =cut