\ go testing

include go-bitmap.f
include ../timer.f

\ I/O

: .bitboard ( b -- )
  dim 2 + 0 do
    cr dup @ dim 2 + 0 do dup 1 and . 2/ loop drop
    cell+
  loop drop ;
  
: b. ( [b] -- ) bd-top .bitboard bdrop ;

: bdepth ( -- n ) bd-next bd-stack - bd-size / ;

: bd-ck
  white blit black blit empty blit bxor bxor bnot b0= if ." board OK" then ;

: test-bd
  b0
  dim 1+ 1 do dim 1+ 1 do
    i j bd-top bd-set
    i j bd-top bd-@ 1 <> if ." fail" then
    i j bd-top bd-clr
    i j bd-top bd-@ 0 <> if ." fail" then
  loop loop
  b0= if ." bd OK" cr then ;

\ TODO: defining words or macros to factor out duplication, unroll loops

: bd-binary: ( xt -- )
  \ result: only a 5% speedup
  >r : r>
  dim 0 do
    postpone swap postpone cell+ postpone swap postpone cell+
    postpone over postpone @ postpone over postpone @
    dup compile,
    postpone over postpone !
  loop drop
  postpone 2drop postpone ;
;

\ ' AND bd-binary: bd-and
\ ' OR  bd-binary: bd-or
\ ' XOR bd-binary: bd-xor

: bd-binary ( src dest xt -- )
  { xt } ( a b -- r )
  dim 0 do
    swap cell+ swap cell+
    over @ over @ xt execute over !
  loop 2drop ;

: bd-unary ( dest xt -- )
  { xt } ( a -- r )
  dim 0 do
    cell+
    dup @ xt execute row-mask and over !
  loop drop ;

\ : bd-or  ['] or  bd-binary ;
\ : bd-and ['] and bd-binary ;
\ : bd-xor ['] xor bd-binary ;
\ : bd-not ['] invert bd-unary ;
\ : bd-2/  ['] 2/     bd-unary ;
\ : bd-2*  ['] 2*     bd-unary ;

\ slightly slower (surprised it wasn't much slower)
: old-nth-candidate ( n -- x y )
  dim 1+ 1 do
    dim 1+ 1 do
      i j candidates bd-@ if
        dup 0= if drop i j unloop unloop exit then
        1-
      then
    loop
  loop ." nth-candidate failed!" drop 0. ;	\ pass

\ obsoleted by random-candidate ( might be faster at start of game? )
: random-move
  begin
    0.
    begin 2drop
      dim dup * choose dim /mod 1 1 d+
      2dup empty bd-@ if
        2dup is-eye? 0=
      else false then
    until
    cr .s
    2dup makemove empty bd-@ is-ko? or
  while	\ ko or still empty (suicide): try again
    takeback
  repeat ;

\ useful for testing
: random-game
  0 passes !
  begin
    rm key [char] q = done? or
  until
  .board cr .scores ;

: test
  test-bd
reset  white bd-empty? .
empty bd-count .

2 1 makemove \ corner captures
1 1 makemove
1 2 makemove
9 2 makemove
9 1 makemove
8 1 makemove
2 9 makemove
1 9 makemove
1 8 makemove
9 8 makemove
9 9 makemove
8 9 makemove

3 3 makemove \ . @ .
3 4 makemove \ @ O @
4 4 makemove \ O @ O
4 5 makemove \ . O .
5 3 makemove
5 4 makemove
4 2 makemove
4 3 makemove
.board ." , ko:" is-ko? . cr
4 3 atari? ." atari? " .
4 4 makemove
.board ." , ko:" is-ko? . cr
takeback

pass pass is-ko? . cr

\ white blit 3 4 string . liberties b. bd-next bd-count .
\ black blit 9 9 string . liberties b. bd-next bd-count .

\ 9 9 is-eye? .
;
\ test