Importing SDLPerl 2.2
[sdlgit/SDL_perl.git] / test / testcolor.sdlpl
CommitLineData
bfd90409 1#!/usr/bin/env perl
2#
3# testcolor.pl
4#
5# Copyright (C) 2005 David J. Goehrig <dgoehrig@cpan.org>
6#
7# ------------------------------------------------------------------------------
8#
9# This library is free software; you can redistribute it and/or
10# modify it under the terms of the GNU Lesser General Public
11# License as published by the Free Software Foundation; either
12# version 2.1 of the License, or (at your option) any later version.
13#
14# This library is distributed in the hope that it will be useful,
15# but WITHOUT ANY WARRANTY; without even the implied warranty of
16# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17# Lesser General Public License for more details.
18#
19# You should have received a copy of the GNU Lesser General Public
20# License along with this library; if not, write to the Free Software
21# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22#
23# ------------------------------------------------------------------------------
24#
25# Please feel free to send questions, suggestions or improvements to:
26#
27# David J. Goehrig
28# dgoehrig@cpan.org
29#
30
31use SDL;
32use SDL::App;
33use SDL::Event;
34
35use vars qw/ $app /;
36
37print STDERR <<USAGE;
38 Right click on any pixel to get its color values
39 Left click on any pixel to set its value to the last selected
40USAGE
41
42SDL::Init(SDL_INIT_ALL);
43
44$app = new SDL::App -width => 320, -height => 240, -depth => 8;
45
46my %colors = (
47 red => (new SDL::Color -r => 255, -g => 0, -b => 0 ),
48 green => (new SDL::Color -r => 0, -g => 255, -b => 0),
49 blue => (new SDL::Color -r => 0, -g => 0, -b => 255),
50 yellow => (new SDL::Color -r => 255, -g => 255, -b => 0),
51 purple => (new SDL::Color -r => 255, -g => 0, -b => 255),
52 white => (new SDL::Color -r => 255, -g => 255, -b => 255)
53);
54
55
56$x = 0; $y = 0;
57$rect = new SDL::Rect -x => $x, -y => $y,
58 -w => $app->width / scalar(keys %colors), -h => $app->height();
59
60print "Sorted colors:\n";
61
62for ( sort keys %colors ) {
63 print "$_ " . join (",",$colors{$_}->r(), $colors{$_}->g(),
64 $colors{$_}->b()) . "\n";
65}
66
67for ( sort keys %colors ) {
68 $rect->x($x);
69 $x += $rect->width();
70 $app->fill($rect,$colors{$_});
71}
72
73$app->sync();
74
75$last = new SDL::Color -r => 128, -g => 128, -b => 128;
76
77$app->sync();
78$app->loop( {
79 SDL_QUIT() => sub { exit(0); },
80 SDL_KEYDOWN() => sub { $app->fullscreen(); },
81 SDL_MOUSEBUTTONDOWN() => sub {
82 my $e = shift;
83 if ($e->button == 3) {
84 $last = $app->pixel($e->button_x(),$e->button_y());
85 print STDERR "X: ", $e->button_x(), " Y: ", $e->button_y(),
86 " R: ", $last->r(), " G: ", $last->g(),
87 " B: ", $last->b(), "\n";
88 } else {
89 $app->pixel($e->button_x(),$e->button_y(),$last);
90 }
91 },
92});