(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
    tileset           ; optional tileset struct when ~tilemap~ is ~#f~ (see renderer)
    camera
    tileset-texture
    camera-target     ; symbol tag or #f
    background)       ; #f or (r g b) / (r g b a) for framebuffer clear

  (define (scene-add-entity scene entity)
    (update-scene scene
      entities: (append (scene-entities scene) (list entity))))

  (define (scene-map-entities scene . procs)
    "Apply each proc in sequence to the scene's entities; returns a new scene."
    (update-scene scene
      entities: (fold (lambda (proc es) (map proc es))
                      (scene-entities scene)
                      procs)))

  (define (scene-filter-entities scene pred)
    "Keep only entities satisfying pred; returns a new scene."
    (update-scene scene
      entities: (filter pred (scene-entities scene))))

  (define (scene-transform-entities scene proc)
    "Apply proc to the full entity list (entities → entities); returns a new scene."
    (update-scene scene
      entities: (proc (scene-entities scene))))

  ;; Center camera on entity. Clamps to >= 0 on both axes.
  ;; Returns a new camera struct.
  (define (camera-follow camera entity viewport-w viewport-h)
    (let* ((entity-x (entity-ref entity #:x 0))
           (entity-y (entity-ref entity #:y 0)))
      (update-camera camera
        x: (inexact->exact (floor (max 0 (- entity-x (/ viewport-w 2)))))
        y: (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)))

  ;; First wins: one origin entity per #:group-id (for lookup).
  (define (group-origin-alist entities)
    (let loop ((es entities) (acc '()))
      (if (null? es)
          acc
          (let ((e (car es)))
            (if (and (entity-ref e #:group-origin? #f)
                     (entity-ref e #:group-id #f))
                (let ((gid (entity-ref e #:group-id)))
                  (if (assq gid acc)
                      (loop (cdr es) acc)
                      (loop (cdr es) (cons (cons gid e) acc))))
                (loop (cdr es) acc))))))

  (define (sync-member-to-origin e origins)
    (let* ((gid (entity-ref e #:group-id #f))
           (o   (and gid (not (entity-ref e #:group-origin? #f))
                     (assq gid origins))))
      (if o
          (let ((origin (cdr o)))
            (entity-set (entity-set e #:x (+ (entity-ref origin #:x 0)
                                             (entity-ref e #:group-local-x 0)))
                        #:y (+ (entity-ref origin #:y 0)
                               (entity-ref e #:group-local-y 0))))
          e)))

  ;; Snap member #:x/#:y to origin + #:group-local-x/y.
  ;; Pure entities → entities function; use with scene-transform-entities.
  (define (sync-groups entities)
    (let ((origins (group-origin-alist entities)))
      (map (cut sync-member-to-origin <> origins) entities)))
)