(module downstroke-entity
    *
  (import scheme
	  (chicken base)
	  (chicken keyword)
	  (only srfi-1 fold))

  ;; Entities = plists with shared keys (#:type, #:x, #:y, #:width, #:height, ...).

  (define (entity-ref entity key #!optional default)
    (get-keyword key entity (if (procedure? default) default (lambda () default))))

  (define (entity-type entity)
    (entity-ref entity #:type #f))

  (define (entity-set entity key val)
    (let ((cleaned (let loop ((lst entity) (acc '()))
                     (if (null? lst)
                         (reverse acc)
                         (let ((k (car lst))
                               (v (cadr lst)))
                           (if (eq? k key)
                               (loop (cddr lst) acc)
                               (loop (cddr lst) (cons v (cons k acc)))))))))
      (cons key (cons val cleaned))))

  (define (entity-update entity key proc #!optional default)
    (entity-set entity key (proc (entity-ref entity key default))))

  ;; #:skip-pipelines — list of symbols naming frame pipeline steps to skip for this
  ;; entity. Physics documents the built-in step names (see docs/physics.org). Other
  ;; subsystems (e.g. animation, rendering) may reserve additional symbols later and
  ;; use the same predicate and define-pipeline macro.

  (define (entity-skips-pipeline? entity step)
    (let ((skips (entity-ref entity #:skip-pipelines '())))
      (and (pair? skips) (memq step skips))))

  ;; er-macro-transformer so (rename 'entity-skips-pipeline?) captures the
  ;; binding from THIS module — works across compiled unit boundaries.
  (define-syntax define-pipeline
    (er-macro-transformer
      (lambda (form rename _compare)
        (let* ((name-skip (cadr form))
               (name     (car name-skip))
               (skip     (cadr name-skip))
               (formals  (caddr form))
               (f1       (car formals))
               (body     (cdddr form))
               (%define  (rename 'define))
               (%if      (rename 'if))
               (%let     (rename 'let))
               (%quote   (rename 'quote))
               (%skip?   (rename 'entity-skips-pipeline?)))
          `(,%define (,name ,@formals)
             (,%if (,%skip? ,f1 (,%quote ,skip))
                   ,f1
                   (,%let () ,@body)))))))

  (define (make-player-entity x y width height)
    (list #:type 'player
	  #:x x
	  #:y y
	  #:width width
	  #:height height
	  #:vx 0
	  #:vy 0
	  #:gravity? #t
	  #:on-ground? #f
	  #:tile-id 29
	  #:input-map '((left  . (-2 .  0))
	                (right . ( 2 .  0))
	                (down  . ( 0 .  2)))))
)