;;; Copyright (C) 2024 David Thompson <dave@spritely.institute>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(define-module (game tileset)
  #:use-module (dom canvas)
  #:use-module (dom image)
  #:use-module (ice-9 match)
  #:use-module (math rect)
  #:use-module (srfi srfi-9)
  #:export (make-tileset
            tileset?
            tileset-image
            tileset-tile-width
            tileset-tile-height
            draw-tile))

(define-record-type <tileset>
  (%make-tileset image tile-width tile-height tiles)
  tileset?
  (image tileset-image)
  (tile-width tileset-tile-width)
  (tile-height tileset-tile-height)
  (tiles tileset-tiles))

(define (make-tileset image width height tile-width tile-height)
  (let* ((w (quotient width tile-width))
         (h (quotient height tile-height))
         (tiles (make-vector (* w h))))
    (let y-loop ((y 0))
      (when (< y h)
        (let x-loop ((x 0))
          (when (< x w)
            (vector-set! tiles (+ (* y w) x)
                         (make-rect (* x tile-width)
                                    (* y tile-height)
                                    tile-width
                                    tile-height))
            (x-loop (1+ x))))
        (y-loop (1+ y))))
    (%make-tileset image tile-width tile-height tiles)))

(define (draw-tile context tileset idx x y)
  (match tileset
    (($ <tileset> image _ _ tiles)
     (let* ((tile (vector-ref tiles idx))
            (sx (rect-x tile))
            (sy (rect-y tile))
            (w (rect-width tile))
            (h (rect-height tile)))
       (draw-image context image sx sy w h x y w h)))))