NetHack::Menu - interact with NetHack's menus

    use NetHack::Menu;
    my $menu = NetHack::Menu->new(vt => $term_vt102);

    # compile all pages of the menu
    until ($menu->at_end) {
        $term_vt102->process($nh->send_and_recv($menu->next));
    }

    # we want to stuff all blessed items into our bag
    $menu->select(sub { /blessed/ });

    # but we don't want things that will make our bag explode
    $menu->deselect(sub { /cancell|bag.*(holding|tricks)/ });

    $term_vt102->process($nh->send_and_recv($menu->commit));

    perldoc NetHack::Menu

#!perl
package NetHack::Menu;
use Moose;
use Moose::Util::TypeConstraints;

has vt => (
    is       => 'rw',
    isa      => 'Term::VT102',
    required => 1,
    handles  => ['row_plaintext', 'rows'],
);

has page_number => (
    is      => 'rw',
    isa     => 'Int',
);

has page_count => (
    is      => 'rw',
    isa     => 'Int',
);

has pages => (
    is      => 'rw',
    isa     => 'ArrayRef[ArrayRef]',
    default => sub { [] },
);

enum 'NetHackMenuSelectCount' => qw(single multi);
has select_count => (
    is      => 'rw',
    isa     => 'NetHackMenuSelectCount',
    default => 'multi',
);

has cache => (
    is      => 'rw',
    isa     => 'ArrayRef[ArrayRef[Str]]',
    default => sub { [] },
);

has noselect_x => (
    is      => 'rw',
    isa     => 'ArrayRef[Int]',
    default => sub { [] },
);

sub has_menu {
    my $self = shift;

    for (0 .. $self->rows) {
        if (($self->row_plaintext($_)||'') =~ /\((end|(\d+) of (\d+))\)\s*$/) {

            my ($current, $max) = ($2, $3);
            ($current, $max) = (1, 1) if ($1||'') eq 'end';

            # this may happen if someone is trying to screw with us and gives
            # us a page number or page count of 0
            next unless $current && $max;

            return 1;
        }
    }
    return 0;
}

sub at_end {
    my $self = shift;

    for (0 .. $self->rows) {
        if (($self->row_plaintext($_)||'') =~ /^(.*)\((end|(\d+) of (\d+))\)\s*$/) {
            my ($current, $max) = ($3, $4);
            ($current, $max) = (1, 1) if ($2||'') eq 'end';

            # this may happen if someone is trying to screw with us and gives
            # us a page number or page count of 0
            next unless $current && $max;

            $self->page_number($current);
            $self->page_count($max);
            $self->parse_current_page(length($1), $_);
            last;
        }
    }

    defined($self->page_number)
        or Carp::croak "Unable to parse a menu.";

    for (1 .. $self->page_count) {
        if (!defined($self->pages->[$_])) {
            return 0;
        }
    }

    return 1;
}

sub parse_current_page {
    my $self      = shift;
    my $start_col = shift;
    my $end_row   = shift;

    # have we already parsed this one?
    return if defined $self->pages->[ $self->page_number ];
    my $page = $self->pages->[ $self->page_number ] ||= [];

    # extra space is for #enhance
    my $re = qr/^(?:.{$start_col})(.)  ?([-+#]) (.*?)\s*$/;
    for (0 .. $end_row - 1) {
        next unless $self->row_plaintext($_) =~ $re;
        my ($selector, $name) = ($1, $3);
        my $selected = $2 eq '+' ? 'all' : $2 eq '#' ? -1 : 0;

        push @$page, [
            $name,
            $selector,
            $selected,
            $selected,
        ];
    }
}

sub next {
    my $self = shift;

    # look for the first page after the current page that hasn't been parsed
    for ($self->page_number + 1 .. $self->page_count) {
        if (@{ $self->pages->[$_] || [] } == 0) {
            return join '', map {'>'} $self->page_number + 1 .. $_;
        }
    }

    # now look for any pages we may have missed at the beginning
    for (1 .. $self->page_number - 1) {
        if (@{ $self->pages->[$_] || [] } == 0) {
            return '^' . join '', map {'>'} $self->page_number + 1 .. $_;
        }
    }

    # we're done, but the user isn't following our API
    confess "$self->next called even though $self->at_end is true.";
}

sub select {
    my $self = shift;
    my $code = shift;

    for (map { @{ $_ || [] } } @{ $self->pages }) {
        my ($name, $selector, $selected, $started_selected) = @$_;

        my $select = do {
            local $_ = $name;
            $code->($selector);
        };

        if ($select && $selected ne 'all') {
            $_->[2] = 'all';
        }
    }
}

sub select_quantity {
    my $self = shift;
    my $code = shift;

    for (map { @{ $_ || [] } } @{ $self->pages }) {
        my ($name, $selector, $selected, $started_selected) = @$_;

        my $select = do {
            local $_ = $name;
            $code->($selector);
        };

        $_->[2] = defined($select) ? $select : $_->[2];
    }
}

sub deselect {
    my $self = shift;
    my $code = shift;

    for (map { @{ $_ || [] } } @{ $self->pages }) {
        my ($name, $selector, $selected, $started_selected) = @$_;

        my $deselect = do {
            local $_ = $name;
            $code->($selector);
        };

        if ($deselect && $selected) {
            $_->[2] = 0;
        }
    }
}

# stop as soon as we've got the first item to select
sub _commit_single {
    my $self = shift;
    my $out = '^';
    my $skip_first = 0;

    for (@{ $self->pages }) {
        next if $skip_first++ == 0;

        for (@{ $_ || [] }) {
            if ($_->[2]) {
                return $out . $_->[1];
            }
        }
        $out .= '>';
    }

    return $out . ' ';
}

# everything and anything, baby
sub _commit_multi {
    my $self = shift;

    my @pages = map {
        join '', map {
            ($_->[2] eq $_->[3]                ) ? ''                 :
            ($_->[2] eq 0                      ) ? $_->[1]            :
            ($_->[2] eq 'all'   && $_->[3] ne 0) ? ($_->[1] x 2)      :
            ($_->[2] eq 'all'                  ) ? $_->[1]            :
                                                   ($_->[2] . $_->[1]);
        } @{ $_ || [] }
    } @{ $self->pages };

    shift @pages; # there is no page 0

    return '^' . join('>', @pages) . ' ';
}

sub commit {
    my $self = shift;
    my $method = '_commit_' . $self->select_count;
    $self->$method();
}

our $VERSION = '0.06';

1;