1#!/usr/bin/perl 2 3use strict; 4use warnings; 5use Time::HiRes; 6 7use SDL; 8use SDL::Event; 9use SDL::Events; 10use SDL::Rect; 11use SDL::Surface; 12use SDL::Video; 13 14use SDLx::SFont; 15use SDLx::Surface; 16use SDLx::Sprite; 17 18use SDLx::LayerManager; 19use SDLx::Layer; 20use SDLx::FPS; 21 22SDL::init(SDL_INIT_VIDEO); 23my $display = SDL::Video::set_video_mode( 800, 600, 32, SDL_HWSURFACE | SDL_HWACCEL ); 24my $layers = SDLx::LayerManager->new(); 25my $event = SDL::Event->new(); 26my $loop = 1; 27my $last_click = Time::HiRes::time; 28my $fps = SDLx::FPS->new( fps => 60 ); 29my @selected_cards = (); 30my $left_mouse_down = 0; 31my @rects = (); 32 33init_surfaces(); 34$layers->blit($display); 35SDL::Video::update_rect( $display, 0, 0, 0, 0 ); 36game(); 37 38sub event_loop { 39 my $handler = shift; 40 41 SDL::Events::pump_events(); 42 while ( SDL::Events::poll_event($event) ) { 43 $left_mouse_down = 1 if $event->type == SDL_MOUSEBUTTONDOWN && $event->button_button == SDL_BUTTON_LEFT; 44 $left_mouse_down = 0 if $event->type == SDL_MOUSEBUTTONUP && $event->button_button == SDL_BUTTON_LEFT; 45 46 $handler->{on_quit}->() 47 if defined $handler->{on_quit} 48 && ( $event->type == SDL_QUIT || ( $event->type == SDL_KEYDOWN && $event->key_sym == SDLK_ESCAPE ) ); 49 $handler->{on_drop}->() if defined $handler->{on_drop} && $event->type == SDL_MOUSEBUTTONUP; 50 $handler->{on_click}->() 51 if defined $handler->{on_click} 52 && $event->type == SDL_MOUSEBUTTONDOWN 53 && Time::HiRes::time- $last_click >= 0.3; 54 55 $last_click = Time::HiRes::time if $event->type == SDL_MOUSEBUTTONDOWN; 56 } 57} 58 59sub game { 60 my @selected_cards = (); 61 my $x = 0; 62 my $y = 0; 63 my $handler = { 64 on_quit => sub { 65 $loop = 0; 66 }, 67 on_drop => sub { 68 if ( scalar @selected_cards ) { 69 my $layer = $layers->by_position( $event->button_x, $event->button_y ); 70 71 if ( defined $layer ) { 72 my @behind = @{ $layer->behind }; 73 if ( scalar @behind == 1 74 && $behind[0]->data->{id} =~ m/^\w{2}$/ ) 75 { 76 $layer->foreground; 77 $layers->detach_xy( $behind[0]->pos->x + 8, $behind[0]->pos->y + 8 ); 78 printf( "to %s\n", $behind[0]->data->{id} ); 79 } else { 80 $layers->detach_back; 81 } 82 } else { 83 $layers->detach_back; 84 } 85 } 86 @selected_cards = (); 87 }, 88 on_click => sub { 89 unless ( scalar @selected_cards ) { 90 my $layer = $layers->by_position( $event->button_x, $event->button_y ); 91 92 if ( defined $layer 93 && $layer->data->{id} =~ m/^(white|black)$/ ) 94 { 95 @selected_cards = ($layer); 96 $layers->attach( $layer, $event->button_x, $event->button_y ); 97 } 98 } 99 }, 100 }; 101 102 while ($loop) { 103 event_loop($handler); 104 @rects = @{ $layers->blit($display) }; 105 SDL::Video::update_rect( $display, 0, 0, 0, 0 ) if scalar @rects; 106 $fps->delay; 107 } 108} 109 110sub init_surfaces { 111 my $white_surface = SDL::Image::load('test/data/wood_light.png'); 112 my $black_surface = SDL::Image::load('test/data/wood_dark.png'); 113 my $white_button = SDL::Image::load('test/data/button_light.png'); 114 my $black_button = SDL::Image::load('test/data/button_dark.png'); 115 for my $x ( 0 .. 7 ) { 116 for my $y ( 0 .. 7 ) { 117 $layers->add( 118 SDLx::Layer->new( 119 ( $x + $y ) & 1 ? $white_surface : $black_surface, 120 144 + 64 * $x, 121 44 + 64 * $y, 122 { id => chr( ord('A') + $x ) . ( $y + 1 ) } 123 ) 124 ); 125 } 126 } 127 128 for my $x ( 0 .. 7 ) { 129 for my $y ( 0 .. 7 ) { 130 if ( $y < 2 ) { 131 $layers->add( SDLx::Layer->new( $white_button, 152 + 64 * $x, 52 + 64 * $y, { id => 'white' } ) ); 132 } 133 134 if ( $y > 5 ) { 135 $layers->add( SDLx::Layer->new( $black_button, 152 + 64 * $x, 52 + 64 * $y, { id => 'black' } ) ); 136 } 137 } 138 } 139} 140