(module downstroke-prefabs *
  (import scheme
          (chicken base)
          (chicken keyword)
          (chicken port)
          defstruct
          downstroke-entity
          downstroke-ai)

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

  ;; 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)
      (ai-body      #:ai-facing 1 #:ai-machine #f #:chase-origin-x 0 #:disabled #f)))

  ;; Compose a prefab entry with mixin table
  ;; Returns (name . merged-plist)
  (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))
           (mixin-plists
             (map (lambda (mname)
                    (let ((m (assq mname mixin-table)))
                      (if m (cdr m) (error "Unknown mixin" mname))))
                  mixin-names))
           ;; inline-fields prepended → first-match semantics give them highest priority
           (merged (apply append inline-fields mixin-plists)))
      (cons name merged)))

  ;; Engine-level hooks
  (define *engine-hooks*
    `((init-enemy-ai . ,(lambda (e) (entity-set e #:ai-machine (make-enemy-ai-machine))))))

  ;; 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))))

  ;; Group prefab entry: (name . plist) with #:parts = list of part plists.
  ;; Part offsets may use #:local-x / #:local-y or #:group-local-x / #:group-local-y.
  (define (compose-group-prefab entry)
    (cons (car entry) (cdr entry)))

  ;; 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+
    (list #: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 scene-sync-groups!.
  (define +physics-group-origin-defaults+
    (list #: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+
    (list #: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  (cdr (assq 'mixins data)))
           (prefab-section (cdr (assq 'prefabs data)))
           (group-section  (cond ((assq 'group-prefabs data) => cdr) (else '())))
           ;; user mixins first → user wins on assq lookup (overrides engine mixin by name)
           (user-mixin-table (map (lambda (m) (cons (car m) (cdr m))) mixin-section))
           (merged-mixin-table (append user-mixin-table engine-mixin-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) (compose-prefab entry merged-mixin-table))
                              prefab-section))
           (group-table (map compose-group-prefab 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 (instantiate-prefab registry type x y w h)
    (if (not registry)
        #f
        (let ((entry (assq type (prefab-registry-prefabs registry))))
          (if (not entry)
              #f
              ;; instance fields prepended → highest priority
              (let* ((base (append (list #:x x #:y y #:width w #:height 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-group-member part ox oy gid type-members static-parts?)
    (let* ((p0 (part-with-group-locals part))
           (merged (append 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
                       (append
                         (list #: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)))))))