#!/usr/bin/env perl # # testfonttool.pl # # Copyright (C) 2005 David J. Goehrig # # ------------------------------------------------------------------------------ # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Lesser General Public # License as published by the Free Software Foundation; either # version 2.1 of the License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # # ------------------------------------------------------------------------------ # # Please feel free to send questions, suggestions or improvements to: # # David J. Goehrig # dgoehrig@cpan.org # use strict; use SDL; use SDL::App; use SDL::Event; use SDL::Tool::Font; use SDL::Color; use MIME::Base64 qw(decode_base64); my (%options,$app,$mode); $options{-flags} = SDL_SWSURFACE; $options{-title} = $0; $options{-width} ||= 800; $options{-height} ||= 600; $options{-depth} ||= $options{-bpp} || 32; $app = new SDL::App %options; my %ttfonts = ( 'ttf1.ttf' => 0, 'ttf2.ttf' => 0, ); my %sfonts = ( 'sfont1.png' => 0, 'sfont2.png' => 0, ); my @fonts; write_fonts(); for ( reverse keys %ttfonts ) { for $mode ( qw/ -normal -bold -italic -underline / ) { if (-e "/tmp/$_") { print STDERR "Loading $_\n"; $ttfonts{"$_$mode"} = new SDL::Tool::Font $mode => 1, -ttfont => "/tmp/$_", -size => 20, -fg => $SDL::Color::black, -bg => $SDL::Color::black; push @fonts, $ttfonts{"$_$mode"}; } } } %ttfonts = reverse %ttfonts; for ( reverse keys %sfonts) { if (-e "/tmp/$_") { print STDERR "Loading $_\n"; $sfonts{$_} = new SDL::Tool::Font -sfont => "/tmp/$_"; push @fonts, $sfonts{$_}; } } %sfonts = reverse %sfonts; sub DrawFonts { $app->fill(0,$SDL::Color::white); my ($x,$y) = @_; for my $font ( @fonts) { $font->print($app,$x,$y,"SDLperl font test. ", "This is " . ($ttfonts{$font} || $sfonts{$font})); $y += 40; } $app->flip(); } DrawFonts(10,10); $app->loop( { SDL_KEYDOWN() => sub { my ($event) = @_; $app->warp($options{-width}/2,$options{-height}/2) if ($event->key_sym() == SDLK_SPACE); $app->fullscreen() if ($event->key_sym() == SDLK_f); exit(0) if ($event->key_sym() == SDLK_ESCAPE); }, SDL_QUIT() => sub { exit(0); } } ); sub write_fonts() { my $ttf1 = decode_base64 < /tmp/ttf1.ttf" or die "Failed to write font $!\n"; print FP $ttf2; close FP; open FP, "> /tmp/ttf2.ttf" or die "Failed to write font $!\n"; print FP $ttf2; close FP; open FP, "> /tmp/sfont1.png" or die "Failed to write font $!\n"; print FP $sfont1; close FP; open FP, "> /tmp/sfont2.png" or die "Failed to write font $!\n"; print FP $sfont2; close FP; }