view release on metacpan or  search on metacpan

kezboard  view on Meta::CPAN

use SDL;
use SDL::App;
use SDL::Event;
use SDL::Rect;
use SDL::Surface;
use SDL::Tool::Font;
use Time::HiRes 'sleep';

sub MAX_LEVEL () { 5 }

my $mulligan;

GetOptions(
    'delay=f'  => \my $delay,
    'help|h|?' => sub {
        print STDERR <<'EOH';
Usage: kezboard [--delay=f] [--level=i] [--no-mulligan] [--seed=i]
                [--prefix=dir]
EOH
        exit(64);
    },
    'level=i'   => \my $level,
    'mulligan!' => sub { $mulligan = $_[1] ? 0 : 1 },
    'prefix=s'  => \my $prefix,
    'seed=i'    => sub { srand $_[1] },
) or exit 1;

if ( !defined $level ) {
    $level = 1;
} else {
    die "kezboard: invalid starting level '$level'\n"
      if $level < 1
      or $level > 1 + MAX_LEVEL;
}
# seconds to delay when "animating" moves
$delay = 0.5 if !defined $delay or $delay <= 0.0;
# directory that contains the font/... and image/... files
$prefix //= dist_dir('Game-Kezboard');

sub CARD_NAME ()   { 0 }
sub CARD_FUNC ()   { 1 }
sub CARD_SPRITE () { 2 }

# larger values may require rejiggering the display and clicks
# handling code
sub HANDSIZE () { 5 }
sub TOPLAY ()   { 3 }

sub MOVE_OK ()  { 0 }
sub MOVE_EOL () { 1 }    # end of level (player got to goal, etc)
sub MOVE_NOP () { 2 }    # a move that should not cause delays

# game state - picking cards, or are the cards being run?
sub STATE_PICK () { 0 }
sub STATE_BRUN () { 1 }

sub HERO () { 0 }    # where in @animates the player lives (also ID)
sub GOAL () { 1 }

sub SCRAM () { 2 }    # animate IDs
sub BOMB ()  { 3 }

sub XX ()     { 0 }    # points, and @animates index slots
sub YY ()     { 1 }
sub IX ()     { 2 }    # animate inertia
sub IY ()     { 3 }
sub ORIENT () { 4 }    # animate orientation (if any)
sub SPRITE () { 5 }    # array for sprite based on orientation
sub ID ()     { 6 }
sub NAME ()   { 7 }
sub DEAD ()   { 8 }

my $cards_played = ~0;    # score (lower is better)

my @collisions;
$collisions[HERO][GOAL]  = \&collide_hero_goal;
$collisions[HERO][SCRAM] = \&collide_hero_scram;
$collisions[HERO][BOMB]  = \&collide_hero_bomb;
$collisions[GOAL][HERO]  = \&collide_hero_goal;
$collisions[GOAL][SCRAM] = \&collide_gate_scram;

my $clicks;               # quadtree foo

my @headings = (
    [ 1,  0 ],            # x,y vector
    [ 0,  -1 ],
    [ -1, 0 ],
    [ 0,  1 ],
);

my @boardsz = ( 20, 20 );
my @occupy;    # where animates are (collision detection)

my $swidth  = 1024;           # SDL window dimensions
my $sheight = 768;
my $cellsz  = 32;             # how big a grid cell is
my $cardsz  = 64;             # how big a card is (roughly)
my $cpad    = 32;             # padding around the cards for clicks
my @cardxy  = ( 64,  96 );    # cards to put into play
my @gridxy  = ( 192, 64 );    # where the grid starts
my @playxy  = ( 896, 96 );    # played cards (and some buttons)

my $state;

my $app = SDL::App->new(
    -w          => $swidth,
    -h          => $sheight,
    -resizeable => 0,
    -title      => 'Kezboard Alpha',
);

# there are better fonts, but this one won on disk space
my $fontsz = 32;
my $font   = SDL::Tool::Font->new(
    -ttfont => catfile( $prefix, qw[font Ac437_EverexME_5x8.ttf] ),
    -size   => $fontsz,
    -fg     => $SDL::Color::white,
    -bg     => $SDL::Color::black,
);
my $description;    # shows details for something, usually the player
my $max_desc_len = 21;

my $bgi = SDL::Surface->new(
    -name => catfile( $prefix, qw[image starfield.png] ) );
my $dbi = SDL::Surface->new(
    -name => catfile( $prefix, qw[image descbg.png] ) );
my $blanki = SDL::Surface->new(
    -name => catfile( $prefix, qw[image blank.png] ) );
my $bombi = SDL::Surface->new(
    -name => catfile( $prefix, qw[image bomba.png] ) );
my $casti = SDL::Surface->new(
    -name => catfile( $prefix, qw[image castle.png] ) );
my $gridi =
  SDL::Surface->new(
    -name => catfile( $prefix, qw[image grid.png] ) );
my $mulgi =
  SDL::Surface->new(
    -name => catfile( $prefix, qw[image mulligan.png] ) );

kezboard  view on Meta::CPAN

    $ani->[IX] += $head->[XX];
    $ani->[IY] += $head->[YY];
}

sub move_backwards ($ani) {
    my $head = $headings[ $ani->[ORIENT] % @headings ];
    $ani->[IX] -= $head->[XX];
    $ani->[IY] -= $head->[YY];
}

# it was easy to implement, so why not?
sub move_nop ($ani) { }

# generate the next game level (or not)
sub next_level () {
    if ( $level > MAX_LEVEL ) {
        a_random_screen($victor);
        a_random_screen(
            $score,
            sub {
                $font->print( $app, 256, $sheight / 2, $cards_played );
            }
        );
        game_over( 0, $cards_played );
    }

    @animates = @occupy = ();

    # this could be made more difficult by ensuring the inertia of the
    # goal (if any) is directed away from the player, but that's harder
    # to calculate
    my @start = random_point();
    my @goal;
    do {
        @goal = random_point();
    } while ( distance( @start, @goal ) < 11 );

    $animates[HERO] =
      make_animate( HERO, 'You', @start, random_orient(), \@faces );
    $animates[GOAL] = make_animate( GOAL, 'Goal', @goal, 0, [$casti] );

    place_animate($_) for @animates;

    if ( 2 <= $level <= 3 ) {
        $animates[GOAL]->@[ IX, IY ] = random_inertia(3);
    }
    if ( $level == 3 or $level == 5 ) {
        my $n = 37;
        $n = 29 if $level == 5;
        for ( 1 .. $n ) {
            push @animates,
              make_animate( SCRAM, '??', random_point_unique(), 0, [$scrami] );
            place_animate( $animates[-1] );
        }
    }
    if ( $level >= 4 ) {
        my $n = 29;
        $n = 17 if $level == 5;
        for ( 1 .. $n ) {
            push @animates,
              make_animate( BOMB, 'Bomb', random_point_unique(), 0, [$bombi] );
            place_animate( $animates[-1] );
        }
    }

    # NOTE you could instead first collect everything and shuffle here
    # so that a new level (or a restart) starts from a clean deck
    $deck->collect( 'discard', qw(board player) );
    deal_cards();
    describe_animate( $animates[HERO] );
    $state = STATE_PICK;
}

sub occupied ( $x, $y ) { $occupy[$y][$x] }
sub unoccupy ( $x, $y ) { undef $occupy[$y][$x] }

sub place_animate ($ani) {
    $occupy[ $ani->[YY] ][ $ani->[XX] ] = $ani;
}

sub draw_cell ( $i, $j, $sprite ) {
    my @xy = @gridxy;
    put_sprite( $xy[XX] + $i * $cellsz, $xy[YY] + $j * $cellsz, $sprite );
}

sub relocate ( $ani, $x, $y ) {
    undef $occupy[ $ani->[YY] ][ $ani->[XX] ];
    draw_cell( $ani->@[ XX, YY ], $blanki );
    ( $ani->[XX], $ani->[YY] ) = ( $x, $y );
    draw_animate($ani);
    $occupy[$y][$x] = $ani;
}

# try to put a card from the player's hand to the bottom of the board
# (cards are applied from top to bottom)
sub play_card ($index) {
    return if $deck->get('board')->@* == TOPLAY;
    eval { $deck->deal( player => board => $index, 0 ); 1 }
}

sub unplay_card ($index) {
    return if $deck->get('board')->@* == 0;
    eval { $deck->deal( board => player => $index, 0 ); 1 }
}

# this may need a stack trace (confess) if ->width on undef is attempted
sub put_sprite ( $x, $y, $sprite ) {
    my $dest = SDL::Rect->new(
        -x      => $x,
        -y      => $y,
        -width  => $sprite->width,
        -height => $sprite->height,
    );
    $sprite->blit( NULL, $app, $dest );
}

sub random_inertia ($max) {
    my @inertia = ( 0, 0 );
    my $half    = int( $max / 2 );
    while ( $inertia[XX] == 0 and $inertia[YY] == 0 ) {
        @inertia = map { $_ = int( rand $max ) - $half } 1 .. 2;