(use-modules (chickadee)
             (chickadee math grid)
             (chickadee math vector)
             (chickadee math rect)
             (chickadee graphics color)
             (chickadee graphics font)
             (chickadee graphics path)
             (chickadee graphics sprite))

(define grid (make-grid))
(define item-color (make-color 0.7 0.0 0.0 0.7))
(define cell-color (make-color 0.0 0.7 0.0 0.4))
(define player-color (make-color 0.0 0.0 0.7 0.8))
(define player-pos (vec2 32.0 32.0))
(define player-speed 2)
(define player-velocity (vec2 0.0 0.0))
(define null-vec2 (vec2 0.0 0.0))
(define last-cell-count -1)
(define cell-painter
  (with-style ((fill-color cell-color))
    (fill (square null-vec2 (grid-cell-size grid)))))
(define cell-canvas (make-empty-canvas))
(define item-canvas (make-empty-canvas))

(define (make-cell-painter)
  (let ((size (grid-cell-size grid)))
    (apply superimpose
           (grid-cell-fold (lambda (cell x y memo)
                             (cons (translate (vec2 (* x size) (* y size))
                                     cell-painter)
                                   memo))
                           '()
                           grid))))

(define (make-item-painter item rect)
  (with-style ((fill-color (if (eq? item 'player)
                               player-color
                               item-color)))
    (fill
     (rectangle (vec2 (rect-x rect)
                      (rect-y rect))
                (rect-width rect)
                (rect-height rect)))))

(define (compose-item-painters)
  (apply superimpose
         (grid-item-fold (lambda (item rect memo)
                           (cons (make-item-painter item rect) memo))
                         '()
                         grid)))

(define (load)
  (grid-add grid 'wall-left 0 0 32 480)
  (grid-add grid 'wall-top 32 448 576 32)
  (grid-add grid 'wall-right 608 0 32 480)
  (grid-add grid 'wall-bottom 32 0 576 32)
  (grid-add grid 'box-1 100 100 100 50)
  (grid-add grid 'box-2 300 300 50 100)
  (grid-add grid 'box-3 350 150 200 75)
  (grid-add grid 'box-4 150 140 130 75)
  (grid-add grid 'player (vec2-x player-pos) (vec2-y player-pos) 32 32)
  (set-canvas-painter! item-canvas (compose-item-painters)))

(define (update dt)
  (set-vec2-x! player-velocity 0.0)
  (set-vec2-y! player-velocity 0.0)
  (when (key-pressed? 'up)
    (set-vec2-y! player-velocity player-speed))
  (when (key-pressed? 'down)
    (set-vec2-y! player-velocity (- player-speed)))
  (when (key-pressed? 'right)
    (set-vec2-x! player-velocity player-speed))
  (when (key-pressed? 'left)
    (set-vec2-x! player-velocity (- player-speed)))
  (unless (vec2= player-velocity null-vec2)
    (vec2-add! player-pos player-velocity)
    (grid-move grid 'player player-pos
               (lambda (a b)
                 (if (eq? a 'player)
                     slide
                     #f)))
    (set-canvas-painter! item-canvas (compose-item-painters)))
  (let ((cell-count (grid-cell-count grid)))
    (unless (= cell-count last-cell-count)
      (set! last-cell-count cell-count)
      (set-canvas-painter! cell-canvas (make-cell-painter)))))

(define %cell-rect
  (make-rect 0.0 0.0 (grid-cell-size grid) (grid-cell-size grid)))
(define %cell-count-pos
  (vec2 0.0 0.0))

(define number->string*
  (let ((cache (make-hash-table)))
    (lambda (n)
      (or (hashv-ref cache n)
          (begin
            (let ((s (number->string n)))
              (hashv-set! cache n s)
              s))))))

(define (draw alpha)
  (draw-canvas cell-canvas)
  (let ((size (grid-cell-size grid)))
    (for-each-cell (lambda (cell x y)
                     (set-vec2-x! %cell-count-pos (+ (* x size) (/ size 2)))
                     (set-vec2-y! %cell-count-pos (+ (* y size) (/ size 2)))
                     (draw-text (number->string* (cell-count cell))
                                %cell-count-pos))
                   grid))
  (draw-canvas item-canvas))

(run-game #:load load #:draw draw #:update update)