;; Game state and logic for the runner entities
(define-module (game model runner)
  #:use-module (ice-9 pretty-print)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-9)
  #:use-module (srfi srfi-9 gnu)
  #:use-module (srfi srfi-64)
  #:use-module (chickadee math vector)
  #:use-module (game util pipe)
  #:use-module (game model level)
  #:export (runner-load
            runner-state 
            runner-position runner-with-position
            runner-x runner-with-x
            runner-y runner-with-y
            runner-update))

(define-immutable-record-type <runner>
  (%make-runner position state)
  runner?
  (position runner-position runner-with-position)
  (state runner-state runner-with-state)                    ;; 'go-left 'go-right 'climb 'fall 'stationary
  )

(define default-state 'fall)

(define (runner-load initial-position)
  (%make-runner initial-position default-state))

(define (runner-x runner)
"return the x coordinate as an integer"
(inexact->exact (floor (vec2-x (runner-position runner)))))

(define (runner-y runner)
  "return the y coordinate as an integer"
  (inexact->exact (floor (vec2-y (runner-position runner)))))

(define (runner-with-x runner x)
  (runner-with-position runner (vec2 x (runner-y runner))))

(define (runner-with-y runner y)
  (runner-with-position runner (vec2 (runner-x runner) y)))

;; return next state of runner 
;; @returns 'go-left 'go-right 'climb 'fall 'stationary
(define (next-state runner level inputs)
  "return the next state of the runner based on the current state, level and inputs"
  (let* ((position (runner-position runner))
         (state (runner-state runner))
         (tile-below-blocked? (level-tile-blocked? level (vec2 (runner-x runner) (1- (runner-y runner))))))
    (cond
     ((equal? (level-tile-at level position) 'ladder) 'climb)
     ((> (floor-remainder (runner-y runner) level-cell-size) 0) 'fall)
     ((not tile-below-blocked?) 'fall)
     (else (cond
            ((member 'left inputs) 'go-left)
            ((member 'right inputs) 'go-right)
            (else 'stationary))))))

(define (input->movement input distance)
  (case input
    ((left) (vec2 (- distance) 0))
    ((right) (vec2 distance 0))
    ((up) (vec2 0 distance))
    ((down) (vec2 0 (- distance)))
    (else (vec2 0 0))))

(define (round-position pos)
  (vec2 (inexact->exact (floor (vec2-x pos)))
        (inexact->exact (floor (vec2-y pos)))))

(define (safe-move level pos move)
  (let ((new-pos (vec2+ pos move)))
    (if (level-tile-blocked? level new-pos)
        (pk "snap position " pos "to" (round-position pos)) ;; snap to grid on collision with hard scenery
        new-pos
        )))

(define (next-position level position state inputs distance)
  (case state
    ((fall) (safe-move level position (vec2 0 (- distance))))
    ((go-left) (safe-move level position (vec2 (- distance) 0)))
    ((go-right) (safe-move level position (vec2 distance 0)))
    ((stationary) position)
    ((climb) (fold (lambda (input pos) 
                     (safe-move level pos (input->movement input distance)))
                   position
                   inputs))
    (else position)
    ))

(define speed 50.0)

(define (runner-update runner level inputs dt)
  (let* ((state (next-state runner level inputs))
         (distance (* dt speed))
         (position (next-position level (runner-position runner) (runner-state runner) inputs distance))
         )
    (-> runner
        (runner-with-state state)
        (runner-with-position position))))

;; Tests
(test-begin "runner-model")

(let* ((level (level-parse "WWWWW\nW...W\nW.P.W\nW..HW\nWWWWW\n"))
       (default-position (vec2 32 32))
       (runner (runner-load default-position)))
  (test-assert (runner? runner))
  (test-equal default-position (runner-position runner))
  (test-equal default-state (runner-state runner))
  
  (test-equal (vec2 10 20)  (runner-position (runner-with-position runner (vec2 10 20))))
  (test-equal default-position (runner-position runner))
  (test-equal 'go-left (runner-state (runner-with-state runner 'go-left)))
  (test-equal default-state (runner-state runner))
  
  (test-equal 16 (runner-x (runner-with-position runner (vec2 16.34 20.78))))
  (test-equal 20 (runner-y (runner-with-position runner (vec2 16.34 20.78))))
  
  (test-equal 'fall (next-state runner level '()))
  (let ((runner (runner-with-position runner (vec2 16 16))))
    (test-equal 'stationary (next-state runner level '()))
    (test-equal 'go-left (next-state runner level '(left)))
    (test-equal 'go-right (next-state runner level '(right))))
  (let ((runner (runner-with-position runner (vec2 48 32))))
    (test-equal 'stationary (next-state runner level '())))
  (let ((runner (runner-with-position runner (vec2 48 31))))
    (test-equal 'climb (next-state runner level '())))
  (let ((runner (runner-with-position runner (vec2 32 31))))
    (test-equal 'fall (next-state runner level '())))
  
  (test-equal "fall in air" (vec2 32.0 31.0) (next-position level (vec2 32.0 32.0) 'fall '() 1.0))
  (test-equal "fall on brick" (vec2 32.0 16.0) (next-position level (vec2 32.0 16.0) 'fall '() 1.0))
  
  (test-equal (vec2 31.0 32.0) (next-position level (vec2 32.0 32.0) 'go-left '() 1.0))
  (test-equal (vec2 33.0 32.0) (next-position level (vec2 32.0 32.0) 'go-right '() 1.0))
  (test-equal (vec2 32.0 32.0) (next-position level (vec2 32.0 32.0) 'stationary '() 1.0))
  
  (test-equal "climb left" (vec2 31.0 32.0) (next-position level (vec2 32.0 32.0) 'climb '(left) 1.0))
  (test-equal "climb right" (vec2 33.0 32.0) (next-position level (vec2 32.0 32.0) 'climb '(right) 1.0))
  (test-equal "climb down" (vec2 32.0 31.0) (next-position level (vec2 32.0 32.0) 'climb '(down) 1.0))
  (test-equal "climb up" (vec2 32.0 33.0) (next-position level (vec2 32.0 32.0) 'climb '(up) 1.0))
  
  (test-equal "snap to grid on collision with hard scenery"
    (vec2 32.0 16.0) 
    (runner-position
     (runner-update
      (runner-with-state 
       (runner-with-position runner (vec2 32 16.3)) 
       'fall)
      level
      '()
      0.017
      )
     ))
  )

(test-end "runner-model")