view release on metacpan or  search on metacpan

bin/pmarad  view on Meta::CPAN

our %key_inputs = (    # extended keys (mostly untested)
    410 => \&move_winch,
    331 => \&move_select,    # "0" maybe?

    260 => \&move_west,
    258 => \&move_south,
    259 => \&move_north,
    261 => \&move_east,

    262 => \&move_northwest,
    339 => \&move_northeast,
    360 => \&move_southwest,
    338 => \&move_southeast,
);

run();

sub init {
    # default is 1000 milliseconds, too long unless on a 300 baud line?
    $ENV{ESCDELAY} = 50 unless exists $ENV{ESCDELAY};

    # NOTE do not add "nodelay" without reviewing the getchar loop
    initscr;
    $SIG{WINCH} = 'IGNORE';    # KLUGE lock curses window size
    if ( $COLS < NEED_COLS or $LINES < NEED_ROWS ) {
        endwin;
        printf STDERR "pmarad: screen is too small (need %d,%d)\n", NEED_COLS,
          NEED_ROWS;
        exit 1;
    }
    raw;
    keypad(1);
    noecho;
    $app = newgame();
}

sub newgame {
    state $app;
    $app->{dirty} = 1;
    $app->{game}  = Game::Marad->new;
    $app->{state} = STATE_NORMAL;
    $app->{boardw} //= subwin( 9, 18, 0, 3 );
    $app->@{qw(cursy cursx)} = ( CURS_START_Y, CURS_START_X );
    return $app;
}

sub run {
    init() unless defined $app;
    while (1) {
        update($app);
      KEY:
        my ( $ch, $key ) = getchar;
        my $action;
        if ( defined $key ) {
            $action = $key_inputs{$key};
            goto KEY unless defined $action;
        } elsif ( defined $ch ) {
            $action = $ch_inputs{$ch};
            goto KEY unless defined $action;
        } else {
            # nodelay if set will probably need a napms here to avoid busy
            # looping through a getchar that then too quickly returns
            goto KEY;
        }
        goto KEY if $action->($app) == NEXT_KEY;
    }
}

sub move_west {
    my ($app) = @_;
    $app->{cursx} -= COLOFF;
    return NEXT_EVENT;
}

sub move_south {
    my ($app) = @_;
    $app->{cursy} += 1;
    return NEXT_EVENT;
}

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

sub move_east {
    my ($app) = @_;
    $app->{cursx} += COLOFF;
    return NEXT_EVENT;
}

# the checks on the diagonals are to prevent the cursor from "sliding"
# along a border; diagonals are only allowed where a proper diagonal
# can happen
sub move_northwest {
    my ($app) = @_;
    if ( $app->{cursy} > MINROW and $app->{cursx} > MINCOL ) {
        $app->{cursy} -= 1;
        $app->{cursx} -= COLOFF;
    }
    return NEXT_EVENT;
}

sub move_northeast {
    my ($app) = @_;
    if ( $app->{cursy} > MINROW and $app->{cursx} < MAXCOL ) {
        $app->{cursy} -= 1;
        $app->{cursx} += COLOFF;
    }
    return NEXT_EVENT;
}

sub move_southwest {
    my ($app) = @_;
    if ( $app->{cursy} < MAXROW and $app->{cursx} > MINCOL ) {
        $app->{cursy} += 1;
        $app->{cursx} -= COLOFF;
    }
    return NEXT_EVENT;
}