Game-TextPatterns
view release on metacpan or search on metacpan
lib/Game/TextPatterns.pm view on Meta::CPAN
my $pad = __PACKAGE__->new(pattern => $fill)->multiply($add, $rows);
$quads[0]->append_cols($fill, $pad);
}
}
for my $r (1 .. 3) {
push @quads, $quads[0]->clone->rotate($r);
}
$quads[1]->append_cols($fill, $quads[0]);
$quads[2]->append_cols($fill, $quads[3]);
$quads[1]->append_rows($fill, $quads[2]);
return $quads[1];
}
sub from_array {
my ($self, $array) = @_;
my @pat;
for my $row ($array->@*) {
push @pat, join('', $row->@*);
}
$self->pattern(\@pat);
return $self;
}
sub mask {
my ($self, $mask, $pattern) = @_;
my $pat = $self->pattern;
my ($cols, $rows) = (length $pat->[0], scalar $pat->@*);
my $rep = $pattern->pattern;
for my $r (0 .. $rows - 1) {
$pat->[$r] =~ s{([$mask]+)}{substr($rep->[$r], $-[0], $+[0] - $-[0]) || $1}eg;
}
return $self;
}
sub multiply {
my ($self, $cols, $rows) = @_;
die "cols must be a positive integer"
if !defined $cols
or !looks_like_number($cols)
or $cols < 1;
$cols = int $cols;
if (defined $rows) {
die "rows must be a positive integer"
if !looks_like_number($rows)
or $rows < 1;
$rows = int $rows;
} else {
$rows = $cols;
}
if ($cols > 1) {
for my $row ($self->pattern->@*) {
$row = $row x $cols;
}
}
if ($rows > 1) {
$self->pattern([ ($self->pattern->@*) x $rows ]);
}
return $self;
}
sub overlay {
my ($self, $p, $overlay, $mask) = @_;
my ($cols, $rows) = $self->dimensions;
$p->[0] += $cols - 1 if $p->[0] < 0;
$p->[1] += $rows - 1 if $p->[1] < 0;
if ($p->[0] < 0 or $p->[0] >= $cols or $p->[1] < 0 or $p->[1] >= $rows) {
local $" = ',';
croak "point @$p out of bounds";
}
my ($colnum, $rownum) = map { $_ - 1 } $overlay->dimensions;
my $subpat =
$self->clone->crop($p,
[ min($p->[0] + $colnum, $cols - 1), min($p->[1] + $rownum, $rows - 1) ]);
my $to_draw = $overlay->clone->mask($mask, $subpat);
$self->draw_in($p, $to_draw);
return $self;
}
sub randomly {
my ($self, $re, $percent, $fn) = @_;
my $pat = $self->pattern;
my ($cols, $rows) = (length $pat->[0], scalar $pat->@*);
my $total = $cols * $rows;
my $to_fill = int($total * $percent);
$cols--;
$rows--;
if ($to_fill > 0) {
while (my ($r, $row) = each $pat->@*) {
for my $c (0 .. $cols) {
if (substr($row, $c, 1) =~ m/$re/ and rand() < $to_fill / $total) {
# NOTE exposes internals but I have no plans of
# changing them
$fn->($pat, [ $c, $r ], $cols, $rows);
$to_fill--;
}
$total--;
}
}
}
return $self;
}
sub rotate {
my ($self, $rotate_by) = @_;
$rotate_by %= 4;
if ($rotate_by == 0) { # zero degrees
return $self;
} elsif ($rotate_by == 2) { # 180 degrees
return $self->flip_both;
}
my $pat = $self->pattern;
my ($cols, $rows) = (length $pat->[0], scalar $pat->@*);
my @new;
if ($rotate_by == 1) { # 90 degrees
for my $char (split //, $pat->[0]) {
unshift @new, $char;
}
if ($rows > 1) {
for my $rnum (1 .. $rows - 1) {
for my $cnum (0 .. $cols - 1) {
$new[ $cols - $cnum - 1 ] .= substr $pat->[$rnum], $cnum, 1;
}
}
}
} elsif ($rotate_by == 3) { # 270 degrees
for my $char (split //, $pat->[-1]) {
push @new, $char;
}
if ($rows > 1) {
for my $rnum (reverse 0 .. $rows - 2) {
for my $cnum (0 .. $cols - 1) {
$new[$cnum] .= substr $pat->[$rnum], $cnum, 1;
}
}
lib/Game/TextPatterns.pm view on Meta::CPAN
=head1 METHODS
Call these on something returned by a constructor. Those that modify the
pattern in-place (some though do not) can be chained with other methods.
If something goes wrong these will throw an exception.
=over 4
=item B<append_cols> I<fill> I<pattern>
Appends the given I<pattern> to the right of the existing object (or a
sort of a horizontal L<cat(1)>). If the patterns are of unequal size the
I<fill> character (or array reference) will be used to fill in the gaps.
If I<fill> is an array reference the first character of that reference
will be used to fill gaps should the object be smaller, or otherwise the
second character of the array will be used as fill if the object is
larger than the given I<pattern>.
=item B<append_rows> I<fill> I<pattern>
Appends the given I<pattern> below the existing object (much like
L<cat(1)> does for text). Same rules for I<fill> as for B<append_cols>.
=item B<as_array>
Returns the pattern of the object as a reference to a 2D array.
Presumably useful for some other interface that expects a 2D grid. See
also B<from_array>.
=item B<border> I<width> I<character>
Creates a border of the given I<width> (1 by default) and I<character>
(C<#> by default) around the B<pattern>.
=item B<cols>
Returns the width (x, or number of columns) in the B<pattern>. This is
based on the length of the first line of the B<pattern>.
=item B<crop> I<point1> I<point2>
Crops the pattern to the given column and row pairs, which are counted
from zero for the first row or column, or backwards from the end for
negative numbers. Will throw an error if the crop values lie outside the
size of the pattern.
See also B<trim>.
=item B<dimensions>
Returns the B<cols> and B<rows> of the current B<pattern>.
=item B<draw_in> I<point1> [ I<point2> ] I<pattern>
Draws the I<pattern> within the given bounds, though will not extend the
dimensions of the object if the I<pattern> exceeds that (hence the lower
right bound being optional). Should the I<pattern> be smaller than the
given bounds nothing will be changed at those subsequent points (this
differs from other methods that accept a I<fill> argument).
See also the more complicated B<overlay>.
=item B<fill_4way> I<point> I<char>
Replaces the character found at I<point> with I<char> and repeats this
fill for all similar characters found by 4-way motion from the
starting I<point>.
=item B<fill_8way> I<point> I<char>
Replaces the character found at I<point> with I<char> and repeats this
fill for all similar characters found by 8-way motion from the
starting I<point>.
=item B<flip_both>
Flips the B<pattern> by columns and by rows. Similar to a rotate by
180 degrees.
###. -> ...#
#... -> .###
=item B<flip_cols>
Flips the columns (vertical mirror) in the B<pattern>.
###. -> .###
#... -> ...#
=item B<flip_four> [ I<reduce-col?> [ I<reduce-row?> ] ]
Treats the object as a pattern in quadrant I of the unit circle and
returns a new object with that pattern flipped as appropriate into the
other three quadrants. See also B<four_up>.
###.
#... becomes:
.######.
...##...
...##...
.######.
Note that this does not modify the object in-place, to do that:
$pat = $pat->flip_four;
The optional I<reduce-col> and I<reduce-row> will cause a row, a column,
or if only I<reduce-col> is supplied and is true, both a row and a
column to be lost. That is C<flip_four(1)> causes
###.
#... to become
.#####.
...#...
.#####.
=item B<flip_rows>
Flips the rows (horizontal mirror).
###. -> #...
#... -> ###.
=item B<four_up> [ I<fill> ] [ I<crop?> ]
Treats the object as a pattern in quadrant I of the unit circle and
returns a new object with that pattern rotated into the other three
quadrants by an appropriate number of degrees. See also B<flip_four>.
###.
#... becomes:
??..????
??#.????
??#.###.
??###...
...###??
.###.#??
????.#??
????..??
I<fill> will be used if the input is not a square during various calls
to B<append_cols> and B<append_rows>, unless I<crop> is a true value, in
which case the object used will be cropped to be a square before the
rotations. The default I<fill> as shown above is C<?>.
Note that this does not modify the object in-place.
=item B<from_array> I<array>
Replaces the pattern of the object with the contents of the given 2D
array. See also B<as_array>.
=item B<mask> I<char> I<pattern>
B<mask> replaces instances of the I<char> in the object with the
corresponding character(s) of the given I<pattern>.
=item B<multiply> I<cols> [ I<rows> ]
Multiplies the existing data in the columns or rows, unless I<cols> or
I<rows> is C<1>. With no I<rows> set multiplies both the columns and
rows by the given value.
=item B<overlay> I<point> I<pattern> I<mask>
Draws the I<pattern> into the object at the given I<point> though
preserving anything from the original object that match the I<mask>
character in the I<pattern>.
See also the simpler B<draw_in>.
=item B<rows>
Returns the height (y, or number of rows) in the B<pattern>.
=item B<rotate> I<amount>
Rotates the pattern by 0, 90, 180, or 270 degrees specified by the
integers C<0>, C<1>, C<2>, and C<3> (or modulus of those).
=item B<randomly> I<match> I<percent> I<callback>
Similar to B<white_noise> but calls a callback function for each
matching cell randomly found. For example to act on 10% of cells that
match C<#> use
use constant { ROW => 1, COL => 0, };
$m->randomly(
qr/#/, 0.1,
sub {
my ($pat, $point, $max_cols, $max_rows) = @_;
substr $pat->[$point->[ROW]], $point->[COL], 1, 'x';
}
);
as internally the pattern is stored as an array of strings.
=item B<string> I<sep>
Returns the B<pattern> as a string with rows joined by the I<sep> value
(C<$/> by default which typically is but may not be a newline).
=item B<trim> I<amount>
Convenience method for C<crop( [amount,amount], [-amount,-amount] )>.
=item B<white_noise> I<char> I<percent>
Fills the object with the given percentage of the I<char> randomly.
# 50% fill with 'x'
$v->white_noise( 'x', .5 );
See B<randomly> for a similar routine to this one, if more complicated.
=back
=head1 BUGS
=head2 Reporting Bugs
Please report any bugs or feature requests to
C<bug-game-textpatterns at rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Game-TextPatterns>.
( run in 1.705 second using v1.01-cache-2.11-cpan-e1769b4cff6 )