view release on metacpan or  search on metacpan

bin/pmarad  view on Meta::CPAN

    return NEXT_EVENT;
}

sub move_cancel {
    my ($app) = @_;
    if ( $app->{state} == STATE_SELECT ) {
        $app->@{qw(dirty state)} = ( 1, STATE_NORMAL );
        return NEXT_EVENT;
    } else {
        $app->{state} = STATE_NORMAL;
        return NEXT_KEY;
    }
}

sub move_quit {
    endwin;
    exit;
}

# pick a source square, or try a move with a destination square
sub move_select {
    my ($app) = @_;

    if ( $app->{state} == STATE_NORMAL ) {
        my ( $row, $col ) = $app->@{qw(cursy cursx)};
        my ( $y,   $x ) = ( $row + CURS_OFF_Y, int( ( $col + CURS_OFF_X ) / COLOFF ) );
        if ( $app->{game}->is_owner( $x, $y ) ) {
            $app->@{qw(state srcy srcx)} = ( STATE_SELECT, $row, $col );
            # NOTE Curses.pm helpfully returns an IV or a PV depending
            # on whether there are attributes already set or not
            my $chtype = inch $row, $col;
            addch $row, $col,
              A_BOLD | ( looks_like_number($chtype) ? $chtype : ord $chtype );
            move $row, $col;
        }
        return NEXT_KEY;

    } elsif ( $app->{state} == STATE_SELECT ) {
        my ( $r, $msg ) = $app->{game}->move(
            int( ( $app->{srcx} + CURS_OFF_X ) / COLOFF ),
            $app->{srcy} + CURS_OFF_Y,
            int( ( $app->{cursx} + CURS_OFF_X ) / COLOFF ),
            $app->{cursy} + CURS_OFF_Y,
        );
        if ( $r == 1 ) {
            $app->@{qw(dirty state)} = ( 1, STATE_NORMAL );
            return NEXT_EVENT;
        } else {
            # not a valid move. better luck next time?
            return NEXT_KEY;
        }
    }
}

sub move_winch {
    my ($app) = @_;
    $app->{dirty} = 1;
    return NEXT_EVENT;
}

sub update {
    my ($app) = @_;
    if ( $app->{dirty} ) {
        touchwin;
        move 0, 0;
        clrtobot;

        my $score = $app->{game}->score;
        if ( $score->[0] >= VICTORY ) {
            victory(1);
        } elsif ( $score->[1] >= VICTORY ) {
            victory(2);
        }

        my $game = $app->{game};
        my ( $board, $grid ) = ( $game->board, $app->{boardw} );
        $score = $game->score;

        addstring 7, 1,  sprintf "%X", $score->[0];
        addstring 7, 21, sprintf "%X", $score->[1];

        if ( $game->player == 0 ) {
            addstring 1, 1, sprintf "%d", $game->move_count;
            addstring 1, 21, ' ';
        } else {
            addstring 1, 1, ' ';
            addstring 1, 21, sprintf "%d", $game->move_count;
        }

        my $maxidx = $board->$#*;
        for my $row ( 0 .. $maxidx ) {
            for my $col ( 0 .. $maxidx ) {
                my $piece = $piecemap{ $board->[$row][$col] } // '?';
                if ( $piece eq '.' and ( $row == 4 xor $col == 4 ) ) {
                    # presumably colors might also help show the center
                    # square, but I'd have to enable those...
                    $piece = ',';
                } elsif ( $row == 4 and $col == 4 ) {
                    $piece = ord($piece) | A_REVERSE;
                }
                addch $grid, $row, $col * COLOFF, $piece;
            }
        }

        noutrefresh $grid;
        doupdate;
        $app->{dirty} = 0;
    }

    # maintain the cursor position, which things like window resizes
    # may like to fiddle with
    if ( $app->{cursx} < MINCOL ) {
        $app->{cursx} = MINCOL;
    } elsif ( $app->{cursx} > MAXCOL ) {
        $app->{cursx} = MAXCOL;
    }
    if ( $app->{cursy} < MINROW ) {
        $app->{cursy} = MINROW;
    } elsif ( $app->{cursy} > MAXROW ) {
        $app->{cursy} = MAXROW;
    }