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; |
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}); |
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})); |
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}, |
85 | $$surface,$x,$y,${$$self{-fg}},${$$self{-bg}},join("",@text)); |
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 | } |
177 | |
084b921f |
178 | croak "Could not initialize True Type Fonts\n" |
8fde61e3 |
179 | if ( SDL::TTFInit() < 0); |
180 | |
181 | 1; |
182 | |
183 | __END__; |
184 | |
185 | =pod |
186 | |
187 | =head1 NAME |
188 | |
189 | SDL::TTFont - a SDL perl extension |
190 | |
191 | =head1 SYNOPSIS |
192 | |
193 | $font = new TTFont -name => "Utopia.ttf", -size => 18; |
194 | |
195 | =head1 DESCRIPTION |
196 | |
197 | L<SDL::TTFont> is a module for applying true type fonts to L<SDL::Surface>. |
198 | |
199 | =head1 AUTHOR |
200 | |
201 | David J. Goehrig |
202 | |
203 | =head1 SEE ALSO |
204 | |
205 | L<perl> L<SDL::Surface> |
206 | |
207 | =cut |