: newl
 here 0 , 0 , create ,
 ;
: addl ( adr - )
 here swap dup @ 0 ,  , !
 ;
: viewl ( adr - )
 @
 begin
  dup @ . cell+ @ dup
 while 
 repeat drop
 ;
0 constant start
16 constant end
4 constant row
0 variable flag flag !
newl score
2463534242 variable seed seed !
: rndm ( - x ) seed @ dup 13 lshift xor
 dup 17 rshift xor dup 5 lshift xor
 dup seed ! ;
: rand ( n -- 0..n-1 ) rndm um* nip ;
: randomize time&date drop drop drop drop drop 0 do rndm drop loop ;
create ar end cells allot
: set0
 ar end start do dup 0 swap !
 cell + loop drop ;
: prcell ( x - ) dup if 7 .r else drop 5 spaces 46 emit space then ;
: draw page ." score " score @ @ . cr cr cr ar end start do dup @ prcell
 i 1+ row mod 0= if cr cr cr cr then cell + loop drop
 cr cr
 ." Q <quit>     W <up>"
 ."           s2048 - start game" CR
 ."       A <left>    D <right>"
 ."   c2048 - cont. game" CR
 ."             S <down>"
 ."          vscore - view score" ;
: 2or4 ( - 2 or 4 ) 10 rand 4 - if 2 else 4 then ;
: wher ( - 1..2*end ) end 2 * rand 1+ ;
: select ( - 2 27 ) 2or4 wher ;
: 1flag ( n1 n2 - n1 n2 ) dup if 1 flag ! then ;
: 0flag 0 flag ! ;
: score+ ( n - n ) dup score @ @ + score @ ! ;
: !swap ( 0 n1 - n1 0 )
 over 0= if 1flag swap then ;
: !rot ( 0 n1 n2 - n1 n2 0 )
 >r !swap r> !swap ;
: !rot4 ( 0 n1 n2 n3 - n1 n2 n3 0 )
 >r !rot r> !swap ;
: rot0 ( n1 n2 0 n3 - n1 n2 n3 0 )
 !swap !rot !rot4 ;
: join ( n1 n2 n3 n3 - n1 n2 n3+n3 0 )
 >r >r 2dup =
 if 1flag + score+ r> r> 2dup =
  if + score+ 0 0
  else 0
  then
 else r> 2dup =
  if 1flag + score+ r> 0
  else r> 2dup =
   if 1flag + score+ 0
   then
  then
 then ;
: next ( adr1 - adr2 ) ar 2dup end 1- cells + - if drop cell + else nip then ;
: next0 ( adr1 - adr2 ) begin next dup @ 0= until ;
: put ( 2 27 - ) ar >r begin r> next0 >r 1- dup 0= until drop r> ! ;
: shake ( adr - ) dup row cells + 2dup >r >r swap do
 i @ cell +loop rot0 join r> r> cell - do i ! cell negate +loop ;
: shake_all 0flag ar row start do dup shake row cells + loop drop ;
: change ( n1 adr - adr1 ) swap cells over + dup @ rot ! ;
: noose ( n3 n2 n1 addr - ) dup @ >r change change change r> swap ! ;
: clockwise -12 3 12 ar noose -7 6 7 ar cell + noose
 -2 9 2 ar 2 cells + noose -4 1 4 ar 5 cells + noose ;
: press ( - f ) key case
 [char] d of clockwise clockwise
  shake_all clockwise clockwise false endof ( right )
 [char] s of clockwise shake_all
  clockwise clockwise clockwise false endof ( down )
 [char] a of shake_all false endof ( left )
 [char] w of clockwise clockwise clockwise
  shake_all clockwise
 false endof ( up )
 [char] q of true endof ( quit )
 false swap endcase
 ;
: vscore
 score viewl ;
: gloop
 draw
 begin press flag @
 if 0flag select put draw
 then until ."  quit" ;
:  c2048
 0flag page gloop ;
: s2048
 score @ @ if score addl then 0flag set0 page randomize
 select put select put gloop ;