Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 105 lines (84 sloc) 2.139 kb
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
1 #!/usr/bin/env perl
2
3 use strict;
4 use SDL;
c3d720d Kartik Thakore Cleaned up all of SDL::App to SDLx::App
kthakore authored
5 use SDLx::App;
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
6 use SDL::Event;
7 use SDL::Tool::Font;
8 use SDL::Color;
9
e6e146e Kartik Thakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
10 my ( %options, $app, $mode );
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
11
12 die "usage: $0 [-hw] [-fullscreen] [-width 640] [-height 480] [-bpp 24]\n"
4979eb1 Jeffrey T. Palmer perltidy
jtpalmer authored
13 if ( SDL::in( $ARGV[0], qw/ -h -? --help/ ) );
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
14
15 chdir 'test' if -d 'test';
16 die "$0 must be run in the SDL_perl/test/ directory!"
4979eb1 Jeffrey T. Palmer perltidy
jtpalmer authored
17 unless ( -d 'data' );
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
18
e6e146e Kartik Thakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
19 for ( 0 .. @ARGV - 1 ) {
4979eb1 Jeffrey T. Palmer perltidy
jtpalmer authored
20 $options{ $ARGV[$_] } = $ARGV[ $_ + 1 ] || 1;
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
21 }
22
23 $options{-flags} = SDL_SWSURFACE;
e6e146e Kartik Thakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
24 $options{-flags} |= SDL_HWPALETTE if ( $options{-hw} );
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
25 $options{-flags} |= SDL_FULLSCREEN if ( $options{-fullscreen} );
26
27 $options{-title} = $0;
28
29 $options{-width} ||= 800;
30 $options{-height} ||= 600;
e6e146e Kartik Thakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
31 $options{-depth} ||= $options{-bpp} || 24;
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
32
e6e146e Kartik Thakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
33 $app = SDLx::App->new(%options);
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
34
35 my %ttfonts = (
4979eb1 Jeffrey T. Palmer perltidy
jtpalmer authored
36 'aircut3.ttf' => 0,
37 'electrohar.ttf' => 0,
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
38 );
39
40 my %sfonts = (
4979eb1 Jeffrey T. Palmer perltidy
jtpalmer authored
41 '24P_Arial_NeonYellow.png' => 0,
42 '24P_Copperplate_Blue.png' => 0,
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
43 );
44
45 my @fonts;
46
47 for ( reverse keys %ttfonts ) {
4979eb1 Jeffrey T. Palmer perltidy
jtpalmer authored
48 for $mode (qw/ -normal -bold -italic -underline /) {
49 if ( -e "data/$_" ) {
50 print STDERR "Loading $_\n";
51 $ttfonts{"$_$mode"} = SDL::Tool::Font->new(
52 $mode => 1,
53 -ttfont => "data/$_",
54 -size => 20,
55 -fg => $SDL::Color::black,
56 -bg => $SDL::Color::black
57 );
58 push @fonts, $ttfonts{"$_$mode"};
59 }
60 }
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
61 }
62
63 %ttfonts = reverse %ttfonts;
64
e6e146e Kartik Thakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
65 for ( reverse keys %sfonts ) {
4979eb1 Jeffrey T. Palmer perltidy
jtpalmer authored
66 if ( -e "data/$_" ) {
67 print STDERR "Loading $_\n";
68 $sfonts{$_} = SDL::Tool::Font->new( -sfont => "data/$_" );
69 push @fonts, $sfonts{$_};
70 }
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
71 }
72
73 %sfonts = reverse %sfonts;
74
75 sub DrawFonts {
4979eb1 Jeffrey T. Palmer perltidy
jtpalmer authored
76 $app->fill( 0, $SDL::Color::white );
77 my ( $x, $y ) = @_;
78 for my $font (@fonts) {
79 $font->print(
80 $app, $x, $y,
81 "SDLperl font test. ",
82 "This is " . ( $ttfonts{$font} || $sfonts{$font} )
83 );
84 $y += 40;
85 }
86 $app->flip();
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
87 }
88
e6e146e Kartik Thakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
89 DrawFonts( 10, 10 );
90
91 $app->loop(
4979eb1 Jeffrey T. Palmer perltidy
jtpalmer authored
92 { SDL_KEYDOWN() => sub {
93 my ($event) = @_;
94 $app->warp( $options{-width} / 2, $options{-height} / 2 )
95 if ( $event->key_sym() == SDLK_SPACE );
96 $app->fullscreen() if ( $event->key_sym() == SDLK_f );
97 exit(0) if ( $event->key_sym() == SDLK_ESCAPE );
98 },
99 SDL_QUIT() => sub {
100 exit(0);
101 }
102 }
e6e146e Kartik Thakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
103 );
5597ddb Daniel de Oliveira Mantovani files moved to this paste
mantovani authored
104
Something went wrong with that request. Please try again.