2048: Difference between revisions
m
→{{header|Perl 6}}: refactor a bit, style tweaks
Thundergnat (talk | contribs) m (→{{header|Perl 6}}: refactor a bit, style tweaks) |
|||
Line 1,757:
<lang perl6>use Term::termios;
# raw mode interferes with carriage returns, so
# set flags needed to emulate it manually
Line 1,766:
# reset terminal to original setting on exit
END { $
my @board = ( ['', '', '', ''] xx 4 );
Line 1,776:
constant $mid = join '─' x $cell, '├', '┼' xx 3, '┤';
constant $bot = join '─' x $cell, '└', '┴' xx 3, '┘';
constant left = 'left';
constant right = 'right';
my %dir = (
Line 1,785 ⟶ 1,787:
sub row (@row) {
sprintf("│%{$cell}s│%{$cell}s│%{$cell}s│%{$cell}s│\n", @row
}
sub center ($s){
my $c = $cell - $s.chars;
my $
sprintf "%{$cell}s", "$s$pad";
}
sub draw-board {
print "\n\n{$tab}Press direction arrows to move.";
print "\n\n{$tab}Press q to quit.\n\n$tab$top\n$tab";
Line 1,805 ⟶ 1,804:
}
multi sub
my @tiles = grep { .chars }, @c;
@tiles;
}
multi sub squash ('right', @c) {
my @tiles = grep { .chars }, @c;
@tiles;
}
sub combine ($v is rw, $w is rw) { $v += $w; $w = ''; $score += $v; }
Line 1,811 ⟶ 1,820:
multi sub move('up') {
for 0 .. 3 -> $y {
my @col =
for 0 .. 2 -> $x {
combine(@col[$x], @col[$x+1]) if @col[$x] && @col[$x+1] == @col[$x]
}
@
}
}
Line 1,823 ⟶ 1,830:
multi sub move('down') {
for 0 .. 3 -> $y {
my @col =
for 3 ... 1 -> $x {
combine(@col[$x], @col[$x-1]) if @col[$x] && @col[$x-1] == @col[$x]
}
@
▲ @col.unshift: '' while @col.elems < 4;
}
}
Line 1,835 ⟶ 1,840:
multi sub move('left') {
for 0 .. 3 -> $y {
my @row =
for 0 .. 2 -> $x {
combine(@row[$x], @row[$x+1]) if @row[$x] && @row[$x+1] == @row[$x]
}
@
}
}
Line 1,847 ⟶ 1,850:
multi sub move('right') {
for 0 .. 3 -> $y {
my @row =
for 3 ... 1 -> $x {
combine(@row[$x], @row[$x-1]) if @row[$x] && @row[$x-1] == @row[$x]
}
@
▲ @row.unshift: '' while @row.elems < 4;
}
}
sub another {
my @
for @board.kv -> $r, @row {
@
}
my ( $x, $y ) = @
@board[$x
}
loop {
another
draw-board
say $score;
# Read up to 4 bytes from keyboard buffer.
# Page navigation keys are 3-4 bytes each.
# Specifically, arrow keys are 3.
my $
$save = join '|', flat @board
move(%dir{$
last if $
}</lang>
Sample output:
<pre>
Press direction arrows to move
Press q to quit.
┌──────┬──────┬──────┬──────┐
|