2048
2048 is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
Implement a 2D sliding block puzzle game where blocks with numbers are combined to add their numbers. The name comes from the popular open-source implementation of this game mechanic, 2048.
Requirements:
- "Non-greedy" movement. The tiles that were created by combining other tiles should not be combined again during the same turn (move). That is to say that moving the tile row of
[2][2][2][2]
to the right should result in
......[4][4]
and not
.........[8]
- Check for valid moves. The player can't skip their turn by trying a move that doesn't change the board.
- Win condition. (Player creates a 2048 tile.)
- Lose condition. (No valid moves possible.)
Tcl
Text mode
<lang tcl>
- A minimal implementation of the game 2048 in Tcl.
package require Tcl 8.5 package require struct::matrix package require struct::list
- Board size.
set size 4
- Iterate over all cells of the game board and run script for each.
- The game board is a 2D matrix of a fixed size that consists of elements
- called "cells" that each can contain a game tile (corresponds to numerical
- values of 2, 4, 8, ..., 2048) or nothing (zero).
- - cellList is a list of cell indexes (coordinates), which are
- themselves lists of two numbers each. They each represent the location
- of a given cell on the board.
- - varName1 are varName2 are names of the variables the will be assigned
- the index values.
- - cellVarName is the name of the variable that at each step of iteration
- will contain the numerical value of the present cell. Assigning to it will
- change the cell's value.
- - script is the script to run.
proc forcells {cellList varName1 varName2 cellVarName script} {
upvar $varName1 i
upvar $varName2 j
upvar $cellVarName c
foreach cell $cellList {
set i [lindex $cell 0]
set j [lindex $cell 1]
set c [cell-get $cell]
uplevel $script
cell-set "$i $j" $c
}
}
- Generate a list of cell indexes for all cells on the board, i.e.,
- {{0 0} {0 1} ... {0 size-1} {1 0} {1 1} ... {size-1 size-1}}.
proc cell-indexes {} {
global size
set list {}
foreach i [::struct::list iota $size] {
foreach j [::struct::list iota $size] {
lappend list [list $i $j]
}
}
return $list
}
- Check if a number is a valid cell index (is 0 to size-1).
proc valid-index {i} {
global size
expr {0 <= $i && $i < $size}
}
- Return 1 if the predicate pred is true when applied to all items on the list
- or 0 otherwise.
proc map-and {list pred} {
set res 1
foreach item $list {
set res [expr {$res && [$pred $item]}]
if {! $res} break
}
return $res
}
- Check if list represents valid cell coordinates.
proc valid-cell? cell {
map-and $cell valid-index
}
- Get the value of a game board cell.
proc cell-get cell {
board get cell {*}$cell
}
- Set the value of a game board cell.
proc cell-set {cell value} {
board set cell {*}$cell $value
}
- Filter a list of board cell indexes cellList to only have those indexes
- that correspond to empty board cells.
proc empty {cellList} {
::struct::list filterfor x $cellList {[cell-get $x] == 0}
}
- Pick a random item from the given list.
proc pick list {
lindex $list [expr {int(rand() * [llength $list])}]
}
- Put a "2*" into an empty cell on the board. The star is to indicate it's new
- for the player's convenience.
proc spawn-new {} {
set emptyCell [pick [empty [cell-indexes]]]
if {[llength $emptyCell] > 0} {
forcells [list $emptyCell] i j cell {
set cell 2*
}
}
}
- Return vector sum of lists v1 and v2.
proc vector-add {v1 v2} {
set result {}
foreach a $v1 b $v2 {
lappend result [expr {$a + $b}]
}
return $result
}
- If checkOnly is false try to shift all cells one step in the direction of
- directionVect. If checkOnly is try just say if that move is possible.
proc move-all {directionVect {checkOnly 0}} {
set changedCells 0
forcells [cell-indexes] i j cell {
set newIndex [vector-add "$i $j" $directionVect]
set removedStar 0
if {$cell eq {2*}} {
set cell 2
set removedStar 1
}
# For every nonempty source cell and valid destination cell...
if {$cell != 0 && [valid-cell? $newIndex]} {
# Destination is empty.
if {[cell-get $newIndex] == 0} {
if {$checkOnly} {
# -level 2 is to return from both forcells and move-all.
return -level 2 true
} else {
# Move tile to empty cell.
cell-set $newIndex $cell
set cell 0
incr changedCells
}
# Destination is the same number as source.
} elseif {([cell-get $newIndex] eq $cell) &&
[string first + $cell] == -1} {
if {$checkOnly} {
return -level 2 true
} else {
# When merging two tiles into one mark the new tile with
# the marker of "+" to ensure it doesn't get combined
# again this turn.
cell-set $newIndex [expr {2 * $cell}]+
set cell 0
incr changedCells
}
}
}
if {$checkOnly && $removedStar} {
set cell {2*}
}
}
if {$checkOnly} {
return false
}
# Remove "changed this turn" markers at the end of the turn.
if {$changedCells == 0} {
forcells [cell-indexes] i j cell {
set cell [string trim $cell +]
}
}
return $changedCells
}
- Is it possible to move any tiles in the direction of directionVect?
proc can-move? {directionVect} {
move-all $directionVect 1
}
- Check win condition. The player wins when there's a 2048 tile.
proc check-win {} {
forcells [cell-indexes] i j cell {
if {$cell == 2048} {
puts "You win!"
exit 0
}
}
}
- Check lose condition. The player loses when the win condition isn't met and
- there are no possible moves.
proc check-lose {possibleMoves} {
set values [dict values $possibleMoves]
if {!(true in $values || 1 in $values)} {
puts "You lose."
exit 0
}
}
- Pretty-print the board.
proc print-board {} {
forcells [cell-indexes] i j cell {
if {$j == 0} {
puts ""
}
puts -nonewline [
if {$cell != 0} {
format "\[%4s\]" $cell
} else {
lindex "......"
}
]
}
puts "\n"
}
proc main {} {
global size
struct::matrix board
# Generate an empty board of a given size.
board add columns $size
board add rows $size
forcells [cell-indexes] i j cell {
set cell 0
}
set controls {
h {0 -1}
j {1 0}
k {-1 0}
l {0 1}
}
# Game loop.
while true {
set playerMove 0
set possibleMoves {}
spawn-new
print-board
check-win
# Find possible moves.
foreach {button vector} $controls {
dict set possibleMoves $button [can-move? $vector]
}
check-lose $possibleMoves
# Get valid input from the player.
while {$playerMove == 0} {
# Print prompt.
puts -nonewline "Move ("
foreach {button vector} $controls {
if {[dict get $possibleMoves $button]} {
puts -nonewline $button
}
}
puts ")?"
set playerInput [gets stdin]
# Validate input.
if {[dict exists $possibleMoves $playerInput] &&
[dict get $possibleMoves $playerInput]} {
set playerMove [dict get $controls $playerInput]
}
}
# Apply current move until no changes occur on the board.
while true {
if {[move-all $playerMove] == 0} break
}
}
}
main </lang>