1 #lang racket
    2 
    3 ; jumpsaround - jumper game
    4 ; (c) 2020 Alexander Kulbartsch
    5 
    6 (define SIZEX 6)  ;6
    7 (define SIZEY 5)  ;5
    8 
    9 (define JUMP '{{-1 -2} {1 -2} {-2 -1} {2 -1} {-2 1} {2 1} {-1 2} {1 2}} )
   10 
   11 (define board (make-vector (* SIZEX SIZEY) 0))
   12 (define solutions 0)
   13 (define roundtrips 0) 
   14   
   15 (define (board-ref x y)
   16   (vector-ref board (+ x (* y SIZEX))))
   17 
   18 (define (board-set! x y v)
   19   (vector-set! board (+ x (* y SIZEX)) v))
   20 
   21 (define (printboard rt)
   22   (printf "===== Solution # ~a - Roundtripps: ~a ====== \n" solutions roundtrips)
   23   (if rt  (printf " *** Roundtrip *** ")  #f)
   24   (for ([i SIZEY])
   25     (for ([j SIZEX])
   26       (printf "~a:" (board-ref j i)))
   27     (printf "\n"))
   28   (printf "\n"))
   29 
   30 
   31 (define (jumpto x y iter) 
   32   (board-set! x y iter)
   33   ;check if finished
   34   (if (>= iter (* SIZEX SIZEY))
   35       (begin ;check for roundtrips
   36           (let ([round #f])
   37             (map (lambda (d)
   38               (let ([nx (+ x (car  d))]
   39                     [ny (+ y (cadr d))])
   40                 (if (and (not round)
   41                          (>= nx 0) (< nx SIZEX)
   42                          (>= ny 0) (< ny SIZEY))
   43                    (if (= (board-ref nx ny) 1)
   44                        (begin
   45                          (set! roundtrips (+ roundtrips 1))
   46                          (set! round #t))
   47                        #f )
   48                    #f )))
   49            JUMP)
   50           (set! solutions (+ solutions 1))
   51           (printboard round)))      
   52       ; else try next
   53       (map (lambda (d)
   54              (let ([nx (+ x (car  d))]
   55                    [ny (+ y (cadr d))])
   56                (if (and (>= nx 0) (< nx SIZEX)
   57                         (>= ny 0) (< ny SIZEY))
   58                    (if (= (board-ref nx ny) 0)
   59                        (begin
   60                          ; (display nx) 
   61                          (jumpto nx ny (add1 iter)) )
   62                        #f)
   63                    #f)))
   64            JUMP))
   65   
   66   (board-set! x y 0)
   67 )
   68 
   69 (define (start) 
   70    (printf "Hello Jumper!\n")
   71    ;(display board)
   72    (jumpto 0 0 1)
   73    (printf "I am done.\n"))
   74 
   75 (let ([start-sec (current-inexact-milliseconds)])
   76   (start)
   77   (printf "Duration: ~a seconds.\n" (/ (- (current-inexact-milliseconds) start-sec) 1000)))
   78 
   79 ; EOF