librarygames/2048/Twenty48.xtl
2048's rules, a library: 2048.xtl (scripted), play.xtl (at the terminal) and the web page all use these. Slide the tiles of a 4 by 4 board left, right, up or down; two equal tiles that meet merge into their sum (once a move), and a 2 or a 4 appears on an empty square. Make a 2048 tile; the game ends when no move changes the board.
The state is one vector: the score, then the 16 squares row by row (0 empty).
ˡc̲ompress : (Num a, Truthy a) => a -> a
Every row at once, its tiles slid left: each tile's new column is the count of tiles up to it in its row (a running sum); a 4 by 4 by 4 table of each square against each column (row, old column, new column) puts every value in its place, summed over the old columns.
ˡc̲ompress ← { b → c ← (b ≠ 0) × '+ s̲\₂ b ≠ 0 '+ r̲/₂ (b 'l̲eft t̲able r̲ange 4) × c '= t̲able r̲ange 4 }
ˡp̲lace : Num a => a -> Int
Every row at once, which tiles double when equal neighbors merge, left to right: a run of equal tiles starts where a tile differs from the one before; each tile's place in its run is its column less the run's start (the latest start so far, by a max-scan). A tile in an odd place doubles when the next tile is equal; a tile in an even place is absorbed (the one before it doubled).
ˡp̲lace ← { b → j ← 4 4 r̲eshape r̲ange 4 prev ← 0 c̲at₂ -1 d̲rop₂ b 1 + j − 'm̲ax s̲\₂ j × b ≠ prev }
ˡd̲oubles : (Num a, Truthy b) => a -> b
Where a tile meets an equal one to its right in a row, the first of each pair (counted from the left).
ˡd̲oubles ← { b → next ← (1 d̲rop₂ b) c̲at₂ 0 (b ≠ 0) ∧ (1 = (ˡp̲lace b) m̲od 2) ∧ b = next }
ˡm̲erge : (Num a, Truthy a) => a -> a
A row after merging: each first of a pair doubled, its partner emptied.
ˡm̲erge ← { b → (b × 1 = (ˡp̲lace b) m̲od 2) + b × ˡd̲oubles b }
ˡl̲eft : (Num a, Truthy a) => a -> a
A move left: compress, merge, compress, composed as a train of atops (each applied to the result of the one on its right).
ˡl̲eft ← [ˡc̲ompress [ˡm̲erge ˡc̲ompress]]
ˡt̲urn : Num b => a -> b -> a
The other moves turn the board so that the move is left, and turn it back: d is 1 left, 2 right, 3 up, 4 down. Up and down transpose the board (o_\) once, right and down reverse its rows once: each a power of 0 or 1. Turning back undoes them in the other order.
ˡt̲urn ← { b d → (1 × d m̲ember? 2 4) 'r̲ev₂ p̲ower (1 × d m̲ember? 3 4) 'o̲\ p̲ower b }
ˡb̲ack : Num b => a -> b -> a
The board turned back from the left-moving view of move d (undoing l:t_urn).
ˡb̲ack ← { b d → (1 × d m̲ember? 3 4) 'o̲\ p̲ower (1 × d m̲ember? 2 4) 'r̲ev₂ p̲ower b }
ˡs̲lide : (Num a, Truthy a, Num b) => a -> b -> a
Every tile of board b moved in direction d (1 left, 2 right, 3 up, 4 down): turned so the move is left, moved left, turned back.
ˡs̲lide ← { b d → (ˡl̲eft b ˡt̲urn d) ˡb̲ack d }
ˡg̲ain : (Num a, Truthy a, Num b) => a -> b -> a
What a move scores: the value of every tile it makes by merging.
ˡg̲ain ← { b d → c ← ˡc̲ompress b ˡt̲urn d '+ r̲/ r̲avel 2 × c × ˡd̲oubles c }
ˡs̲pawn : (Num a, Truthy a) => a -> a
A 2 (or, one time in ten, a 4) on a random empty square.
ˡs̲pawn ← { b → e ← w̲here 0 = r̲avel b 0 = t̲ally e ? b k ← (r̲oll! t̲ally e) s̲elect e v ← 2 + 2 × 10 = r̲oll! 10 4 4 r̲eshape (r̲avel b) + v × k = r̲ange 16 }
ˡn̲ew : (Any a, Num b, Truthy b) => a -> b
A new game: no score, two tiles spawned on an empty board.
ˡn̲ew ← { x → 0 c̲at r̲avel ˡs̲pawn ˡs̲pawn 4 4 r̲eshape 0 }
ˡm̲ove : (Num a, Truthy a, Num b) => a -> b -> a
A move d: the board slides; if anything moved, the score gains the merged tiles and a new tile appears; if not, nothing happens.
ˡm̲ove ← { s d → b ← ˡb̲oard s n ← b ˡs̲lide d n m̲atch b ? s ((ˡs̲core s) + b ˡg̲ain d) c̲at r̲avel ˡs̲pawn n }