2048: Difference between revisions

Content added Content deleted
m (→‎{{header|Perl 6}}: refactor a bit, style tweaks)
Line 1,757:
<lang perl6>use Term::termios;
 
myconstant $saved_termiossaved := Term::termios.new(fd => 1).getattr;
myconstant $termios := Term::termios.new(fd => 1).getattr;
# 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 { $saved_termiossaved.setattr(:NOW) }
 
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>>».&center )
}
 
sub center ($s){
my $c = $cell - $s.chars;
my $lpad = ' ' x floorceiling($c/2);
sprintf "%{$cell}s", "$s$pad";
my $r = ' ' x ceiling($c/2);
"$l$s$r";
}
 
sub clscr { run('clear') }
 
sub draw-board {
clscrrun('clear');
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 squishsquash ('left', @c) { grep { $_.chars }, @c }
my @tiles = grep { .chars }, @c;
@coltiles.unshiftpush: '' while @col.elemstiles < 4;▼
@tiles;
}
 
multi sub squash ('right', @c) {
my @tiles = grep { .chars }, @c;
@rowtiles.unshift: '' while @row.elemstiles < 4;▼
@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 = squishsquash left, @board[*]>>»[$y];
@col.append: '' xx 4;
for 0 .. 2 -> $x {
combine(@col[$x], @col[$x+1]) if @col[$x] && @col[$x+1] == @col[$x]
}
@colboard[*]»[$y] = squishsquash left, @col;
@board[$_][$y] = @col[$_] || '' for 0 .. 3;
}
}
Line 1,823 ⟶ 1,830:
multi sub move('down') {
for 0 .. 3 -> $y {
my @col = squishsquash right, @board[*]>>»[$y];
for 3 ... 1 -> $x {
combine(@col[$x], @col[$x-1]) if @col[$x] && @col[$x-1] == @col[$x]
}
@colboard[*]»[$y] = squishsquash right, @col;
▲ @col.unshift: '' while @col.elems < 4;
@board[$_][$y] = @col[$_] for 0 .. 3;
}
}
Line 1,835 ⟶ 1,840:
multi sub move('left') {
for 0 .. 3 -> $y {
my @row = squishsquash left, flat @board[$y]>>»[*];
@row.append: '' xx 4;
for 0 .. 2 -> $x {
combine(@row[$x], @row[$x+1]) if @row[$x] && @row[$x+1] == @row[$x]
}
@rowboard[$y] = squishsquash left, @row;
@board[$y][$_] = @row[$_] || '' for 0 .. 3;
}
}
Line 1,847 ⟶ 1,850:
multi sub move('right') {
for 0 .. 3 -> $y {
my @row = squishsquash right, flat @board[$y]>>»[*];
for 3 ... 1 -> $x {
combine(@row[$x], @row[$x-1]) if @row[$x] && @row[$x-1] == @row[$x]
}
@rowboard[$y] = squishsquash right, @row;
▲ @row.unshift: '' while @row.elems < 4;
@board[$y][$_] = @row[$_] for 0 .. 3;
}
}
 
sub another {
my @emptyempties;
for @board.kv -> $r, @row {
@emptyempties.push(($r, $_)) for @row.grep-index(:k, '', @row);
}
my ( $x, $y ) = @emptyempties.roll;
@board[$x][; $y] = (flat 2 xx 9, 4).roll;
}
 
loop {
another() if (join '|', flat @board>>».list) ne $save;
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 $get-chrchar = $*IN.read(4).decode.ords;
$save = join '|', flat @board>>».list;
move(%dir{$get-chrchar}) if so %dir{$get-chrchar};
last if $get-chrchar eq 113; # (q)uit
}</lang>
Sample output:
<pre>
Press direction arrows to move. Press q to quit.
 
Press q to quit.
 
┌──────┬──────┬──────┬──────┐
Retrieved from "https://rosettacode.org/wiki/2048"