view release on metacpan or  search on metacpan

lib/Game/LevelMap.pm  view on Meta::CPAN

            if ( $cols != $newcols ) {
                croak 'unequal column length at row index ' . $#map;
            }
        } else {
            $cols = $newcols;
        }
    }
    $self->level( \@map );
    return $self;
}

# TODO this might buffer and only print what differs across successive
# calls (for less bandwidth over an SSH connection)
sub to_panel {
    my $self = shift;
    my ( $col, $row, $width, $height, $x, $y ) = map int, @_[ 0 .. 5 ];
    my $oobfn    = $_[6] // sub { return ' ' };
    my $lm       = $self->level;
    my $map_cols = $lm->$#*;
    my $map_rows = $lm->[0]->$#*;
    croak "x must be within the level map" if $x < 0 or $x > $map_cols;
    croak "y must be within the level map" if $y < 0 or $y > $map_rows;
    my $scol = $x - int( $width / 2 );
    my $srow = $y - int( $height / 2 );
    my $s    = '';

    for my $r ( $srow .. $srow + $height - 1 ) {
        $s .= "\e[" . $row++ . ';' . $col . 'H';
        for my $c ( $scol .. $scol + $width - 1 ) {
            if ( $c < 0 or $c > $map_cols or $r < 0 or $r > $map_rows ) {
                $s .= $oobfn->( $lm, $c, $r, $map_cols, $map_rows );
            } else {
                $s .= $lm->[$r][$c];
            }
        }
    }
    print $s;
    return $self;
}

sub to_string {
    my ($self) = @_;
    my $lm     = $self->level;
    my $s      = '';
    for my $rowref ( $lm->@* ) { $s .= join( '', $rowref->@* ) . $/ }
    return $s;
}

sub to_terminal {
    my $self = shift;
    my ( $col, $row ) = map int, @_;
    my $lm = $self->level;
    my $s  = '';
    for my $rowref ( $lm->@* ) {
        $s .= "\e[" . $row++ . ';' . $col . 'H' . join( '', $rowref->@* );
    }
    print $s;
    return $self;
}

sub update_terminal {
    my $self = $_[0];
    my ( $col, $row ) = map int, @_[ 1 .. 2 ];
    my $lm = $self->level;
    my $s  = '';
    for my $point ( @_[ 3 .. $#_ ] ) {
        $s .= "\e["
          . ( $row + $point->[1] ) . ';'
          . ( $col + $point->[0] ) . 'H'
          . $lm->[ $point->[1] ][ $point->[0] ];
    }
    print $s;
    return $self;
}

1;
__END__

=head1 NAME

Game::LevelMap - level map representation

=head1 SYNOPSIS

  use Game::LevelMap;

  my $lm = Game::LevelMap->new( from_string => <<'EOF' );
  .....
  .@.>.
  .....
  EOF

  print $lm->to_string;

  # the following methods may require buffering disabled
  STDOUT->autoflush(1);

  $lm->to_terminal( 1, 1 );

  # maybe instead there's a static border, indent
  $lm->to_terminal( 2, 2 );
  ...
  # several points on the map changed, update them
  $lm->update_terminal( 2, 2, [ 5, 2 ], [ 4, 2 ] );

  # complicated, see docs tests eg/panel-viewer
  $lm->to_panel( ... );

=head1 DESCRIPTION

A small level map implementation that uses characters (or strings
consisting of escape sequences or combining characters, or objects that
hopefully stringify themselves properly) in an array of arrays
representing a level map as might be used in a game.

  x cols
  y rows

Points use the geometric form (x,y) col,row which is backwards from what
terminal escape sequences use.