Game-Kezboard

 view release on metacpan or  search on metacpan

kezboard  view on Meta::CPAN

    $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 ) {
        $state = STATE_PICK;
        deal_cards();
        describe_animate( $animates[HERO] );
        goto &update;
    }

    $cards_played++;
    my ( $card, undef ) = $deck->deal( board => 'discard' );
    $card->[CARD_FUNC]->( $animates[HERO] );

    # redraw player and update their description
    describe_animate( $animates[HERO] );
    put_sprite( 0, $sheight - 64, $dbi );
    $font->print( $app, 16, $sheight - 48, $description );
    draw_animate( $animates[HERO], 1 );
    $app->sync;
    sleep $delay;

    for my $ani (@animates) {
        next if $ani->[IX] == 0 and $ani->[IY] == 0;



( run in 0.971 second using v1.01-cache-2.11-cpan-d7f47b0818f )