(module downstroke-world
    *
  (import scheme
	  (chicken base)
	  (only srfi-1 fold filter)
	  defstruct
	  downstroke-tilemap
	  downstroke-entity)
  ;; Scene = current level: tilemap (layers, objects) + list of entities.

  ;; Returns tile-id if the cell at (col, row) in this layer is non-zero, #f otherwise.
  (define (layer-tile-at layer col row)
    (let ((rows (layer-map layer)))
      (and (< row (length rows))
           (let ((row-data (list-ref rows row)))
             (and (< col (length row-data))
                  (let ((tile-id (list-ref row-data col)))
                    (and (not (zero? tile-id)) tile-id)))))))

  (define (tilemap-tile-at tilemap col row)
    "Get the tile ID at grid position (col, row).
     Returns 0 if out of bounds or if all layers have 0 at that cell."
    (let ((width  (tilemap-width  tilemap))
          (height (tilemap-height tilemap)))
      (if (or (< col 0) (>= col width) (< row 0) (>= row height))
          0
          (let loop ((layers (tilemap-layers tilemap)))
            (if (null? layers)
                0
                (or (layer-tile-at (car layers) col row)
                    (loop (cdr layers))))))))

  (defstruct camera x y)

  (defstruct scene
    entities
    tilemap
    camera
    tileset-texture
    camera-target)    ; symbol tag or #f

  (define (scene-add-entity scene entity)
    (scene-entities-set! scene (append (scene-entities scene) (list entity)))
    scene)

  (define (scene-update-entities scene . procs)
    "Apply each proc in sequence to the scene's entities; each proc maps over all entities.
     The scene's entity list is replaced once with the final result."
    (scene-entities-set! scene
      (fold (lambda (proc es) (map proc es))
            (scene-entities scene)
            procs))
    scene)

  (define (scene-filter-entities scene pred)
    "Remove all entities from scene that do not satisfy pred."
    (scene-entities-set! scene
      (filter pred (scene-entities scene)))
    scene)

  ;; Center camera on entity. Clamps to >= 0 on both axes.
  ;; viewport-w and viewport-h are the game window dimensions (pixels).
  (define (camera-follow! camera entity viewport-w viewport-h)
    (let* ((entity-x (entity-ref entity #:x 0))
           (entity-y (entity-ref entity #:y 0)))
      (camera-x-set! camera (inexact->exact (floor (max 0 (- entity-x (/ viewport-w 2))))))
      (camera-y-set! camera (inexact->exact (floor (max 0 (- entity-y (/ viewport-h 2))))))))

  ;; Returns the first entity in scene whose #:tags list contains tag, or #f.
  (define (scene-find-tagged scene tag)
    (let loop ((entities (scene-entities scene)))
      (cond
        ((null? entities) #f)
        ((member tag (entity-ref (car entities) #:tags '())) (car entities))
        (else (loop (cdr entities))))))

  ;; Returns all entities in scene whose #:tags list contains tag.
  (define (scene-find-all-tagged scene tag)
    (filter (lambda (e) (member tag (entity-ref e #:tags '())))
            (scene-entities scene)))
)