lib/SDL/TTFont.pm

   1 #       TTFont.pm
   2 #
   3 #       a SDL perl extension for SDL_ttf support
   4 #
   5 #       Copyright (C) David J. Goehrig 2002
   6 #
   7
   8 package SDL::TTFont;
   9
  10 use strict;
  11 use SDL;
  12 use SDL::Surface;
  13
  14 use vars qw/ @ISA /;
  15
  16 @ISA = qw(SDL::Surface);
  17
  18 sub new {
  19         my $proto = shift;
  20         my $class = ref($proto) || $proto;
  21         my $self = {};
  22         my %options;
  23         (%options) = @_;
  24         $self->{-mode} = $options{-mode}        || $options{-m}  || TEXT_SHADED();
  25         $self->{-name} = $options{-name}        || $options{-n};
  26         $self->{-size} = $options{-size}        || $options{-s};
  27         $self->{-fg} = $options{-foreground}    || $options{-fg} || $SDL::Color::black;
  28         $self->{-bg} = $options{-background}    || $options{-bg} || $SDL::Color::white;
  29
  30         die "SDL::TTFont::new requires a -name\n"
  31                 unless ($$self{-name});
  32
  33         die "SDL::TTFont::new requires a -size\n"
  34                 unless ($$self{-size});
  35
  36         $self->{-font} = SDL::TTFOpenFont($self->{-name},$self->{-size});
  37
  38         die "Could not open font $$self{-name}, ", SDL::GetError(), "\n"
  39                 unless ($self->{-font});
  40
  41         bless $self,$class;
  42         return $self;
  43 }
  44
  45 sub DESTROY {
  46         my $self = shift;
  47         SDL::FreeSurface($self->{-surface});
  48         SDL::TTFCloseFont($self->{-font});
  49 }
  50
  51 sub print {
  52         my ($self,$surface,$x,$y,@text) = @_;
  53
  54         die "Print requies an SDL::Surface"
  55                 unless( ref($surface) && $surface->isa("SDL::Surface") );
  56
  57         SDL::FreeSurface($self->{-surface}) if ($$self{-surface});
  58
  59         $$self{-surface} = SDL::TTFPutString($$self{-font},$$self{-mode},
  60                 $$surface,$x,$y,${$$self{-fg}},${$$self{-bg}},join("",@text));
  61
  62         die "Could not print \"", join("",@text), "\" to surface, ",
  63                 SDL::GetError(), "\n" unless ($$self{-surface});
  64 }
  65
  66 sub width {
  67         my ($self,@text) = @_;
  68         my $aref = SDL::TTFSizeText($$self{-font},join(" ",@text));
  69         $$aref[0];
  70 }
  71
  72 sub height {
  73         my ($self) = @_;
  74         SDL::TTFFontHeight($$self{-font});
  75 }
  76
  77 sub ascent {
  78         my ($self) = @_;
  79         SDL::TTFFontAscent($$self{-font});
  80 }
  81
  82 sub descent {
  83         my ($self) = @_;
  84         SDL::TTFFontDescent($$self{-font});
  85 }
  86
  87 sub normal {
  88         my ($self) = @_;
  89         SDL::TTFSetFontStyle($$self{-font},TTF_STYLE_NORMAL());
  90 }
  91
  92 sub bold {
  93         my ($self) = @_;
  94         SDL::TTFSetFontStyle($$self{-font},TTF_STYLE_BOLD());
  95 }
  96
  97 sub italic {
  98         my ($self) = @_;
  99         SDL::TTFSetFontStyle($$self{-font},TTF_STYLE_ITALIC());
 100
 101 }
 102
 103 sub underline {
 104         my ($self) = @_;
 105         SDL::TTFSetFontStyle($$self{-font},TTF_STYLE_UNDERLINE());
 106 }
 107
 108 sub text_shaded {
 109         my ($self) = @_;
 110         $$self{-mode} = TEXT_SHADED();
 111 }
 112
 113 sub text_solid {
 114         my ($self) = @_;
 115         $$self{-mode} = TEXT_SOLID();
 116 }
 117
 118 sub text_blended {
 119         my ($self) = @_;
 120         $$self{-mode} = TEXT_BLENDED();
 121 }
 122
 123 sub utf8_shaded {
 124         my ($self) = @_;
 125         $$self{-mode} = UTF8_SHADED();
 126 }
 127
 128 sub utf8_solid {
 129         my ($self) = @_;
 130         $$self{-mode} = UTF8_SOLID();
 131 }
 132
 133 sub utf8_blended {
 134         my ($self) = @_;
 135         $$self{-mode} = UTF8_BLENDED();
 136 }
 137
 138 sub unicode_shaded {
 139         my ($self) = @_;
 140         $$self{-mode} = UNICODE_SHADED();
 141 }
 142
 143 sub unicode_solid {
 144         my ($self) = @_;
 145         $$self{-mode} = UNICODE_SOLID();
 146 }
 147
 148 sub unicode_blended {
 149         my ($self) = @_;
 150         $$self{-mode} = UNICODE_BLENDED();
 151 }
 152
 153 die "Could not initialize True Type Fonts\n"
 154         if ( SDL::TTFInit() < 0);
 155
 156 1;
 157
 158 __END__;
 159
 160 =pod
 161
 162 =head1 NAME
 163
 164 SDL::TTFont - a SDL perl extension
 165
 166 =head1 SYNOPSIS
 167
 168   $font = new TTFont -name => "Utopia.ttf", -size => 18;
 169
 170 =head1 DESCRIPTION
 171
 172 L<SDL::TTFont> is a module for applying true type fonts to L<SDL::Surface>.
 173
 174 =head1 AUTHOR
 175
 176 David J. Goehrig
 177
 178 =head1 SEE ALSO
 179
 180 L<perl> L<SDL::Surface>
 181
 182 =cut