(library (strigoform level)
  (export tile-width
          tile-height

          make-level-object
          level-object?
          level-object-x
          level-object-type
          level-object-properties

          make-level
          level?
          level-height
          level-foreground
          level-collision
          level-objects
          level-update!
          draw-level-foreground

          rect-collides-with-level?)
  (import (scheme base)
          (hoot match)
          (strigoform assets)
          (strigoform canvas)
          (strigoform game-area)
          (strigoform math)
          (strigoform type))

  ;; action id, sprite sheet offset, x, y
  (define %tile-size (+ 4 8 8 8))
  (define tile-width 16.0)
  (define tile-height 16.0)
  (define level-width 15)

  (define-type level-object
    make-level-object
    level-object?
    (x level-object-x set-level-object-x!)
    (type level-object-type set-level-object-type!)
    (properties level-object-properties set-level-object-properties!))

  (define-type level
    make-level
    level?
    (height level-height set-level-height!)
    (foreground level-foreground set-level-foreground!)
    (collision level-collision set-level-collision!)
    (objects level-objects set-level-objects!))

  (define (level-offset x y)
    (+ (* level-width y) x))

  (define (point-collides-with-level? level x y)
    (match level
      (#('level height foreground collision objects)
       (let ((tx (exact (truncate (/ x tile-width))))
             (ty (exact (truncate (/ y tile-height)))))
         (and (>= tx 0) (< tx level-width)
              (>= ty 0) (< tx height)
              (= (bytevector-u8-ref collision (level-offset tx ty)) 1))))))

  (define (rect-collides-with-level? level x y w h scroll)
    (match level
      (#('level height foreground collision objects)
       (let* ((y (+ y (- (* height tile-height) game-height scroll)))
              (tx0 (exact (truncate (/ x tile-width))))
              (ty0 (exact (truncate (/ y tile-height))))
              (tx1 (exact (truncate (/ (+ x w) tile-width))))
              (ty1 (exact (truncate (/ (+ y h) tile-height)))))
         (define (occupied? x y)
           (and (>= x 0) (< x level-width)
                (>= y 0) (< x height)
                (= (bytevector-u8-ref collision (level-offset x y)) 1)))
         (or (occupied? tx0 ty0)
             (occupied? tx1 ty0)
             (occupied? tx1 ty1)
             (occupied? tx0 ty1))))))

  (define (draw-level-layer context level layer parallax scroll)
    (match level
      (#('level height _ _ _)
       (let* ((tw tile-width)
              (th tile-height)
              (scroll (* scroll parallax))
              (pixel-y-offset (- (* height th) scroll game-height))
              (scroll-y-offset (- height (exact (truncate (/ scroll tile-height)))))
              (y-start (clamp (- scroll-y-offset 21) 0 height))
              (y-end (clamp scroll-y-offset 0 height)))
         (do ((y y-start (+ y 1)))
             ((= y y-end))
           (let* ((row (vector-ref layer y))
                  (k (/ (bytevector-length row) 16))
                  (ty (* y tile-height)))
             (do ((x 0 (+ x 1)))
                 ((= x k))
               (let* ((offset (* x 16))
                      (tx (f64-ref row offset))
                      (ix (f64-ref row (+ offset 8))))
                 (draw-image context image:map
                             ix 0.0 tw th
                             tx (- ty pixel-y-offset) tw th)))))))))

  (define (draw-level-foreground context level scroll)
    (match level
      (#('level height foreground collision objects)
       (draw-level-layer context level foreground 1.0 scroll))))

  (define (level-update! level scroll last-row-scanned do-action)
    (match level
      (#('level height foreground collision objects)
       (let ((row (max
                   (exact
                    (truncate
                     (/ (- (* height tile-height)
                           game-height scroll)
                        tile-height)))
                   0)))
         (do ((y row (+ y 1)))
             ((= y last-row-scanned))
           (for-each (lambda (obj)
                       (match obj
                         (#('level-object x type properties)
                          (let ((x* (+ (* x tile-width)
                                       (/ tile-width 2.0)))
                                (y* (+ (* (- y row 1) tile-height)
                                       (/ tile-height 2.0))))
                            (do-action type x* y* properties)))))
                     (vector-ref objects y)))
         row)))))