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