1 \ jumpsaround - the knight's tour problem 
    2 \ (c) 2020 Alexander Kulbartsch
    3 
    4 6 constant SIZEX 
    5 5 constant SIZEY
    6 
    7 \ init the possible 8 moves for a night 
    8 : init-jump ( n7..n0 a -- ) 8 0 ?do dup rot swap i cells + ! loop drop ; 
    9 variable jumpx 8 cells allot
   10  1 -1  2 -2  2 -2  1 -1  jumpx init-jump
   11 variable jumpy 8 cells allot 
   12  2  2  1  1 -1 -1 -2 -2  jumpy init-jump
   13 \ display jumpto coordinates, only for needed testing 
   14 : jump-show ( -- ) 8 0 ?do ." {" jumpx i cells + @ . ." ," jumpy i cells + @ . ." }" loop cr ;
   15 
   16 \ define and init more variables
   17 variable board SIZEX SIZEY * cells allot   board SIZEX SIZEY * cells erase    
   18 variable iters SIZEX SIZEY * cells allot   iters SIZEX SIZEY * cells 0 fill 
   19 variable solutions                         0 solutions !  
   20 variable roundtrips                        0 roundtrips ! 
   21 variable isroundtrip                       false isroundtrip ! 
   22 
   23 : board-get ( x y -- n ) SIZEX * + cells board + @ ; 
   24 : board-set ( n x y -- ) SIZEX * + cells board + ! ; 
   25 
   26 \ print board
   27 : printboard ( -- ) 
   28   ." ===== Solution #" solutions @ . ." - Roundtripps:" roundtrips @ . ." ====== "
   29   isroundtrip @ if ." *** Roundtrip ***" endif cr
   30   SIZEY 0 ?do
   31     SIZEX 0 ?do 
   32       i j board-get dup 10 < if space endif . [char] : emit 
   33     loop cr
   34   loop cr ;
   35 
   36 \ jump to 
   37 : jumpto ( nx ny ni -- )
   38     dup 2over board-set                 \ store position ( nx ny ni ) 
   39     \ finished?
   40     dup SIZEX SIZEY * >= if             \ finished ? 
   41         8 0 ?do 
   42             jumpx i cells + @ 3 pick +    \ ( nx ny ni nx2 )
   43             jumpy i cells + @ 3 pick +    \ ( nx ny ni nx2 ny2)
   44             \ check if the new position is on the board
   45             dup  0 >=  over sizey < and   
   46             2 pick 
   47             dup  0 >=  swap sizex < and   and if 
   48                 \ detect roundtrip
   49                 board-get 1 = if 1 roundtrips +! true isroundtrip ! leave  then  \ ( nx ny ni b )
   50             else 2drop 
   51             then \ btw "then" and "endif" are the same ;)  
   52         loop
   53         1 solutions +!
   54         printboard                      \ ( nx ny )
   55     else \ try next jump
   56         8 0 ?do 
   57             jumpx i cells + @ 3 pick +    \ ( nx ny ni nx2 )
   58             jumpy i cells + @ 3 pick +    \ ( nx ny ni nx2 ny2)
   59             \ ." i=" i . .s cr  \ test
   60             \ check if the new position is on the board
   61             dup  0 >=  over sizey < and    
   62             2 pick 
   63             dup  0 >=  swap sizex < and   and if 
   64                 \ check if new field position is still empty
   65                 2dup board-get 0 = 
   66                 if   2 pick 1+  
   67                      recurse
   68                 else 2drop
   69                 then \ ( nx ny ni )
   70             else 2drop
   71             then \ btw "then" and "endif" are the same ;)  
   72         loop
   73     then
   74     drop                            \ ( nx ny ni -- nx ny )
   75     0 -rot board-set ;              \ ( nx ny -- )
   76 
   77 \ main
   78 cr
   79 ." Hello, Jumper!" cr
   80  0 0 1 jumpto
   81 ." I am done" cr
   82 bye
   83 
   84 \ EOF