\ 4096th.fth

\ Utils
variable random
2 random ! \ seed
\ random time&date + + + + + + random ! \ Memmory address + time seed
: rand ( max -- r ) random @ 6364136223846793005 * 1 + dup random ! swap mod ;
\ TODO: Discover the bit-ness and parse the string to the correct value
\ : cell-bits ( -- n ) 1 begin 2* dup 0< until ;
\ Values for LCG: Xn+1 = a Xn + c mod 2^bit
\  8-bit    mod 2^8     a 5                         c 1
\ 16-bit    mod 2^16    a 21                        c 1
\ 32-bit    mod 2^32    a 1103515245                c 12345
\ 64-bit    mod 2^64    a 6364136223846793005       c 1


\ Grid
variable grid 15 cells allot
grid 16 cells erase

\ Colors:
\  2 K    64 M
\  4 Y   128 R
\  8 G   256 Y
\ 16 C   512 K
\ 32 B  1024 W
: drawGrid
    page
    grid
    dup  0 cells + @ 7 .r
    dup  1 cells + @ 7 .r
    dup  2 cells + @ 7 .r
    dup  3 cells + @ 7 .r
    cr
    dup  4 cells + @ 7 .r
    dup  5 cells + @ 7 .r
    dup  6 cells + @ 7 .r
    dup  7 cells + @ 7 .r
    cr
    dup  8 cells + @ 7 .r
    dup  9 cells + @ 7 .r
    dup 10 cells + @ 7 .r
    dup 11 cells + @ 7 .r
    cr
    dup 12 cells + @ 7 .r
    dup 13 cells + @ 7 .r
    dup 14 cells + @ 7 .r
    dup 15 cells + @ 7 .r
    cr
    drop
;

: countEmpty ( -- c )   \ Can later be replacced by a variable to keep count?
    0                       ( 0 )
    16 0 do
        grid i cells + @    ( c gridi )
        0=                  ( c grid=0? )
        if 1+ then          ( c++ )
    loop
;

: addRandomVal ( -- )
    countEmpty        ( n )
    rand                ( rn )
    15 0 do
        grid        ( rn grid )
        i cells + @ ( rn gridi )
        0=          ( rn gridi=0? )
        if          ( rn )
            1-      ( rn-- )
            dup
            0<      ( rn rn<0 ) \ gridi==0 and rn<0 Here it is
            if      ( rn )
                grid i   ( grid i )
                cells +     ( gridi )
                2 swap !    ( )
                leave
        then then
    loop
    drop
    \ grid 0 to 15 if gridi 0= rn-- if rn<0 gridi=2 leave
    \ Randomize sequence of [0,15]
    \ Find first of those that is empty
    \ Randomize val either 2 or 4
    \ put val in position
    \ Later: check for no more empty (here? elsewhere?)
    \ Easy mode?
;

: initGrid
    grid 16 cells erase
    addRandomVal
    addRandomVal
;


\ Fall
: drop0 ( a 0 ... 0 -- a )
    begin dup 0= while drop repeat
;

-1 constant sentinel

: ?sentinel ( a -- a a=sentinel? )
    dup sentinel =
;

: findSentinel ( S ... -- S ... n )
    5 0 do \ Furthest sentinel can be is SIZE + 1
        i pick      ( S ... xn )
        ?sentinel   ( S ... xn xn=S? )
        if          ( S ... xn )
            drop    ( S ... )
            i leave ( S ... n )
        then        ( S ... xn )
        drop        ( S ... )
    loop
;

: 0pad ( S ... n -- S 0 ... 0 ... )
    4 swap -    ( S x ... 4-n )                 \ x is known to be non-zero
    0 do 0 loop ( S x ... 0 ... 0 )
    begin       ( S x ... 0 ... )
        3 pick  ( s x ... 0 ... x )
        0<>     ( S x ... 0 ... x<>0? )         \ in fact, no zeroes before S
    while       ( S x ... 0 ... )
        3 roll  ( S ... 0 ... x )
    repeat      ( S 0 ... 0 x ... x )
;

: fall ( sentinel a1 b1 c1 d1 -- sentinel a2 b2 c2 d2 )
    sentinel >r             ( S a b c d )       ( r: S )
    begin                   ( S ... x y  )      ( r: ... S )
        ?sentinel 0=        ( S ... x y y!=S? ) ( r: ... S )
    while                   ( S ... x y )       ( r: ... S )
        drop0 ?sentinel 0=  ( S ... x y y!=S? ) ( r: ... S )
        if \ Needed check for case of ( S 0 ... 0 ) so drop0 >r doesnt sent S.
            drop0 >r        ( S ... x )         ( r: y ... S )
            drop0 r>        ( S ... x y         ( r: ... S )
            2dup            ( S ... x y x y )   ( r: ... S )
            =               ( S ... x y x=y? )  ( r: ... S )
            if + then       ( S ... Z )         ( r: ... S )    \ Z = y | x+y
            >r              ( S ... )           ( r: Z ... S )
        then
    repeat
    begin                   ( S )               ( r: ... S )
        r> ?sentinel
    until                   ( S ... S )         ( r: )
    drop                    ( S ... )
    findSentinel            ( S ... n )
    dup 4 - 0<>             ( S ... n n<>4 )
    if 0pad else drop then  ( S a2 b2 c2 d2 )
;


\ Lines
: getCol ( i -- a b c d )
    grid swap   ( grid i )
    cells +     ( gridi0 )
    dup         ( gridi0 gridi0 )
    @ swap      ( a gridi0 )
    4 cells +   ( a gridi1 )
    dup         ( a gridi1 gridi1 )
    @ swap      ( a b gridi1 )
    4 cells +   ( a b gridi2 )
    dup         ( a b gridi2 gridi2 )
    @ swap      ( a b c gridi2 )
    4 cells +   ( a b c gridi3 )
    @           ( a b c d )
;

: getRow ( i -- a b c d )
    grid swap   ( grid i )
    4 *         ( grid 4i )
    cells +     ( gridi0 )
    dup         ( gridi0 gridi0 )
    @ swap      ( a gridi0 )
    1 cells +   ( a gridi1 )
    dup         ( a gridi1 gridi1 )
    @ swap      ( a b gridi1 )
    1 cells +   ( a b gridi2 )
    dup         ( a b gridi2 gridi2 )
    @ swap      ( a b c gridi2 )
    1 cells +   ( a b c gridi3 )
    @           ( a b c d )
;

: putCol ( a b c d i -- )
    grid swap           ( a b c d grid i )
    cells +             ( a b c d gridi0 )
    >r                  ( a b c d ) ( R: gridi0 )
    3 roll              ( b c d a ) ( R: gridi0 )
    r@ !                ( b c d ) ( R: gridi0 )
    2 roll              ( c d b ) ( R: gridi0 )
    r@ 1 4 * cells + !  ( c d ) ( R: gridi0 )
    swap                ( d c ) ( R: gridi0 )
    r@ 2 4 * cells + !  ( d ) ( R: gridi0 )
    r> 3 4 * cells + !  ( ) ( R: )
;

: putRow ( a b c d i -- )
    grid swap       ( a b c d grid i )
    4 *             ( a b c d grid 4i )
    cells +         ( a b c d gridi0 )
    >r              ( a b c d ) ( R: gridi0 )
    3 roll          ( b c d a ) ( R: gridi0 )
    r@ !            ( b c d ) ( R: gridi0 )
    2 roll          ( c d b ) ( R: gridi0 )
    r@ 1 cells + !  ( c d ) ( R: gridi0 )
    swap            ( d c ) ( R: gridi0 )
    r@ 2 cells + !  ( d ) ( R: gridi0 )
    r> 3 cells + !  ( ) ( R: )
;

: 4reverse ( a b c d -- d c b a )
    swap 2swap swap
;


\ Gameplay
: fallDown ( -- )
    4 0 do
        sentinel    ( S )
        i getCol    ( S a1 b1 c1 d1 )
        fall        ( S a2 b2 c2 d2 )
        i putCol    ( S )
        drop        ( )
    loop
;

: fallLeft ( -- )
    4 0 do
        sentinel    ( S )
        i getRow    ( S a1 b1 c1 d1 )
        4reverse    ( S d1 c1 b1 a1 )
        fall        ( S d2 c2 b2 a2 )
        4reverse    ( S a2 b2 c2 d2 )
        i putRow    ( S )
        drop        ( )
    loop
;

: fallRight ( -- )
    4 0 do
        sentinel    ( S )
        i getRow    ( S a1 b1 c1 d1 )
        fall        ( S a2 b2 c2 d2 )
        i putRow    ( S )
        drop        ( )
    loop
;

: fallUp ( -- )
    4 0 do
        sentinel    ( S )
        i getCol    ( S a1 b1 c1 d1 )
        4reverse    ( S d1 c1 b1 a1 )
        fall        ( S d2 c2 b2 a2 )
        4reverse    ( S a2 b2 c2 d2 )
        i putCol    ( S )
        drop        ( )
    loop
;


\ Input
: ?isDown ( key -- bool )
    dup         ( key key )
    [char] s =  ( key s? )
    swap dup    ( s? key key )
    [char] S =  ( s? key S? )
    swap dup    ( s? S? key key )
    [char] j =  ( s? S? key j? )
    swap        ( s? S? j? key )
    [char] J =  ( s? S? j? J? )
    or or or    ( s|S|j|J? )
;

: ?isLeft ( key -- bool )
    dup         ( key key )
    [char] a =  ( key a? )
    swap dup    ( a? key key )
    [char] A =  ( a? key A? )
    swap dup    ( a? A? key key )
    [char] h =  ( a? A? key h? )
    swap        ( a? A? h? key )
    [char] H =  ( a? A? h? H? )
    or or or    ( a|A|h|H? )
;

: ?isRight ( key -- bool )
    dup         ( key key )
    [char] d =  ( key d? )
    swap dup    ( d? key key )
    [char] D =  ( d? key D? )
    swap dup    ( d? D? key key )
    [char] l =  ( d? D? key l? )
    swap        ( d? D? l? key )
    [char] L =  ( d? D? l? L? )
    or or or    ( d|D|l|L? )
;

: ?isUp ( key -- bool )
    dup         ( key key )
    [char] w =  ( key w? )
    swap dup    ( w? key key )
    [char] W =  ( w? key W? )
    swap dup    ( w? W? key key )
    [char] k =  ( w? W? key k? )
    swap        ( w? W? k? key )
    [char] K =  ( w? W? k? K? )
    or or or    ( w|W|k|K? )
;

: ?isQuit ( key -- bool )
    dup         ( key key )
    [char] q =  ( key q? )
    swap        ( q? key )
    [char] Q =  ( q? Q? )
    or          ( q|Q? )
;

: getInput ( -- quit? )
    key ( k )
    dup ?isDown     if fallDown     else
    dup ?isLeft     if fallLeft     else
    dup ?isRight    if fallRight    else
    dup ?isUp       if fallUp       else
    then then then then ?isQuit
;


\ Game
: mainLoop ( -- )
    begin
    addRandomVal
    cr drawGrid cr
    .s
    getInput ( quit? )
    until
;

initGrid
mainLoop

\ sentinel
\ 0 0 0 0
\ .s
\ fall
\ .s
\ cr cr
\ drop drop drop drop
\
\ sentinel
\ 1 2 3 4
\ .s
\ fall
\ .s
\ cr cr
\ drop drop drop drop
\
\ 2 2 0 0
\ .s fall .s cr cr
\ drop drop drop drop
\
\ 2 4 0 2
\ .s fall .s cr cr
\ drop drop drop drop
\
\ 4 4 0 2
\ .s fall .s cr cr
\ drop drop drop drop
\
\ 4 4 4 2
\ .s fall .s cr cr
\ drop drop drop drop
\
\ 4 0 4 2
\ .s fall .s cr cr
\ drop drop drop drop
\
\ 2 2 2 2
\ .s fall .s cr cr
\ drop drop drop drop
\
\ 2 4 8 4
\ .s fall .s cr cr
\ drop drop drop drop

.s cr bye