\ jumpsaround - the knight's tour problem 
\ (c) 2020 Alexander Kulbartsch

6 constant SIZEX 
5 constant SIZEY

\ init the possible 8 moves for a night 
: init-jump ( n7..n0 a -- ) 8 0 ?do dup rot swap i cells + ! loop drop ; 
variable jumpx 8 cells allot
 1 -1  2 -2  2 -2  1 -1  jumpx init-jump
variable jumpy 8 cells allot 
 2  2  1  1 -1 -1 -2 -2  jumpy init-jump
\ display jumpto coordinates, only for needed testing 
: jump-show ( -- ) 8 0 ?do ." {" jumpx i cells + @ . ." ," jumpy i cells + @ . ." }" loop cr ;

\ define and init more variables
variable board SIZEX SIZEY * cells allot   board SIZEX SIZEY * cells erase    
variable iters SIZEX SIZEY * cells allot   iters SIZEX SIZEY * cells 0 fill 
variable solutions                         0 solutions !  
variable roundtrips                        0 roundtrips ! 
variable isroundtrip                       false isroundtrip ! 

: board-get ( x y -- n ) SIZEX * + cells board + @ ; 
: board-set ( n x y -- ) SIZEX * + cells board + ! ; 

\ print board
: printboard ( -- ) 
  ." ===== Solution #" solutions @ . ." - Roundtripps:" roundtrips @ . ." ====== "
  isroundtrip @ if ." *** Roundtrip ***" endif cr
  SIZEY 0 ?do
    SIZEX 0 ?do 
      i j board-get dup 10 < if space endif . [char] : emit 
    loop cr
  loop cr ;

: roundtrip? ( nx ny -- )
    board-get 1 = 
    if   1 roundtrips +! true isroundtrip !
    then ;

: position-on-board?    ( nx ny -- nx ny b )
    dup  0 >=           ( nx ny b )
    over sizey <        ( nx ny b b )
    and                 ( nx ny b   )
    2 pick              ( nx ny b nx )
    dup  0 >=           ( nx ny b nx b )
    swap sizex <        ( nx ny b b b )
    and  and ;          ( nx ny b )

\ jump to 
: jumpto ( nx ny ni -- )
    dup 2over board-set                 \ store position ( nx ny ni ) 
    \ finished?
    dup SIZEX SIZEY * >= if             \ finished? 
        false isroundtrip !
        8 0 ?do 
            jumpx i cells + @ 3 pick +    \ ( nx ny ni nx2 )
            jumpy i cells + @ 3 pick +    \ ( nx ny ni nx2 ny2)
            \ check if the new position is on the board
            position-on-board?
            if   roundtrip?  isroundtrip @  if leave  endif 
            else 2drop 
            then \ btw "then" and "endif" are the same ;)  
        loop
        1 solutions +!
        printboard                      \ ( nx ny )
    else \ try next jump
        8 0 ?do 
            jumpx i cells + @ 3 pick +    \ ( nx ny ni nx2 )
            jumpy i cells + @ 3 pick +    \ ( nx ny ni nx2 ny2)
            \ check if the new position is on the board
            position-on-board? if 
                \ check if new field position is still empty
                2dup board-get 0 = 
                if   2 pick 1+  
                     recurse  
                else 2drop
                then \ ( nx ny ni )
            else 2drop
            then \ btw "then" and "endif" are the same ;)  
        loop
    then
    drop                            \ ( nx ny ni -- nx ny )
    0 -rot board-set ;              \ ( nx ny -- )

\ main
cr
." Hello, Jumper!" cr
 0 0 1 jumpto
." I am done" cr
bye

\ EOF