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
  62                                 SDL::TTFont->can($_)->($$self{-font});
  63                                 #&{$sub}($$self{-font});
  64                         }
  65                 }
  66         } else {
  67                 croak "SDL::Tool::Font requires either a -sfont or -ttfont";
  68         }
  69         bless $self,$class;
  70         $self;
  71 }
  72
  73 sub DESTROY {
  74
  75 }
  76
  77 sub print {
  78         my ($self,$surface,$x,$y,@text) = @_;
  79         croak "Tool::Font::print requires a SDL::Surface\n"
  80                 unless ($surface->isa('SDL::Surface'));
  81         if ($$self{-font}->isa('SDL::Font')) {
  82                 $$self{-font}->use();
  83                 SDL::SFont::PutString( $$surface, $x, $y, join('',@text));
  84         } else {
  85                 $$self{-font}->print($surface,$x,$y,@text);
  86         }
  87 }
  88
  89 1;
  90
  91 __END__;
  92
  93 =pod
  94
  95 =head1 NAME
  96
  97 SDL::Tool::Font - a perl extension
  98
  99 =head1 DESCRIPTION
 100
 101 L<SDL::Tool::Font> provides a unified interface for applying
 102 True Type and SFont fonts to various surfaces.
 103
 104 =head1 METHODS
 105
 106 =head2 print ( surface, x, y, text ... )
 107
 108 C<SDL::Tool::Font::print> print the given text on the supplied surface
 109 with the upper left hand corner starting at the specified coordinates.
 110
 111 =head1 AUTHOR
 112
 113 David J. Goehrig
 114
 115 =head1 SEE ALSO
 116
 117 L<perl> L<SDL::Font> L<SDL::TTFont> L<SDL::Surface>
 118
 119 =cut