(module (downstroke prefabs) *
  (import scheme
          (chicken base)
          (only (chicken keyword) keyword?)
	      srfi-1
          (only (list-utils alist) plist->alist)
          defstruct
          (downstroke entity))

  ;; Registry struct to hold prefab data
  (defstruct prefab-registry
    prefabs group-prefabs file engine-mixin-table user-hooks hook-table)

  ;; Private: internal prefab composition helper.
  ;; Merge alists left-to-right; earlier occurrences of a key win.
  ;; Returns a fresh alist.
  (define (alist-merge . alists)
    (fold (lambda (alist acc)
            (fold (lambda (pair acc)
                    (if (assq (car pair) acc)
                        acc
                        (cons pair acc)))
                  acc
                  alist))
          '()
          alists))

  ;; Keys whose values are lists-of-plists in user data files and must be
  ;; deep-converted to lists-of-alists after the top-level plist->alist pass.
  (define +nested-plist-list-keys+ '(#:animations #:parts))

  (define (convert-nested-plist-values alist)
    (map (lambda (pair)
           (if (memq (car pair) +nested-plist-list-keys+)
               (cons (car pair) (map plist->alist (cdr pair)))
               pair))
         alist))

  ;; Return engine's built-in mixin table
  (define (engine-mixins)
    '((physics-body #:vx 0 #:vy 0 #:ay 0 #:gravity? #t #:solid? #t #:on-ground? #f)
      (has-facing   #:facing 1)
      (animated     #:anim-name idle #:anim-frame 0 #:anim-tick 0 #:tile-id 0 #:animations #t)))

  ;; Compose a prefab entry with a mixin-table of alists.
  ;; `entry` is the raw user plist-shaped entry: (name mixin-name ... #:k v #:k v ...)
  ;; `mixin-table` maps mixin-name → alist (already converted in load-prefabs).
  ;; Returns (name . merged-alist).
  (define (compose-prefab entry mixin-table)
    (let* ((name (car entry))
           (rest (cdr entry))
           (split (let loop ((lst rest) (mixins '()))
                    (if (or (null? lst) (keyword? (car lst)))
                        (cons (reverse mixins) lst)
                        (loop (cdr lst) (cons (car lst) mixins)))))
           (mixin-names  (car split))
           (inline-fields (cdr split))
           (inline-alist (plist->alist inline-fields))
           (mixin-alists
            (map (lambda (mname)
                   (let ((m (assq mname mixin-table)))
                     (if m (cdr m) (error "Unknown mixin" mname))))
                 mixin-names))
           ;; inline-alist first → highest priority (earlier-wins)
           (merged (apply alist-merge (cons inline-alist mixin-alists))))
      (cons name merged)))

  (define *engine-hooks* '())

  ;; Lookup a hook symbol in the hook table
  (define (lookup-hook hook-table hook-sym)
    (let ((entry (assq hook-sym hook-table)))
      (if entry
          (cdr entry)
          (error "Unknown prefab hook" hook-sym))))

  ;; Optional profiles (enabled per group via #:pose-only-origin? / #:static-parts? in data).
  ;; Pose-only origin: tweened or scripted leader, invisible, does not run physics pipelines.
  (define +pose-only-group-origin-defaults+
    '((#:solid? . #f)
      (#:gravity? . #f)
      (#:skip-render . #t)
      (#:skip-pipelines . (jump acceleration gravity velocity-x velocity-y
			                    tile-collisions-x tile-collisions-y on-solid entity-collisions))))

  ;; Physics-driving origin: invisible point mass; members follow via sync-groups.
  (define +physics-group-origin-defaults+
    '((#:solid? . #f)
      (#:gravity? . #t)
      (#:skip-render . #t)
      (#:vx . 0)
      (#:vy . 0)
      (#:on-ground? . #f)))

  ;; Static rigid parts: no integration; world pose comes from the origin each frame.
  (define +static-group-member-defaults+
    '((#:gravity? . #f)
      (#:vx . 0)
      (#:vy . 0)
      (#:on-ground? . #f)
      (#:solid? . #t)
      (#:immovable? . #t)
      (#:skip-pipelines . (jump acceleration gravity velocity-x velocity-y
			                    tile-collisions-x tile-collisions-y on-solid))))

  (define (part-with-group-locals part)
    (let* ((p part)
           (p (if (entity-ref p #:group-local-x #f) p
                  (entity-set p #:group-local-x (entity-ref p #:local-x 0))))
           (p (if (entity-ref p #:group-local-y #f) p
                  (entity-set p #:group-local-y (entity-ref p #:local-y 0)))))
      p))

  (define (load-prefabs file engine-mixin-table user-hooks)
    (let* ((data (with-input-from-file file read))
           (mixin-section  (if (assq 'mixins data) (cdr (assq 'mixins data)) '()))
           (prefab-section (cdr (assq 'prefabs data)))
           (group-section  (cond ((assq 'group-prefabs data) => cdr) (else '())))
           ;; Convert engine mixin-table bodies (plists) to alists.
           (engine-mixin-alist-table
            (map (lambda (m) (cons (car m) (plist->alist (cdr m))))
                 engine-mixin-table))
           ;; user mixins first → user wins on assq lookup (overrides engine mixin by name)
           (user-mixin-table
            (map (lambda (m) (cons (car m) (plist->alist (cdr m))))
                 mixin-section))
           (merged-mixin-table (append user-mixin-table engine-mixin-alist-table))
           ;; user-hooks first → user wins on assq lookup (overrides engine hooks by name)
           (hook-table (append user-hooks *engine-hooks*))
           (prefab-table
            (map (lambda (entry)
                   (let* ((composed (compose-prefab entry merged-mixin-table))
                          (converted (convert-nested-plist-values (cdr composed))))
                     (cons (car composed) converted)))
                 prefab-section))
           (group-table
            (map (lambda (entry)
                   (let* ((name (car entry))
                          (alist-fields (plist->alist (cdr entry)))
                          (converted (convert-nested-plist-values alist-fields)))
                     (cons name converted)))
                 group-section)))
      (make-prefab-registry
       prefabs:            prefab-table
       group-prefabs:      group-table
       file:               file
       engine-mixin-table: engine-mixin-table
       user-hooks:         user-hooks
       hook-table:         hook-table)))

  (define (reload-prefabs! registry)
    (load-prefabs (prefab-registry-file               registry)
                  (prefab-registry-engine-mixin-table registry)
                  (prefab-registry-user-hooks         registry)))

  (define (do-instantiate-prefab registry entry x y w h)
    (let* ((base (entity-set-many (make-entity x y w h) (cdr entry)))
           (hook-val (entity-ref base #:on-instantiate #f))
           (handler
            (cond
             ((procedure? hook-val) hook-val)
             ((symbol?    hook-val)
              (lookup-hook (prefab-registry-hook-table registry) hook-val))
             (else #f))))
      (if handler (handler base) base)))


  (define (instantiate-prefab registry type x y w h)
    (if (not registry)
        #f
        (let ((entry (assq type (prefab-registry-prefabs registry))))
          (if (not entry)
              #f
              (do-instantiate-prefab registry entry x y w h)))))

  (define (instantiate-group-member part ox oy gid type-members static-parts?)
    (let* ((p0 (part-with-group-locals part))
           (merged (alist-merge p0 (if static-parts? +static-group-member-defaults+ '())))
           (lx (entity-ref merged #:group-local-x 0))
           (ly (entity-ref merged #:group-local-y 0))
           (typ (entity-ref merged #:type type-members))
           (with-type (entity-set merged #:type typ))
           (g1 (entity-set with-type #:group-id gid))
           (g2 (entity-set g1 #:group-local-x lx))
           (g3 (entity-set g2 #:group-local-y ly))
           (g4 (entity-set g3 #:x (+ ox lx))))
      (entity-set g4 #:y (+ oy ly))))

  ;; Instantiate a group prefab: one origin entity (pose) + members with #:group-local-x/y.
  ;; Returns (origin member ...) or #f. Each instance gets a fresh gensym #:group-id.
  (define (instantiate-group-prefab registry type ox oy)
    (if (not registry)
        #f
        (let ((entry (assq type (prefab-registry-group-prefabs registry))))
          (if (not entry)
              #f
              (let* ((spec (cdr entry))
                     (gid (gensym (symbol->string type)))
                     (parts (entity-ref spec #:parts '()))
                     (type-members (entity-ref spec #:type-members 'group-part))
                     (pose-only? (entity-ref spec #:pose-only-origin? #f))
                     (static-parts? (entity-ref spec #:static-parts? #f))
                     (ow (entity-ref spec #:origin-width 0))
                     (oh (entity-ref spec #:origin-height 0))
                     (ot (entity-ref spec #:origin-type 'group-origin))
                     (origin-fields
                      (alist-merge
                       `((#:type . ,ot)
                         (#:group-id . ,gid)
                         (#:group-origin? . #t)
                         (#:x . ,ox) (#:y . ,oy)
                         (#:width . ,ow) (#:height . ,oh))
                       (if pose-only?
                           +pose-only-group-origin-defaults+
                           +physics-group-origin-defaults+)))
                     (origin origin-fields)
                     (members
                      (map (lambda (part)
                             (instantiate-group-member
                              part ox oy gid type-members static-parts?))
                           parts)))
                (cons origin members)))))))