Skip to content
Newer
Older
100644 68 lines (55 sloc) 1.6 KB
5597ddb @mantovani files moved to this paste
mantovani authored Mar 22, 2010
1 #!/usr/bin/env perl
2 #
3
4 use SDL;
c3d720d @kthakore Cleaned up all of SDL::App to SDLx::App
kthakore authored Jun 22, 2010
5 use SDLx::App;
5597ddb @mantovani files moved to this paste
mantovani authored Mar 22, 2010
6 use SDL::Event;
7
8 use vars qw/ $app /;
9
10 print STDERR <<USAGE;
11 Right click on any pixel to get its color values
12 Left click on any pixel to set its value to the last selected
13 USAGE
14
c3d720d @kthakore Cleaned up all of SDL::App to SDLx::App
kthakore authored Jun 22, 2010
15 $app = SDLx::App->new( -width => 320, -height => 240, -depth => 8 );
5597ddb @mantovani files moved to this paste
mantovani authored Mar 22, 2010
16
17 my %colors = (
4979eb1 @jtpalmer perltidy
jtpalmer authored Jul 30, 2010
18 red => ( new SDL::Color-r => 255, -g => 0, -b => 0 ),
19 green => ( new SDL::Color-r => 0, -g => 255, -b => 0 ),
20 blue => ( new SDL::Color-r => 0, -g => 0, -b => 255 ),
21 yellow => ( new SDL::Color-r => 255, -g => 255, -b => 0 ),
22 purple => ( new SDL::Color-r => 255, -g => 0, -b => 255 ),
23 white => ( new SDL::Color-r => 255, -g => 255, -b => 255 )
5597ddb @mantovani files moved to this paste
mantovani authored Mar 22, 2010
24 );
25
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored Jul 20, 2010
26 $x = 0;
27 $y = 0;
28 $rect = SDL::Rect->new(
4979eb1 @jtpalmer perltidy
jtpalmer authored Jul 31, 2010
29 -x => $x,
30 -y => $y,
31 -w => $app->width / scalar( keys %colors ),
32 -h => $app->height()
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored Jul 20, 2010
33 );
5597ddb @mantovani files moved to this paste
mantovani authored Mar 22, 2010
34
35 print "Sorted colors:\n";
36
37 for ( sort keys %colors ) {
4979eb1 @jtpalmer perltidy
jtpalmer authored Jul 31, 2010
38 print "$_ " . join( ",", $colors{$_}->r(), $colors{$_}->g(), $colors{$_}->b() ) . "\n";
5597ddb @mantovani files moved to this paste
mantovani authored Mar 22, 2010
39 }
40
41 for ( sort keys %colors ) {
4979eb1 @jtpalmer perltidy
jtpalmer authored Jul 31, 2010
42 $rect->x($x);
43 $x += $rect->width();
44 $app->fill( $rect, $colors{$_} );
5597ddb @mantovani files moved to this paste
mantovani authored Mar 22, 2010
45 }
46
47 $app->sync();
48
b127760 @bricas fix as many obvious indirect object notation infractions as i can find.
bricas authored May 3, 2010
49 $last = SDL::Color->new( -r => 128, -g => 128, -b => 128 );
5597ddb @mantovani files moved to this paste
mantovani authored Mar 22, 2010
50
51 $app->sync();
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored Jul 20, 2010
52 $app->loop(
4979eb1 @jtpalmer perltidy
jtpalmer authored Jul 31, 2010
53 { SDL_QUIT() => sub { exit(0); },
54 SDL_KEYDOWN() => sub { $app->fullscreen(); },
55 SDL_MOUSEBUTTONDOWN() => sub {
56 my $e = shift;
57 if ( $e->button == 3 ) {
58 $last = $app->pixel( $e->button_x(), $e->button_y() );
59 print STDERR "X: ", $e->button_x(), " Y: ", $e->button_y(),
60 " R: ", $last->r(), " G: ", $last->g(),
61 " B: ", $last->b(), "\n";
62 } else {
63 $app->pixel( $e->button_x(), $e->button_y(), $last );
64 }
65 },
66 }
e6e146e @kthakore Did perl tidy. Stole rc from padre. bricas++
kthakore authored Jul 20, 2010
67 );
Something went wrong with that request. Please try again.