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