(define-module (game model level)
  #:use-module (ice-9 match)
  #:use-module (ice-9 pretty-print)
  #:use-module (ice-9 textual-ports)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-64)
  #:export (level-width
            level-height
            level-tiles
            level-entities
            level-player
            level-goal
            level-parse-file
            level-tile-at
            ))

(define-record-type <level>
  (%make-level width height tiles goal player entities)
  level?
  (width level-width)
  (height level-height)
  (tiles level-tiles)
  (goal level-goal)
  (player level-player)
  (entities level-entities))

(define (parse-tile c)
  (case c
    ((#\W) 'wall)
    ((#\B) 'brick)
    ((#\H) 'ladder)
    ((#\P) 'player)
    ((#\E) 'enemy)
    ((#\G) 'goal)
    (else 'empty)))

(define (content->lines content)
  (filter (lambda (line) (not (string-null? line)))
          (map
           (lambda (line) 
             (string-trim-right 
              (car (string-split line #\-))
              #\space))
           (string-split content #\newline))))


(define (parse-lines lines)
  (fold append
        '()
        (map
         (lambda (line)
           (map parse-tile (string->list line)))
         lines)))

(define (level-parse content)
  (let* ((lines (content->lines content))
         (width (string-length (car lines)))
         (height (length lines))
         (tiles (list->vector 
                 (parse-lines lines)))
         (entities '()))
    (%make-level width height tiles #f #f entities)))

(define (level-parse-file filename)
  (level-parse (call-with-input-file filename get-string-all)))


(define (level-tile-at-row-col level row col )
  (let ((index (+ (* row (level-width level)) col)))
    (vector-ref (level-tiles level) index)))

(define cell-size 16)

(define (coord->cell coord)
  (inexact->exact (floor (/ coord cell-size))))

(define (level-tile-at level x y )
  (level-tile-at-row-col level (coord->cell y) (coord->cell x)))


(test-begin "level")


(test-assert (level? (level-parse "WWWWW\nWP GW\nWWWWW\n")))
(test-equal (level-width (level-parse "WWWWW\nWP GW\nWWWWW\n")) 5)
(test-equal (level-height (level-parse "WWWWW\nWP GW\nWWWWW\n")) 3)
(test-equal (level-tiles (level-parse "W")) #(wall))
(test-equal 
    (level-tiles (level-parse "WWWWW\nWP GW\nWWWWW\n")) 
  #(wall wall wall wall wall wall player empty goal wall wall wall wall wall wall))
(test-equal 
    (level-tiles (level-parse "--- ignore this line\nWWWWW\nWP GW - must be ignored\nWWWWW\n")) 
  #(wall wall wall wall wall wall player empty goal wall wall wall wall wall wall))

(test-equal (content->lines "WWWWW\nWP GW\nWWWWW\n") '("WWWWW" "WP GW" "WWWWW"))

(test-equal (parse-tile #\W) 'wall)
(test-equal (parse-tile #\B) 'brick)
(test-equal (parse-tile #\H) 'ladder)
(test-equal (parse-tile #\P) 'player)
(test-equal (parse-tile #\E) 'enemy)
(test-equal (parse-tile #\G) 'goal)
(test-equal (parse-tile #\space) 'empty)

(test-equal (level-width (level-parse-file "assets/levels/level-1.map")) 40)
(test-equal (level-height (level-parse-file "assets/levels/level-1.map")) 30)

(test-equal 
    (level-tile-at-row-col (level-parse "WWWWW\nWP GW\nWWWWW\n") 1 1)
  'player)

(test-equal 
    (level-tile-at-row-col (level-parse "WWWWW\nWP GW\nWWWWW\n") 1 3)
  'goal)

(test-equal 
    (level-find-player (level-parse "WWWWW\nWP GW\nWWWWW\n") 1 3)
  (vec2 16 16))

(test-equal 
    (level-find-goal (level-parse "WWWWW\nWP GW\nWWWWW\n") 1 3)
  (vec2 48 16))

(test-equal 
    (level-find-goal (level-parse "WWWWW\nWE EW\nWWWWW\n") 1 3)
  (list (vec 16 16) (vec2 48 16)))

(test-end "level")