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