Skip to content
This repository
Newer
Older
100644 103 lines (84 sloc) 2.139 kb
5597ddbe » mantovani
2010-03-22 files moved to this paste
1 #!/usr/bin/env perl
2
3 use strict;
4 use SDL;
c3d720d5 » kthakore
2010-06-22 Cleaned up all of SDL::App to SDLx::App
5 use SDLx::App;
5597ddbe » mantovani
2010-03-22 files moved to this paste
6 use SDL::Event;
7 use SDL::Tool::Font;
8 use SDL::Color;
9
e6e146ee » kthakore
2010-07-20 Did perl tidy. Stole rc from padre. bricas++
10 my ( %options, $app, $mode );
5597ddbe » mantovani
2010-03-22 files moved to this paste
11
12 die "usage: $0 [-hw] [-fullscreen] [-width 640] [-height 480] [-bpp 24]\n"
4979eb13 » jtpalmer
2010-07-30 perltidy
13 if ( SDL::in( $ARGV[0], qw/ -h -? --help/ ) );
5597ddbe » mantovani
2010-03-22 files moved to this paste
14
15 chdir 'test' if -d 'test';
16 die "$0 must be run in the SDL_perl/test/ directory!"
4979eb13 » jtpalmer
2010-07-30 perltidy
17 unless ( -d 'data' );
5597ddbe » mantovani
2010-03-22 files moved to this paste
18
e6e146ee » kthakore
2010-07-20 Did perl tidy. Stole rc from padre. bricas++
19 for ( 0 .. @ARGV - 1 ) {
4979eb13 » jtpalmer
2010-07-30 perltidy
20 $options{ $ARGV[$_] } = $ARGV[ $_ + 1 ] || 1;
5597ddbe » mantovani
2010-03-22 files moved to this paste
21 }
22
23 $options{-flags} = SDL_SWSURFACE;
e6e146ee » kthakore
2010-07-20 Did perl tidy. Stole rc from padre. bricas++
24 $options{-flags} |= SDL_HWPALETTE if ( $options{-hw} );
5597ddbe » mantovani
2010-03-22 files moved to this paste
25 $options{-flags} |= SDL_FULLSCREEN if ( $options{-fullscreen} );
26
27 $options{-title} = $0;
28
29 $options{-width} ||= 800;
30 $options{-height} ||= 600;
e6e146ee » kthakore
2010-07-20 Did perl tidy. Stole rc from padre. bricas++
31 $options{-depth} ||= $options{-bpp} || 24;
5597ddbe » mantovani
2010-03-22 files moved to this paste
32
e6e146ee » kthakore
2010-07-20 Did perl tidy. Stole rc from padre. bricas++
33 $app = SDLx::App->new(%options);
5597ddbe » mantovani
2010-03-22 files moved to this paste
34
35 my %ttfonts = (
4979eb13 » jtpalmer
2010-07-30 perltidy
36 'aircut3.ttf' => 0,
37 'electrohar.ttf' => 0,
5597ddbe » mantovani
2010-03-22 files moved to this paste
38 );
39
40 my %sfonts = (
4979eb13 » jtpalmer
2010-07-30 perltidy
41 '24P_Arial_NeonYellow.png' => 0,
42 '24P_Copperplate_Blue.png' => 0,
5597ddbe » mantovani
2010-03-22 files moved to this paste
43 );
44
45 my @fonts;
46
47 for ( reverse keys %ttfonts ) {
4979eb13 » jtpalmer
2010-07-30 perltidy
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 }
5597ddbe » mantovani
2010-03-22 files moved to this paste
61 }
62
63 %ttfonts = reverse %ttfonts;
64
e6e146ee » kthakore
2010-07-20 Did perl tidy. Stole rc from padre. bricas++
65 for ( reverse keys %sfonts ) {
4979eb13 » jtpalmer
2010-07-30 perltidy
66 if ( -e "data/$_" ) {
67 print STDERR "Loading $_\n";
68 $sfonts{$_} = SDL::Tool::Font->new( -sfont => "data/$_" );
69 push @fonts, $sfonts{$_};
70 }
5597ddbe » mantovani
2010-03-22 files moved to this paste
71 }
72
73 %sfonts = reverse %sfonts;
74
75 sub DrawFonts {
4979eb13 » jtpalmer
2010-07-30 perltidy
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();
5597ddbe » mantovani
2010-03-22 files moved to this paste
87 }
88
e6e146ee » kthakore
2010-07-20 Did perl tidy. Stole rc from padre. bricas++
89 DrawFonts( 10, 10 );
90
91 $app->loop(
4979eb13 » jtpalmer
2010-07-30 perltidy
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 }
e6e146ee » kthakore
2010-07-20 Did perl tidy. Stole rc from padre. bricas++
103 );
5597ddbe » mantovani
2010-03-22 files moved to this paste
104
Something went wrong with that request. Please try again.