extra/sokoban/board/board-tests.factor

   1 USING: accessors arrays colors kernel sokoban.board sokoban.piece tools.test ;
   2
   3 { { { f f } { f f } { f f } } } [ 2 3 make-rows ] unit-test
   4 { { { f f } { f f } { f f } } } [ 2 3 <board> rows>> ] unit-test
   5 { 1 { f f } } [ 2 3 <board> { 1 1 } board@block ] unit-test
   6 { f } [ 2 3 <board> { 1 1 } block ] unit-test
   7 [ 2 3 <board> { 2 3 } block ] must-fail
   8 { COLOR: red } [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 1 } block ] unit-test
   9 { t } [ 2 3 <board> { 1 1 } block-free? ] unit-test
  10 { f } [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 1 } block-free? ] unit-test
  11 { t } [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 2 } block-free? ] unit-test
  12 { t } [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 0 1 } block-free? ] unit-test
  13 { t } [ 2 3 <board> { 0 0 } block-in-bounds? ] unit-test
  14 { f } [ 2 3 <board> { -1 0 } block-in-bounds? ] unit-test
  15 { t } [ 2 3 <board> { 1 2 } block-in-bounds? ] unit-test
  16 { f } [ 2 3 <board> { 2 2 } block-in-bounds? ] unit-test
  17 { t } [ 2 3 <board> { 1 1 } location-valid? ] unit-test
  18 { f } [ 2 3 <board> dup { 1 1 } COLOR: red set-block { 1 1 } location-valid? ] unit-test
  19 ! { t } [ 10 10 <board> 10 <random-piece> piece-valid? ] unit-test
  20 ! { f } [ 2 3 <board> 10 <random-piece> { 1 2 } >>location piece-valid? ] unit-test
  21 ! { { { f } { f } } } [ 1 1 <board> add-row rows>> ] unit-test
  22 ! { { { f } } } [ 1 2 <board> dup { 0 1 } COLOR: red set-block remove-full-rows rows>> ] unit-test
  23 ! { { { f } { f } } } [ 1 2 <board> dup { 0 1 } COLOR: red set-block dup check-rows drop rows>> ] unit-test