2048
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>