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 : roundtrip? ( nx ny -- )
   37     board-get 1 = 
   38     if   1 roundtrips +! true isroundtrip !
   39     then ;
   40 
   41 : position-on-board?    ( nx ny -- nx ny b )
   42     dup  0 >=           ( nx ny b )
   43     over sizey <        ( nx ny b b )
   44     and                 ( nx ny b   )
   45     2 pick              ( nx ny b nx )
   46     dup  0 >=           ( nx ny b nx b )
   47     swap sizex <        ( nx ny b b b )
   48     and  and ;          ( nx ny b )
   49 
   50 \ jump to 
   51 : jumpto ( nx ny ni -- )
   52     dup 2over board-set                 \ store position ( nx ny ni ) 
   53     \ finished?
   54     dup SIZEX SIZEY * >= if             \ finished? 
   55         false isroundtrip !
   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             \ check if the new position is on the board
   60             position-on-board?
   61             if   roundtrip?  isroundtrip @  if leave  endif 
   62             else 2drop 
   63             then \ btw "then" and "endif" are the same ;)  
   64         loop
   65         1 solutions +!
   66         printboard                      \ ( nx ny )
   67     else \ try next jump
   68         8 0 ?do 
   69             jumpx i cells + @ 3 pick +    \ ( nx ny ni nx2 )
   70             jumpy i cells + @ 3 pick +    \ ( nx ny ni nx2 ny2)
   71             \ check if the new position is on the board
   72             position-on-board? if 
   73                 \ check if new field position is still empty
   74                 2dup board-get 0 = 
   75                 if   2 pick 1+  
   76                      recurse  
   77                 else 2drop
   78                 then \ ( nx ny ni )
   79             else 2drop
   80             then \ btw "then" and "endif" are the same ;)  
   81         loop
   82     then
   83     drop                            \ ( nx ny ni -- nx ny )
   84     0 -rot board-set ;              \ ( nx ny -- )
   85 
   86 \ main
   87 cr
   88 ." Hello, Jumper!" cr
   89  0 0 1 jumpto
   90 ." I am done" cr
   91 bye
   92 
   93 \ EOF