Commit | Line | Data |
8fde61e3 |
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; |
084b921f |
11 | use warnings; |
12 | use Carp; |
8fde61e3 |
13 | use SDL; |
14 | use SDL::Surface; |
15 | |
16 | use vars qw/ @ISA /; |
17 | |
18 | @ISA = qw(SDL::Surface); |
19 | |
20 | sub 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 | |
47 | sub DESTROY { |
48 | my $self = shift; |
49 | SDL::FreeSurface($self->{-surface}); |
50 | SDL::TTFCloseFont($self->{-font}); |
51 | } |
52 | |
53 | sub 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 | |
68 | sub width { |
69 | my ($self,@text) = @_; |
70 | my $aref = SDL::TTFSizeText($$self{-font},join(" ",@text)); |
71 | $$aref[0]; |
72 | } |
73 | |
74 | sub height { |
75 | my ($self) = @_; |
76 | SDL::TTFFontHeight($$self{-font}); |
77 | } |
78 | |
79 | sub ascent { |
80 | my ($self) = @_; |
81 | SDL::TTFFontAscent($$self{-font}); |
82 | } |
83 | |
84 | sub descent { |
85 | my ($self) = @_; |
86 | SDL::TTFFontDescent($$self{-font}); |
87 | } |
88 | |
89 | sub normal { |
90 | my ($self) = @_; |
91 | SDL::TTFSetFontStyle($$self{-font},TTF_STYLE_NORMAL()); |
92 | } |
93 | |
94 | sub bold { |
95 | my ($self) = @_; |
96 | SDL::TTFSetFontStyle($$self{-font},TTF_STYLE_BOLD()); |
97 | } |
98 | |
99 | sub italic { |
100 | my ($self) = @_; |
101 | SDL::TTFSetFontStyle($$self{-font},TTF_STYLE_ITALIC()); |
102 | |
103 | } |
104 | |
105 | sub underline { |
106 | my ($self) = @_; |
107 | SDL::TTFSetFontStyle($$self{-font},TTF_STYLE_UNDERLINE()); |
108 | } |
109 | |
110 | sub text_shaded { |
111 | my ($self) = @_; |
112 | $$self{-mode} = TEXT_SHADED(); |
113 | } |
114 | |
115 | sub text_solid { |
116 | my ($self) = @_; |
117 | $$self{-mode} = TEXT_SOLID(); |
118 | } |
119 | |
120 | sub text_blended { |
121 | my ($self) = @_; |
122 | $$self{-mode} = TEXT_BLENDED(); |
123 | } |
124 | |
125 | sub utf8_shaded { |
126 | my ($self) = @_; |
127 | $$self{-mode} = UTF8_SHADED(); |
128 | } |
129 | |
130 | sub utf8_solid { |
131 | my ($self) = @_; |
132 | $$self{-mode} = UTF8_SOLID(); |
133 | } |
134 | |
135 | sub utf8_blended { |
136 | my ($self) = @_; |
137 | $$self{-mode} = UTF8_BLENDED(); |
138 | } |
139 | |
140 | sub unicode_shaded { |
141 | my ($self) = @_; |
142 | $$self{-mode} = UNICODE_SHADED(); |
143 | } |
144 | |
145 | sub unicode_solid { |
146 | my ($self) = @_; |
147 | $$self{-mode} = UNICODE_SOLID(); |
148 | } |
149 | |
150 | sub unicode_blended { |
151 | my ($self) = @_; |
152 | $$self{-mode} = UNICODE_BLENDED(); |
153 | } |
154 | |
084b921f |
155 | croak "Could not initialize True Type Fonts\n" |
8fde61e3 |
156 | if ( SDL::TTFInit() < 0); |
157 | |
158 | 1; |
159 | |
160 | __END__; |
161 | |
162 | =pod |
163 | |
164 | =head1 NAME |
165 | |
166 | SDL::TTFont - a SDL perl extension |
167 | |
168 | =head1 SYNOPSIS |
169 | |
170 | $font = new TTFont -name => "Utopia.ttf", -size => 18; |
171 | |
172 | =head1 DESCRIPTION |
173 | |
174 | L<SDL::TTFont> is a module for applying true type fonts to L<SDL::Surface>. |
175 | |
176 | =head1 AUTHOR |
177 | |
178 | David J. Goehrig |
179 | |
180 | =head1 SEE ALSO |
181 | |
182 | L<perl> L<SDL::Surface> |
183 | |
184 | =cut |