File Coverage

blib/lib/Games/OpenGL/Font/2D.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


line stmt bran cond sub pod time code
1             # Games-OpenGL-Font-2D - load/render 2D fonts via OpenGL
2              
3             package Games::OpenGL::Font::2D;
4              
5             # (C) by Tels
6              
7 1     1   21826 use strict;
  1         4  
  1         39  
8              
9 1     1   5 use Exporter;
  1         1  
  1         41  
10 1     1   481 use SDL::OpenGL;
  0            
  0            
11             use SDL::Surface;
12             use vars qw/@ISA $VERSION @EXPORT_OK/;
13             @ISA = qw/Exporter/;
14              
15             @EXPORT_OK = qw/
16             FONT_ALIGN_LEFT FONT_ALIGN_RIGHT FONT_ALIGN_CENTER
17             FONT_ALIGN_TOP FONT_ALIGN_BOTTOM
18             /;
19              
20             $VERSION = '0.07';
21              
22             ##############################################################################
23             # constants
24              
25             use constant FONT_ALIGN_LEFT => -1;
26             use constant FONT_ALIGN_RIGHT => 1;
27             use constant FONT_ALIGN_CENTER => 0;
28              
29             use constant FONT_ALIGN_TOP => -1;
30             use constant FONT_ALIGN_BOTTOM => 1;
31              
32             ##############################################################################
33             # methods
34              
35             sub new
36             {
37             # create a new instance of a font
38             my $class = shift;
39              
40             my $self = { };
41             bless $self, $class;
42            
43             my $args = $_[0];
44             $args = { @_ } unless ref $args eq 'HASH';
45              
46             $self->{file} = $args->{file} || '';
47             $self->{color} = $args->{color} || [ 1,1,1 ];
48             $self->{alpha} = $args->{alpha} || 1;
49             $self->{char_width} = int(abs($args->{char_width} || 16));
50             $self->{char_height} = int(abs($args->{char_height} || 16));
51             $self->{spacing_x} = int($args->{spacing_x} || $self->{char_width});
52             $self->{spacing_y} = int($args->{spacing_y} || 0);
53             $self->{transparent} = 1;
54             $self->{width} = 640;
55             $self->{height} = 480;
56             $self->{zoom_x} = abs($args->{zoom_x} || 1);
57             $self->{zoom_y} = abs($args->{zoom_y} || 1);
58             $self->{chars} = int(abs($args->{chars} || (256-32)));
59             $self->{chars_per_line} = int(abs($args->{chars_per_line} || 32));
60             $self->{align_x} = $args->{align_x};
61             $self->{align_y} = $args->{align_y};
62             $self->{align_y} = -1 unless defined $self->{align_y};
63             $self->{align_x} = -1 unless defined $self->{align_x};
64             $self->{align_x} = int($self->{align_x});
65             $self->{align_y} = int($self->{align_x});
66             $self->{border_x} = int(abs($args->{border_x} || 0));
67             $self->{border_y} = int(abs($args->{border_y} || 0));
68            
69             $self->_read_font($self->{file});
70            
71             $self->{pre_output} = 0;
72            
73             # Create the display lists
74             $self->{base} = glGenLists( $self->{chars} );
75              
76             $self->_build_font();
77             $self;
78             }
79              
80             sub _read_font
81             {
82             my $self = shift;
83              
84             # load the file as SDL::Surface into memory
85             my $font = SDL::Surface->new( -name => $self->{file} );
86              
87             # create one texture and bind it to our object's member 'texture'
88             $self->{texture} = glGenTextures(1)->[0];
89             glBindTexture( GL_TEXTURE_2D, $self->{texture} );
90              
91             # Select nearest filtering
92             glTexParameter( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR );
93             glTexParameter( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR );
94              
95             # generate the OpenGL texture
96             glTexImage2D(
97             GL_TEXTURE_2D, 0, 3, $font->width(), $font->height(), 0, GL_BGR,
98             GL_UNSIGNED_BYTE, $font->pixels() );
99              
100             $self->{texture_width} = $font->width();
101             $self->{texture_height} = $font->height();
102              
103             # $font will go out of scope and thus freed at the end of this sub
104             }
105              
106             sub _build_font
107             {
108             my $self = shift;
109              
110             # select our font texture
111             glBindTexture( GL_TEXTURE_2D, $self->{texture} );
112              
113             my $cw = $self->{char_width};
114             my $ch = $self->{char_height};
115             my $w = int($cw * $self->{zoom_x});
116             my $h = int($ch * $self->{zoom_y});
117             my $bx = $self->{border_x};
118             my $by = $self->{border_y};
119             # calculate w/h of a char in 0..1 space
120             my $cwi = ($cw+$bx)/$self->{texture_width};
121             my $chi = ($ch+$by)/$self->{texture_height};
122             $cw = $cw/$self->{texture_width};
123             $ch = $ch/$self->{texture_height};
124             # print "$self->{file}: $cw x $ch ($w x $h => ",$w+$bx," x ",$h+$by,") $self->{base} ($self->{texture_width} x $self->{texture_height})\n";
125             my $cx = 0; my $cy = 0;
126             my $c = 0;
127             # loop through all characters
128             for my $loop (1 .. $self->{chars})
129             {
130             # start building a list
131             glNewList( $self->{base} + $loop - 1, GL_COMPILE );
132             # Use A Quad For Each Character
133             glBegin( GL_QUADS );
134              
135             # Bottom Left
136             glTexCoord( $cx, $cy + $ch); # was: 0.0625
137             glVertex( 0, 0 );
138              
139             # Bottom Right
140             glTexCoord( $cx + $cw, $cy + $ch);
141             glVertex( $w, 0 );
142              
143             # Top Right
144             glTexCoord( $cx + $cw, $cy);
145             glVertex( $w, $h );
146              
147             # Top Left
148             glTexCoord( $cx , $cy);
149             glVertex( 0, $h );
150              
151             glEnd();
152              
153             # move to next character
154             glTranslate( $self->{spacing_x} * $self->{zoom_x},
155             $self->{spacing_y} * $self->{zoom_y}, 0 );
156             glEndList();
157            
158             # X and Y position of next char
159             $cx += $cwi;
160             if (++$c >= $self->{chars_per_line})
161             {
162             $c = 0; $cx = 0; $cy += $chi;
163             }
164              
165              
166             }
167             }
168              
169             sub pre_output
170             {
171             my $self = shift;
172              
173             warn ("pre_output() called twice") if $self->{pre_output} != 0;
174             $self->{pre_output} = 1;
175              
176             # Select our texture
177             glBindTexture( GL_TEXTURE_2D, $self->{texture} );
178              
179             $self->{gl_flags} = [
180             glIsEnabled(GL_DEPTH_TEST),
181             glIsEnabled(GL_TEXTURE_2D),
182             glIsEnabled(GL_CULL_FACE),
183             ];
184             # Disable/Enable flags
185             glDisable( GL_DEPTH_TEST );
186             glEnable( GL_TEXTURE_2D );
187             glDisable( GL_CULL_FACE );
188             glDepthMask(GL_FALSE); # disable writing to depth buffer
189            
190             glEnable( GL_BLEND );
191             # Select The Type Of Blending
192             if ($self->{transparent})
193             {
194             glBlendFunc(GL_SRC_ALPHA,GL_ONE);
195             }
196             else
197             {
198             glBlendFunc(GL_SRC_ALPHA,GL_ONE_MINUS_SRC_ALPHA);
199             }
200              
201             # Select The Projection Matrix
202             glMatrixMode( GL_PROJECTION );
203             # Store The Projection Matrix
204             glPushMatrix();
205             # Reset The Projection Matrix
206             glLoadIdentity();
207              
208             # Set Up An Ortho Screen
209             # left, right, bottom, top, near, far
210             glOrtho( 0, $self->{width}, 0, $self->{height}, -1, 1 );
211            
212             # Select The Modelview Matrix
213             glMatrixMode( GL_MODELVIEW );
214             # Store the Modelview Matrix
215             glPushMatrix();
216             # Reset The Modelview Matrix
217             glLoadIdentity();
218             }
219              
220             sub output
221             {
222             # Output the given string at the coordinates
223             my ($self,$x,$y,$string,$color,$alpha) = @_;
224              
225             return if $string eq '';
226              
227             # Reset The Modelview Matrix
228             glLoadIdentity();
229              
230             if ($self->{align_x} != FONT_ALIGN_LEFT)
231             {
232             # center or right aligned
233             my $tw = abs((length($string)-1) * $self->{spacing_x} * $self->{zoom_x});
234             # vertical text
235             $tw += $self->{char_width} * $self->{zoom_x};
236             if ($self->{align_x} == FONT_ALIGN_RIGHT)
237             {
238             $x = $x - $tw;
239             }
240             else
241             {
242             $x = $x - $tw / 2;
243             }
244             }
245             if ($self->{align_y} != FONT_ALIGN_TOP)
246             {
247             my $th = abs((length($string)) * $self->{spacing_y} * $self->{zoom_y});
248             $th -= $self->{char_height} * $self->{zoom_y};
249             if ($self->{align_y} == FONT_ALIGN_BOTTOM)
250             {
251             $y = $y + $th;
252             }
253             else
254             {
255             $y = $y + $th / 2;
256             }
257             }
258              
259             # translate to the top-left position of the text (after alignment)
260             glTranslate( $x, $y, 0 );
261              
262             # set color and alpha value
263             $color = $self->{color} unless defined $color;
264             $alpha = $self->{alpha} unless defined $alpha;
265             if (defined $color)
266             {
267             # if not, caller wanted to set color by herself
268             if (defined $alpha)
269             {
270             glColor (@$color,$alpha);
271             }
272             else
273             {
274             glColor (@$color,1);
275             }
276             }
277              
278             # Choose The Font Set (0 or 1) (-32 because our lists start at 0, and space
279             # has an ASCII value of 32 and is the first existing character)
280             glListBase( $self->{base} - 32 );
281              
282             # render the string to the screen
283             glCallListsString( $string );
284              
285             }
286              
287             sub post_output
288             {
289             my $self = shift;
290              
291             warn ("post_output() called before pre_output()")
292             if $self->{pre_output} == 0;
293             $self->{pre_output} = 0;
294              
295             # Reset the OpenGL stuff
296              
297             # Select The Projection Matrix
298             glMatrixMode( GL_PROJECTION );
299             # Restore The Old Projection Matrix
300             glPopMatrix();
301              
302             # Select the Modelview Matrix
303             glMatrixMode( GL_MODELVIEW );
304             # Restore the Old Projection Matrix
305             glPopMatrix();
306              
307             my $flags = $self->{gl_flags};
308             glEnable(GL_DEPTH_TEST) if $flags->[0];
309             glEnable(GL_TEXTURE_2D) if $flags->[1];
310             glEnable(GL_CULL_FACE) if $flags->[2];
311             glDepthMask(GL_TRUE); # enable writing to depth buffer
312            
313             # Caller must re-enable or re-disable other flags if she wishes
314             }
315              
316             sub screen_width
317             {
318             my $self = shift;
319              
320             $self->{width} = shift if @_ > 0;
321             $self->{width};
322             }
323              
324             sub screen_height
325             {
326             my $self = shift;
327              
328             $self->{height} = shift if @_ > 0;
329             $self->{height};
330             }
331              
332             sub color
333             {
334             my $self = shift;
335              
336             if (@_ > 0)
337             {
338             if (ref($_[0]) eq 'ARRAY')
339             {
340             $self->{color} = shift;
341             }
342             else
343             {
344             $self->{color} = [ $_[0], $_[1], $_[2] ];
345             }
346             }
347             $self->{color};
348             }
349              
350             sub transparent
351             {
352             my $self = shift;
353              
354             $self->{transparent} = shift if @_ > 0;
355             $self->{transparent};
356             }
357              
358             sub alpha
359             {
360             my $self = shift;
361              
362             $self->{alpha} = shift if @_ > 0;
363             $self->{alpha};
364             }
365              
366             sub spacing_x
367             {
368             my $self = shift;
369              
370             if (@_ > 0)
371             {
372             $self->{spacing_x} = shift;
373             $self->_build_font();
374             }
375             $self->{spacing_x};
376             }
377              
378             sub spacing_y
379             {
380             my $self = shift;
381              
382             if (@_ > 0)
383             {
384             $self->{spacing_y} = shift;
385             $self->_build_font();
386             }
387             $self->{spacing_y};
388             }
389              
390             sub spacing
391             {
392             my $self = shift;
393              
394             if (@_ > 0)
395             {
396             $self->{spacing_x} = shift;
397             $self->{spacing_y} = shift;
398             $self->_build_font();
399             }
400             ($self->{spacing_x}, $self->{spacing_y});
401             }
402              
403             sub border_x
404             {
405             my $self = shift;
406              
407             if (@_ > 0)
408             {
409             $self->{border_x} = iint(abs(shift));
410             $self->_build_font();
411             }
412             $self->{border_x};
413             }
414              
415             sub border_y
416             {
417             my $self = shift;
418              
419             if (@_ > 0)
420             {
421             $self->{border_y} = iint(abs(shift));
422             $self->_build_font();
423             }
424             $self->{border_y};
425             }
426              
427             sub zoom
428             {
429             my $self = shift;
430              
431             if (@_ > 0)
432             {
433             $self->{zoom_x} = shift;
434             $self->{zoom_y} = shift;
435             $self->_build_font();
436             }
437             ($self->{zoom_x}, $self->{zoom_y});
438             }
439              
440             sub copy
441             {
442             my $self = shift;
443              
444             my $class = ref($self);
445             my $new = {};
446             foreach my $k (keys %$self)
447             {
448             $new->{$k} = $self->{$k};
449             }
450             $new->{base} = glGenLists ( $self->{chars} ); # get the new font some lists
451             bless $new, $class;
452             $new->_build_font();
453             $new;
454             }
455              
456             sub align_x
457             {
458             my $self = shift;
459              
460             $self->{align_x} = shift if @_ > 0;
461             $self->{align_x};
462             }
463              
464             sub align_y
465             {
466             my $self = shift;
467              
468             $self->{align_y} = shift if @_ > 0;
469             $self->{align_y};
470             }
471              
472             sub align
473             {
474             my $self = shift;
475              
476             if (@_ > 0)
477             {
478             $self->{align_x} = shift;
479             $self->{align_y} = shift;
480             }
481             ($self->{align_x}, $self->{align_y});
482             }
483              
484             sub char_height
485             {
486             my $self = shift;
487              
488             $self->{char_height} * $self->{zoom_y};
489             }
490              
491             sub char_width
492             {
493             my $self = shift;
494              
495             $self->{char_width} * $self->{zoom_x};
496             }
497              
498             sub DESTROY
499             {
500             my $self = shift;
501              
502             # free the texture lists
503             glDeleteLists( $self->{base}, $self->{chars} ) if defined $self->{base};
504             }
505              
506             1;
507              
508             __END__