[sdlgit/SDL_perl.git] / lib / SDL / TTFont.pm

#!/usr/bin/env perl
#
# TTFont.pm
#
# Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
#
# ------------------------------------------------------------------------------
#
# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Lesser General Public
# License as published by the Free Software Foundation; either
# version 2.1 of the License, or (at your option) any later version.
# 
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# Lesser General Public License for more details.
# 
# You should have received a copy of the GNU Lesser General Public
# License along with this library; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
#
# ------------------------------------------------------------------------------
#
# Please feel free to send questions, suggestions or improvements to:
#
#	David J. Goehrig
#	dgoehrig@cpan.org
#

package SDL::TTFont;

use strict;
use warnings;
use Carp;
use SDL;
use SDL::Surface;

use vars qw/ @ISA /;

@ISA = qw(SDL::Surface);

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self = {};
	my %options;
	(%options) = @_;
	$self->{-mode} = $options{-mode} 	|| $options{-m}	 || SDL::TEXT_SHADED();
	$self->{-name} = $options{-name} 	|| $options{-n};
	$self->{-size} = $options{-size} 	|| $options{-s};
	$self->{-fg} = $options{-foreground} 	|| $options{-fg} || $SDL::Color::black;
	$self->{-bg} = $options{-background}	|| $options{-bg} || $SDL::Color::white;

	croak "SDL::TTFont::new requires a -name\n"
		unless ($$self{-name});

	croak "SDL::TTFont::new requires a -size\n"
		unless ($$self{-size});

	$self->{-font} = SDL::TTFOpenFont($self->{-name},$self->{-size});

	croak "Could not open font $$self{-name}, ", SDL::GetError(), "\n"
		unless ($self->{-font});

	bless $self,$class;
	return $self;	
}

sub DESTROY {
	my $self = shift;
	SDL::FreeSurface($self->{-surface}) if (defined ($self->{-surface}));
	SDL::TTFCloseFont($self->{-font}) if (defined ($self->{-font}));
}

sub print {
	my ($self,$surface,$x,$y,@text) = @_;

	croak "Print requies an SDL::Surface"
		unless( ref($surface) && $surface->isa("SDL::Surface") );

	SDL::FreeSurface($self->{-surface}) if ($$self{-surface});

	$$self{-surface} = SDL::TTFPutString($$self{-font},$$self{-mode},
		$$surface,$x,$y,$self->{-fg},$self->{-bg},join("",@text));

	croak "Could not print \"", join("",@text), "\" to surface, ",
		SDL::GetError(), "\n" unless ($$self{-surface});
}

sub width {
        my ($self,@text) = @_;
        my $aref = SDL::TTFSizeText($$self{-font},join(" ",@text));
	$$aref[0];
}

sub height {
        my ($self) = @_;
        SDL::TTFFontHeight($$self{-font});
}

sub ascent {
        my ($self) = @_;
        SDL::TTFFontAscent($$self{-font});
}

sub descent {
        my ($self) = @_;
        SDL::TTFFontDescent($$self{-font});
}

sub normal {
	my ($self) = @_;
	SDL::TTFSetFontStyle($$self{-font},SDL::TTF_STYLE_NORMAL());
}

sub bold {
	my ($self) = @_;
	SDL::TTFSetFontStyle($$self{-font},SDL::TTF_STYLE_BOLD());
}

sub italic {
	my ($self) = @_;
	SDL::TTFSetFontStyle($$self{-font},SDL::TTF_STYLE_ITALIC());

}

sub underline {
	my ($self) = @_;
	SDL::TTFSetFontStyle($$self{-font},SDL::TTF_STYLE_UNDERLINE());
}

sub text_shaded {
	my ($self) = @_;
	$$self{-mode} = SDL::TEXT_SHADED();
}

sub text_solid {
	my ($self) = @_;
	$$self{-mode} = SDL::TEXT_SOLID();
}

sub text_blended {
	my ($self) = @_;
	$$self{-mode} = SDL::TEXT_BLENDED();
}

sub utf8_shaded {
	my ($self) = @_;
	$$self{-mode} = SDL::UTF8_SHADED();
}

sub utf8_solid {
	my ($self) = @_;
	$$self{-mode} = SDL::UTF8_SOLID();
}

sub utf8_blended {
	my ($self) = @_;
	$$self{-mode} = SDL::UTF8_BLENDED();
}

sub unicode_shaded {
	my ($self) = @_;
	$$self{-mode} = SDL::UNICODE_SHADED();
}

sub unicode_solid {
	my ($self) = @_;
	$$self{-mode} = SDL::UNICODE_SOLID();
}

sub unicode_blended {
	my ($self) = @_;
	$$self{-mode} = SDL::UNICODE_BLENDED();
}

croak "Could not initialize True Type Fonts\n"
	if ( SDL::TTFInit() < 0);

1;

__END__;

=head1 NAME

SDL::TTFont - a SDL perl extension

=head1 SYNOPSIS

  $font = SDL::TTFont->new( -name => "Utopia.ttf", -size => 18 );
	
=head1 DESCRIPTION

L<< SDL::TTFont >> is a module for applying true type fonts to L<< SDL::Surface >>.

=head1 METHODS

=head2 new

Instanciates a new font surface. It accepts the following parameters:

=head3 -name

=head3 -n

The font filename (possibly with proper path) to be used. B<< This options is mandatory >>.

=head3 -size

=head3 -s

The font size (height, in pixels) to be used. B<< This option is mandatory >>.

=head3 -foreground

=head3 -fg

Foreground color for the font surface (i.e. the actual font color). It expects a 
SDL::Color value. If omitted, black is used as font color.

=head3 -background

=head3 -bg

Background color for the font surface (i.e. the font background color). It expects 
a SDL::Color value. If omitted , white is used for the background.

=head3 -mode

=head3 -m

Font mode. If omitted, SDL::TEXT_SHADED is used. Note that this class provides 
human friendly accessors for setting different modes, so you should probably use 
them instead. See below for further details.

=head2 Text Modes

The SDL::TTFont accepts three different types (shaded, solid, blended) for 
three different encodings (text, utf8, unicode).

  $font->text_shaded;       # sets mode to SDL::TEXT_SHADED
  $font->text_solid;        # sets mode to SDL::TEXT_SOLID
  $font->text_blended;      # sets mode to SDL::TEXT_BLENDED
  
  $font->utf8_shaded;       # sets mode to SDL::UTF8_SHADED
  $font->utf8_solid;        # sets mode to SDL::UTF8_SOLID
  $font->utf8_blended;      # sets mode to SDL::UTF8_BLENDED
  
  $font->unicode_shaded;    # sets mode to SDL::UNICODE_SHADED
  $font->unicode_solid;     # sets mode to SDL::UNICODE_SOLID
  $font->unicode_blended;   # sets mode to SDL::UNICODE_BLENDED

=head2 Text Style

You may also smoothly change your font style by calling any of the following 
methods:

  $font->normal;       # resets font styling, making text "normal"
  $font->bold;         # sets bold style for font
  $font->italic;       # sets italic style for font
  $font->underline;    # sets underline style for font


=head2 Ascent/Descent values

Ascent is the number of pixels from the font baseline to the top of the font, while 
descent is the number of pixels from the font baseline to the bottom of the font.

  $font->ascent;      # height in pixels of the font ascent
  $font->descent;     # height in pixels of the font descent

=head2 height

  my $height = $font->height;
  
Returns the height, in pixels, of the actual rendered text. This is the 
average size for each glyph in the font.

=head2 width(@text)

  my $width = $font->width("Choose your destiny");

Returns the dimensions needed to render the text. This can be used to help 
determine the positioning needed for text before it is rendered. It can also 
be used for wordwrapping and other layout effects.

Be aware that most fonts - notably, non-monospaced ("ms") ones - use kerning 
which adjusts the widths for specific letter pairs. For example, the width 
for "ae" will not always match the width for "a" + "e".

=head2 print ($surface, $top, $left, @text)

Directly draws text to an existing surface. Receives the target L<< SDL::Surface >> 
object and the relative top (y) and left (x) coordinates to put the text in. 
The last parameter may be a string or an array or strings with the text to be 
written.


=head1 AUTHOR

David J. Goehrig

=head1 SEE ALSO

L<perl>, L<SDL>, L<< SDL::Surface >>
Commit	Line	Data
7b6a53a1	1	#!/usr/bin/env perl
8fde61e3	2	#
7b6a53a1	3	# TTFont.pm
8fde61e3	4	#
7b6a53a1	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
8fde61e3	29	#
	30
	31	package SDL::TTFont;
	32
	33	use strict;
084b921f	34	use warnings;
084b921f	35	use Carp;
8fde61e3	36	use SDL;
	37	use SDL::Surface;
	38
	39	use vars qw/ @ISA /;
	40
	41	@ISA = qw(SDL::Surface);
	42
	43	sub new {
	44	my $proto = shift;
	45	my $class = ref($proto) \|\| $proto;
	46	my $self = {};
	47	my %options;
	48	(%options) = @_;
7b6a53a1	49	$self->{-mode} = $options{-mode} \|\| $options{-m} \|\| SDL::TEXT_SHADED();
8fde61e3	50	$self->{-name} = $options{-name} \|\| $options{-n};
	51	$self->{-size} = $options{-size} \|\| $options{-s};
	52	$self->{-fg} = $options{-foreground} \|\| $options{-fg} \|\| $SDL::Color::black;
	53	$self->{-bg} = $options{-background} \|\| $options{-bg} \|\| $SDL::Color::white;
	54
084b921f	55	croak "SDL::TTFont::new requires a -name\n"
8fde61e3	56	unless ($$self{-name});
8fde61e3	57
084b921f	58	croak "SDL::TTFont::new requires a -size\n"
8fde61e3	59	unless ($$self{-size});
	60
	61	$self->{-font} = SDL::TTFOpenFont($self->{-name},$self->{-size});
	62
084b921f	63	croak "Could not open font $$self{-name}, ", SDL::GetError(), "\n"
8fde61e3	64	unless ($self->{-font});
	65
	66	bless $self,$class;
	67	return $self;
	68	}
	69
	70	sub DESTROY {
	71	my $self = shift;
9bf65e79	72	SDL::FreeSurface($self->{-surface}) if (defined ($self->{-surface}));
9bf65e79	73	SDL::TTFCloseFont($self->{-font}) if (defined ($self->{-font}));
8fde61e3	74	}
	75
	76	sub print {
	77	my ($self,$surface,$x,$y,@text) = @_;
	78
084b921f	79	croak "Print requies an SDL::Surface"
8fde61e3	80	unless( ref($surface) && $surface->isa("SDL::Surface") );
	81
	82	SDL::FreeSurface($self->{-surface}) if ($$self{-surface});
	83
	84	$$self{-surface} = SDL::TTFPutString($$self{-font},$$self{-mode},
3e3f41ee	85	$$surface,$x,$y,$self->{-fg},$self->{-bg},join("",@text));
8fde61e3	86
084b921f	87	croak "Could not print \"", join("",@text), "\" to surface, ",
8fde61e3	88	SDL::GetError(), "\n" unless ($$self{-surface});
	89	}
	90
	91	sub width {
	92	my ($self,@text) = @_;
	93	my $aref = SDL::TTFSizeText($$self{-font},join(" ",@text));
	94	$$aref[0];
	95	}
	96
	97	sub height {
	98	my ($self) = @_;
	99	SDL::TTFFontHeight($$self{-font});
	100	}
	101
	102	sub ascent {
	103	my ($self) = @_;
	104	SDL::TTFFontAscent($$self{-font});
	105	}
	106
	107	sub descent {
	108	my ($self) = @_;
	109	SDL::TTFFontDescent($$self{-font});
	110	}
	111
	112	sub normal {
	113	my ($self) = @_;
7b6a53a1	114	SDL::TTFSetFontStyle($$self{-font},SDL::TTF_STYLE_NORMAL());
8fde61e3	115	}
	116
	117	sub bold {
	118	my ($self) = @_;
7b6a53a1	119	SDL::TTFSetFontStyle($$self{-font},SDL::TTF_STYLE_BOLD());
8fde61e3	120	}
	121
	122	sub italic {
	123	my ($self) = @_;
7b6a53a1	124	SDL::TTFSetFontStyle($$self{-font},SDL::TTF_STYLE_ITALIC());
8fde61e3	125
	126	}
	127
	128	sub underline {
	129	my ($self) = @_;
7b6a53a1	130	SDL::TTFSetFontStyle($$self{-font},SDL::TTF_STYLE_UNDERLINE());
8fde61e3	131	}
	132
	133	sub text_shaded {
	134	my ($self) = @_;
7b6a53a1	135	$$self{-mode} = SDL::TEXT_SHADED();
8fde61e3	136	}
	137
	138	sub text_solid {
	139	my ($self) = @_;
7b6a53a1	140	$$self{-mode} = SDL::TEXT_SOLID();
8fde61e3	141	}
	142
	143	sub text_blended {
	144	my ($self) = @_;
7b6a53a1	145	$$self{-mode} = SDL::TEXT_BLENDED();
8fde61e3	146	}
	147
	148	sub utf8_shaded {
	149	my ($self) = @_;
7b6a53a1	150	$$self{-mode} = SDL::UTF8_SHADED();
8fde61e3	151	}
	152
	153	sub utf8_solid {
	154	my ($self) = @_;
7b6a53a1	155	$$self{-mode} = SDL::UTF8_SOLID();
8fde61e3	156	}
	157
	158	sub utf8_blended {
	159	my ($self) = @_;
7b6a53a1	160	$$self{-mode} = SDL::UTF8_BLENDED();
8fde61e3	161	}
	162
	163	sub unicode_shaded {
	164	my ($self) = @_;
7b6a53a1	165	$$self{-mode} = SDL::UNICODE_SHADED();
8fde61e3	166	}
	167
	168	sub unicode_solid {
	169	my ($self) = @_;
7b6a53a1	170	$$self{-mode} = SDL::UNICODE_SOLID();
8fde61e3	171	}
	172
	173	sub unicode_blended {
	174	my ($self) = @_;
7b6a53a1	175	$$self{-mode} = SDL::UNICODE_BLENDED();
8fde61e3	176	}
8fde61e3	177
084b921f	178	croak "Could not initialize True Type Fonts\n"
8fde61e3	179	if ( SDL::TTFInit() < 0);
	180
	181	1;
	182
	183	__END__;
	184
8fde61e3	185	=head1 NAME
	186
	187	SDL::TTFont - a SDL perl extension
	188
	189	=head1 SYNOPSIS
	190
40654afe	191	$font = SDL::TTFont->new( -name => "Utopia.ttf", -size => 18 );
8fde61e3	192
	193	=head1 DESCRIPTION
	194
40654afe	195	L<< SDL::TTFont >> is a module for applying true type fonts to L<< SDL::Surface >>.
	196
	197	=head1 METHODS
	198
	199	=head2 new
	200
	201	Instanciates a new font surface. It accepts the following parameters:
	202
	203	=head3 -name
	204
	205	=head3 -n
	206
	207	The font filename (possibly with proper path) to be used. B<< This options is mandatory >>.
	208
	209	=head3 -size
	210
	211	=head3 -s
	212
	213	The font size (height, in pixels) to be used. B<< This option is mandatory >>.
	214
	215	=head3 -foreground
	216
	217	=head3 -fg
	218
	219	Foreground color for the font surface (i.e. the actual font color). It expects a
	220	SDL::Color value. If omitted, black is used as font color.
	221
	222	=head3 -background
	223
	224	=head3 -bg
	225
	226	Background color for the font surface (i.e. the font background color). It expects
	227	a SDL::Color value. If omitted , white is used for the background.
	228
	229	=head3 -mode
	230
	231	=head3 -m
	232
	233	Font mode. If omitted, SDL::TEXT_SHADED is used. Note that this class provides
	234	human friendly accessors for setting different modes, so you should probably use
	235	them instead. See below for further details.
	236
	237	=head2 Text Modes
	238
	239	The SDL::TTFont accepts three different types (shaded, solid, blended) for
	240	three different encodings (text, utf8, unicode).
	241
	242	$font->text_shaded; # sets mode to SDL::TEXT_SHADED
	243	$font->text_solid; # sets mode to SDL::TEXT_SOLID
	244	$font->text_blended; # sets mode to SDL::TEXT_BLENDED
	245
	246	$font->utf8_shaded; # sets mode to SDL::UTF8_SHADED
	247	$font->utf8_solid; # sets mode to SDL::UTF8_SOLID
	248	$font->utf8_blended; # sets mode to SDL::UTF8_BLENDED
	249
	250	$font->unicode_shaded; # sets mode to SDL::UNICODE_SHADED
	251	$font->unicode_solid; # sets mode to SDL::UNICODE_SOLID
	252	$font->unicode_blended; # sets mode to SDL::UNICODE_BLENDED
	253
	254	=head2 Text Style
	255
	256	You may also smoothly change your font style by calling any of the following
	257	methods:
	258
259	$font->normal; # resets font styling, making text "normal"
260	$font->bold; # sets bold style for font
261	$font->italic; # sets italic style for font
262	$font->underline; # sets underline style for font
263
264
265	=head2 Ascent/Descent values
266
267	Ascent is the number of pixels from the font baseline to the top of the font, while
268	descent is the number of pixels from the font baseline to the bottom of the font.
269
270	$font->ascent; # height in pixels of the font ascent
271	$font->descent; # height in pixels of the font descent
272
273	=head2 height
274
275	my $height = $font->height;
276
277	Returns the height, in pixels, of the actual rendered text. This is the
278	average size for each glyph in the font.
279
280	=head2 width(@text)
281
282	my $width = $font->width("Choose your destiny");
283
284	Returns the dimensions needed to render the text. This can be used to help
285	determine the positioning needed for text before it is rendered. It can also
286	be used for wordwrapping and other layout effects.
287
288	Be aware that most fonts - notably, non-monospaced ("ms") ones - use kerning
289	which adjusts the widths for specific letter pairs. For example, the width
290	for "ae" will not always match the width for "a" + "e".
291
292	=head2 print ($surface, $top, $left, @text)
293
294	Directly draws text to an existing surface. Receives the target L<< SDL::Surface >>
295	object and the relative top (y) and left (x) coordinates to put the text in.
296	The last parameter may be a string or an array or strings with the text to be
297	written.
298
8fde61e3	299
	300	=head1 AUTHOR
	301
	302	David J. Goehrig
	303
	304	=head1 SEE ALSO
	305
40654afe	306	L<perl>, L<SDL>, L<< SDL::Surface >>