threes.factor

! Copyright (C) 2014 Tom Wright.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel random sequences math.order grouping
math.parser io math ;
IN: threes

: bigpiece ( board -- n ) 0 [ min ] reduce 3 max ;

: regulars ( -- x )
{ 1 2 3 1 2 3 } clone ;

: surplus ( -- x ) regulars randomize 2 head ;

: bag ( board -- bag )
bigpiece regulars surplus append swap suffix randomize ;

: empty-board ( -- b )
{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } clone ;

: put-random ( n b -- b ) 16 random swap [ set-nth ] keep ;

: beginning ( -- b )
empty-board dup bag swap [ swap put-random ] reduce ;

: draw ( board -- )
4 group [ [ number>string ] map " " join print ] each ;

: merges? ( p1 p2 -- ? )
[ [ + 6 >= ] [ = ] 2bi and ] [ + 3 = ] 2bi or ;

: boardindex ( c -- i ) first2 [ 4 * ] dip + ;
: @ ( b c -- p ) boardindex swap nth ;

: empty? ( b c -- ? ) @ 0 = ;

: above ( s -- d ) clone dup [ 0 ] dip [ 1 - ] change-nth ;

: above-merges? ( b s -- ? )
[ @ ] [ above @ ] 2bi merges? ;

: lifts? ( b s -- ? )
[ above empty? ] [ above-merges? ] 2bi or ;

: lift ( b c -- b ) drop ;

: lift-column ( b c -- ? )
{ 1 } swap suffix lifts? ;