/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
 31package SDL::TTFont;
 32
 33use strict;
 34use warnings;
 35use Carp;
 36use SDL;
 37use SDL::Surface;
 38
 39use vars qw/ @ISA /;
 40
 41@ISA = qw(SDL::Surface);
 42
 43our $VERSION = 2.548;
 44
 45sub new {
 46	my $proto = shift;
 47	my $class = ref($proto) || $proto;
 48	my $self  = {};
 49	my %options;
 50	(%options) = @_;
 51	$self->{-mode} = $options{-mode}       || $options{-m} || SDL::TEXT_SHADED();
 52	$self->{-name} = $options{-name}       || $options{-n};
 53	$self->{-size} = $options{-size}       || $options{-s};
 54	$self->{-fg}   = $options{-foreground} || $options{-fg} || $SDL::Color::black;
 55	$self->{-bg}   = $options{-background} || $options{-bg} || $SDL::Color::white;
 56
 57	Carp::confess "SDL::TTFont::new requires a -name\n"
 58		unless ( $$self{-name} );
 59
 60	Carp::confess "SDL::TTFont::new requires a -size\n"
 61		unless ( $$self{-size} );
 62
 63	$self->{-font} = SDL::TTFOpenFont( $self->{-name}, $self->{-size} );
 64
 65	Carp::confess "Could not open font $$self{-name}, ", SDL::GetError(), "\n"
 66		unless ( $self->{-font} );
 67
 68	bless $self, $class;
 69	return $self;
 70}
 71
 72sub DESTROY {
 73	my $self = shift;
 74	SDL::FreeSurface( $self->{-surface} ) if ( defined( $self->{-surface} ) );
 75	SDL::TTFCloseFont( $self->{-font} )   if ( defined( $self->{-font} ) );
 76}
 77
 78sub print {
 79	my ( $self, $surface, $x, $y, @text ) = @_;
 80
 81	Carp::confess "Print requies an SDL::Surface"
 82		unless ( ref($surface) && $surface->isa("SDL::Surface") );
 83
 84	SDL::FreeSurface( $self->{-surface} ) if ( $$self{-surface} );
 85
 86	$$self{-surface} = SDL::TTFPutString(
 87		$$self{-font}, $$self{-mode}, $$surface, $x, $y,
 88		$self->{-fg},  $self->{-bg},  join( "",  @text )
 89	);
 90
 91	Carp::confess "Could not print \"", join( "", @text ), "\" to surface, ", SDL::GetError(), "\n"
 92		unless ( $$self{-surface} );
 93}
 94
 95sub width {
 96	my ( $self, @text ) = @_;
 97	my $aref = SDL::TTFSizeText( $$self{-font}, join( " ", @text ) );
 98	$$aref[0];
 99}
100
101sub height {
102	my ($self) = @_;
103	SDL::TTFFontHeight( $$self{-font} );
104}
105
106sub ascent {
107	my ($self) = @_;
108	SDL::TTFFontAscent( $$self{-font} );
109}
110
111sub descent {
112	my ($self) = @_;
113	SDL::TTFFontDescent( $$self{-font} );
114}
115
116sub normal {
117	my ($self) = @_;
118	SDL::TTFSetFontStyle( $$self{-font}, SDL::TTF_STYLE_NORMAL() );
119}
120
121sub bold {
122	my ($self) = @_;
123	SDL::TTFSetFontStyle( $$self{-font}, SDL::TTF_STYLE_BOLD() );
124}
125
126sub italic {
127	my ($self) = @_;
128	SDL::TTFSetFontStyle( $$self{-font}, SDL::TTF_STYLE_ITALIC() );
129
130}
131
132sub underline {
133	my ($self) = @_;
134	SDL::TTFSetFontStyle( $$self{-font}, SDL::TTF_STYLE_UNDERLINE() );
135}
136
137sub text_shaded {
138	my ($self) = @_;
139	$$self{-mode} = SDL::TEXT_SHADED();
140}
141
142sub text_solid {
143	my ($self) = @_;
144	$$self{-mode} = SDL::TEXT_SOLID();
145}
146
147sub text_blended {
148	my ($self) = @_;
149	$$self{-mode} = SDL::TEXT_BLENDED();
150}
151
152sub utf8_shaded {
153	my ($self) = @_;
154	$$self{-mode} = SDL::UTF8_SHADED();
155}
156
157sub utf8_solid {
158	my ($self) = @_;
159	$$self{-mode} = SDL::UTF8_SOLID();
160}
161
162sub utf8_blended {
163	my ($self) = @_;
164	$$self{-mode} = SDL::UTF8_BLENDED();
165}
166
167sub unicode_shaded {
168	my ($self) = @_;
169	$$self{-mode} = SDL::UNICODE_SHADED();
170}
171
172sub unicode_solid {
173	my ($self) = @_;
174	$$self{-mode} = SDL::UNICODE_SOLID();
175}
176
177sub unicode_blended {
178	my ($self) = @_;
179	$$self{-mode} = SDL::UNICODE_BLENDED();
180}
181
182Carp::confess "Could not initialize True Type Fonts\n"
183	if ( SDL::TTFInit() < 0 );
184
1851;