view release on metacpan or  search on metacpan

kezboard  view on Meta::CPAN

        my $fn      = $clicks->getEnclosedObjects( @mousexy, @mousexy )->[0];
        defined $fn and $fn->(@mousexy) and update();
    },
    SDL_QUIT() => sub { game_over() },
);

a_random_screen($pretitle);
a_random_screen($title);

setup_clicks();
$cards_played = ( $level - 1 ) * 10000;
next_level();
update();
$app->loop( \%events );
game_over();

########################################################################
#
# SUBROUTINES

sub a_random_screen ( $sprite, $fn = undef ) {
    my ( $done, $halfdone, $atmost, $event ) =
      ( 0, 0, 4, SDL::Event->new );

    my %events = (
        SDL_KEYUP() => sub ($e) {
            my $s = $e->key_sym;
            $done = 1
              if $s == SDLK_RETURN
              or $s == SDLK_ESCAPE
              or $s == SDLK_SPACE
              or $atmost-- <= 0;
        },
        # check for a full mouse cycle due to a stray "button up" event
        # when the app is started on OpenBSD 7.4
        SDL_MOUSEBUTTONDOWN() => sub { $halfdone           = 1 },
        SDL_MOUSEBUTTONUP()   => sub { $halfdone and $done = 1 },
    );

    put_sprite( 0, 0, $sprite );
    $fn->() if defined $fn;
    $app->sync;
    sleep $delay;

    while ( !$done and $event->wait ) {
        my $fn = $events{ $event->type };
        defined $fn and $fn->($event);
    }
}

# put any played cards back into the player's hand
sub clear_played () {
    if ( $deck->get('board')->@* ) {
        $deck->collect(qw(player board));
        return 1;
    }
}

sub collide_hero_bomb ( $ani, $obj ) {
    if ( $ani->[ID] == HERO ) {
        relocate( $ani, $obj->@[ XX, YY ] );
    } else {
        draw_cell( $ani->@[ XX, YY ], $blanki );
    }
    return MOVE_EOL;
}

sub collide_hero_goal ( $ani, $obj ) {
    if ( $ani->[ID] == HERO ) {
        # NOTE this messes up the occupy map; hopefully the EOL
        # resets things
        relocate( $ani, $obj->@[ XX, YY ] );
    } else {
        # goal moves onto hero: undraw where the goal is
        draw_cell( $ani->@[ XX, YY ], $blanki );
    }
    $level++;
    return MOVE_EOL;
}

sub collide_hero_scram ( $ani, $obj ) {
    if ( $ani->[ID] == HERO ) {
        $ani->@[ IX, IY ] = random_inertia(3);
        relocate( $ani, $obj->@[ XX, YY ] );
        $obj->[DEAD] = 1;
        return MOVE_OK;
    } else {
        $obj->@[ IX, IY ] = random_inertia(3);
        draw_cell( $ani->@[ XX, YY ], $blanki );
        unoccupy( $ani->@[ XX, YY ] );
        $ani->[DEAD] = 1;
        return MOVE_NOP;
    }
}

sub collide_gate_scram ( $ani, $obj ) {
    if ( $ani->[ID] == GOAL ) {
        $ani->@[ IX, IY ] = random_inertia(3);
        relocate( $ani, $obj->@[ XX, YY ] );
        $obj->[DEAD] = 1;
        return MOVE_OK;
    } else {
        $obj->@[ IX, IY ] = random_inertia(3);
        draw_cell( $ani->@[ XX, YY ], $blanki );
        unoccupy( $ani->@[ XX, YY ] );
        $ani->[DEAD] = 1;
        return MOVE_NOP;
    }
}

sub collide_scram ( $ani, $obj ) {
    for my $scram ( $ani, $obj ) {
        $scram->@[ IX, IY ] = random_inertia(3);
    }
    return MOVE_NOP;
}

# fill up the player's hand, with various complications
sub deal_cards () {
    my $avail = $deck->get('draw')->@*;
    if ( $avail < HANDSIZE ) {
        $deck->collect(qw{draw discard});
        $deck->shuffle('draw');
    }
    my $inhand = $deck->get('player')->@*;
    $deck->deal( draw => 'player', 0 ) while $inhand++ < HANDSIZE;
}

# taxicab distance, but accounts for the wrap-around quirk
sub distance ( $x1, $y1, $x2, $y2 ) {
    my $dx = abs( $x1 - $x2 );
    $dx = $boardsz[XX] - $dx if $dx > $boardsz[XX] / 2;
    my $dy = abs( $y1 - $y2 );
    $dy = $boardsz[YY] - $dy if $dy > $boardsz[YY] / 2;
    return $dx + $dy;
}

sub draw_animate ( $ani, $inplace = 0 ) {
    my $n       = $ani->[ORIENT];
    my $sprites = $ani->[SPRITE];
    $n = 0 if $n >= $sprites->@*;
    draw_cell( $ani->@[ XX, YY ], $blanki ) if $inplace;
    put_sprite(
        $gridxy[XX] + $ani->[XX] * $cellsz,
        $gridxy[YY] + $ani->[YY] * $cellsz,
        $sprites->[$n]
    );
}

sub end_turn () {
    return unless $deck->get('board')->@* == TOPLAY;
    $state = STATE_BRUN;
    return 1;
}

# only status 0 if they "win"
sub game_over ( $status = 1, $message = '' ) {
    say $message if length $message;
    exit $status;

kezboard  view on Meta::CPAN

    @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;
    }
    return @inertia;
}

sub random_orient () { int rand @headings }

sub random_point () {
    int rand( $boardsz[XX] ), int rand( $boardsz[YY] );
}

sub random_point_unique () {
    my @point;
    do {
        @point = ( int rand( $boardsz[XX] ), int rand( $boardsz[YY] ) );
    } while ( defined occupied(@point) );
    return @point;
}

sub take_mulligan () {
    unless ($mulligan) {
        $cards_played += 1;    # TODO this penalty might be higher?
        $deck->collect(qw{draw player board discard});
        $deck->shuffle('draw');
        deal_cards();
        $mulligan = 1;
        return 1;
    }
}

sub try_move ( $ani, $nx, $ny ) {
    my $other = occupied( $nx, $ny );
    if ( !defined $other ) {
        relocate( $ani, $nx, $ny );
        return MOVE_OK;
    }
    my $fn = $collisions[ $ani->[ID] ][ $other->[ID] ];
    die "no mapping ", $ani->[ID], " ", $other->[ID] unless defined $fn;
    return $fn->( $ani, $other );
}

sub turn_left ($ani) {
    $ani->[ORIENT] = ( $ani->[ORIENT] + 1 ) % @headings;
}

sub turn_right ($ani) {
    $ani->[ORIENT] = ( $ani->[ORIENT] - 1 ) % @headings;
}

sub turn_around ($ani) {
    $ani->[ORIENT] = ( $ani->[ORIENT] + 2 ) % @headings;
}

sub update {
    put_sprite( 0, 0, $bgi );
    put_sprite( @gridxy, $gridi );

    my $title = q{K E Z B O A R D  A L P H A  -  L} . $level;
    $font->print( $app, 16, 15, $title );

    $font->print( $app, 16, $sheight - 47, $description );

    my ( $pcard, $bcard ) = map $deck->get($_), qw(player board);
    my @xy = @cardxy;
    for my $i ( 0 .. 4 ) {
        if ( $state == STATE_PICK and defined $pcard->[$i] ) {
            put_sprite( @xy, $pcard->[$i][CARD_SPRITE] );
        }
        if ( $i < TOPLAY and defined $bcard->[$i] ) {
            put_sprite( $playxy[XX], $xy[YY], $bcard->[$i][CARD_SPRITE] );
        }
        $xy[YY] += 4 * $cellsz;
    }

    if ( $state == STATE_PICK ) {
        put_sprite( $swidth - 144, 12,            $mulgi ) unless $mulligan;
        put_sprite( $swidth - 288, $sheight - 48, $nopei ) if $bcard->@*;
        put_sprite( $swidth - 144, $sheight - 48, $okayi )
          if $bcard->@* == TOPLAY;
    }

    draw_animate($_) for @animates;
    $app->sync;

    # KLUGE the "physics engine" (such as it is) probably shouldn't be
    # wrapped up with the GUI updates like it is here, but I want to
    # ship a prototype sometime this year
    goto &world_update if $state == STATE_BRUN;
}

# handle applying cards and moving stuff around, interleaved with calls
# to the update function, KLUGE
sub world_update {
    if ( $deck->get('board')->@* <= 0 ) {