#lang debug racket/base
(require racket/match
racket/function
racket/list
racket/vector
threading)
(struct fighter (x y hp) #:transparent)
(struct posn (x y) #:transparent)
(struct grid (vec rows cols) #:transparent)
(define (make-grid line-strs)
(define row-count (length line-strs))
(define col-count (string-length (first line-strs)))
(grid
(apply vector-append
(map list->vector
(map string->list line-strs)))
row-count
col-count))
(define test-map
(make-grid
'("#######"
"#E..G.#"
"#...#.#"
"#.G.#G#"
"#######")))
(module+ test
(require rackunit))
(define (grid-ref g x y)
(vector-ref (grid-vec g) (+ (* (grid-cols g) y) x)))
(define (grid-clear-at? g p #:goal [goal #f])
(match-define (posn x y) p)
(or #R (equal? #R goal #R p)
(equal? (grid-ref g x y) #\.)))
(define (copy-blank-grid g)
(match-define (grid _ rows cols) g)
(grid (make-vector (* rows cols) #f) rows cols))
(define (display-grid g)
(display
(apply string-append
(for/fold ([lst '()]
#:result (reverse (cons "\n" lst)))
([val (in-vector (grid-vec g))]
[i (in-naturals 1)])
(define ch
(cond [(number? val) (number->string (modulo val 10))]
[(boolean? val) "-"]
[(string? val) val]
[else (format "~a" val)]))
(cond [(equal? 0 (modulo i (grid-cols g)))
(cons "\n" (cons ch lst))]
[else (cons ch lst)])))))
(define (posn-outside-grid? p g)
(match-define (posn px py) p)
(or (< px 0)
(< py 0)
(> px (- (grid-rows g) 1))
(> py (- (grid-cols g) 1))))
(define (grid-mark! g pos v)
(match-define (posn x y) pos)
(vector-set! (grid-vec g) (+ (* (grid-cols g) y) x) v))
(define (neighbor-coords pos)
(match-define (posn x y) pos)
(map (lambda (lst) (apply posn lst))
`((,(- x 1) ,y)
(,x ,(+ y 1))
(,(+ x 1) ,y)
(,x ,(- y 1)))))
(define (free-neighbors-at world pos #:goal [goal #f])
(filter (curry grid-clear-at? world #:goal goal) (neighbor-coords pos)))
(define (not-yet-checked? pmap iter-num pos)
(match-define (posn x y) pos)
(let ([val (grid-ref pmap x y)])
(or (boolean? val)
(and (number? val)
(> val iter-num)))))
(define (path-grid world f end-pos)
(define f-pos (posn (fighter-x f) (fighter-y f)))
(define result-grid (copy-blank-grid world))
(grid-mark! result-grid end-pos 0)
(display-grid result-grid)
(let loop ([to-check (list end-pos)]
[i 1])
(define new-1 (map (curry free-neighbors-at world #:goal f-pos) #R to-check))
(define new-2 (remove-duplicates (flatten #R new-1)))
(define new-coords (filter (curry not-yet-checked? result-grid i) #R new-2))
(for-each (lambda (p) (grid-mark! result-grid p i)) new-coords)
(display-grid result-grid)
(cond
[(member f-pos new-coords) result-grid]
[(empty? new-coords) #f]
[else (loop new-coords (+ 1 i))])))