Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 105 lines (84 sloc) 2.139 kB
5597ddb @mantovani files moved to this paste
mantovani authored
1 #!/usr/bin/env perl
2
3 use strict;
4 use SDL;
c3d720d @kthakore Cleaned up all of SDL::App to SDLx::App
kthakore authored
5 use SDLx::App;
5597ddb @mantovani files moved to this paste
mantovani authored
6 use SDL::Event;
7 use SDL::Tool::Font;
8 use SDL::Color;
9
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
10 my ( %options, $app, $mode );
5597ddb @mantovani files moved to this paste
mantovani authored
11
12 die "usage: $0 [-hw] [-fullscreen] [-width 640] [-height 480] [-bpp 24]\n"
4979eb1 @jtpalmer perltidy
jtpalmer authored
13 if ( SDL::in( $ARGV[0], qw/ -h -? --help/ ) );
5597ddb @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 @jtpalmer perltidy
jtpalmer authored
17 unless ( -d 'data' );
5597ddb @mantovani files moved to this paste
mantovani authored
18
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
19 for ( 0 .. @ARGV - 1 ) {
4979eb1 @jtpalmer perltidy
jtpalmer authored
20 $options{ $ARGV[$_] } = $ARGV[ $_ + 1 ] || 1;
5597ddb @mantovani files moved to this paste
mantovani authored
21 }
22
23 $options{-flags} = SDL_SWSURFACE;
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
24 $options{-flags} |= SDL_HWPALETTE if ( $options{-hw} );
5597ddb @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 @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
31 $options{-depth} ||= $options{-bpp} || 24;
5597ddb @mantovani files moved to this paste
mantovani authored
32
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
33 $app = SDLx::App->new(%options);
5597ddb @mantovani files moved to this paste
mantovani authored
34
35 my %ttfonts = (
4979eb1 @jtpalmer perltidy
jtpalmer authored
36 'aircut3.ttf' => 0,
37 'electrohar.ttf' => 0,
5597ddb @mantovani files moved to this paste
mantovani authored
38 );
39
40 my %sfonts = (
4979eb1 @jtpalmer perltidy
jtpalmer authored
41 '24P_Arial_NeonYellow.png' => 0,
42 '24P_Copperplate_Blue.png' => 0,
5597ddb @mantovani files moved to this paste
mantovani authored
43 );
44
45 my @fonts;
46
47 for ( reverse keys %ttfonts ) {
4979eb1 @jtpalmer 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 @mantovani files moved to this paste
mantovani authored
61 }
62
63 %ttfonts = reverse %ttfonts;
64
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
65 for ( reverse keys %sfonts ) {
4979eb1 @jtpalmer 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 @mantovani files moved to this paste
mantovani authored
71 }
72
73 %sfonts = reverse %sfonts;
74
75 sub DrawFonts {
4979eb1 @jtpalmer 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 @mantovani files moved to this paste
mantovani authored
87 }
88
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
89 DrawFonts( 10, 10 );
90
91 $app->loop(
4979eb1 @jtpalmer 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 @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored
103 );
5597ddb @mantovani files moved to this paste
mantovani authored
104
Something went wrong with that request. Please try again.