diff options
Diffstat (limited to 'prefabs.scm')
| -rw-r--r-- | prefabs.scm | 86 |
1 files changed, 83 insertions, 3 deletions
diff --git a/prefabs.scm b/prefabs.scm index 56bc60a..eda75ad 100644 --- a/prefabs.scm +++ b/prefabs.scm @@ -9,7 +9,7 @@ ;; Registry struct to hold prefab data (defstruct prefab-registry - prefabs file engine-mixin-table user-hooks hook-table) + prefabs group-prefabs file engine-mixin-table user-hooks hook-table) ;; Return engine's built-in mixin table (define (engine-mixins) @@ -49,19 +49,54 @@ (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))) + 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 @@ -88,4 +123,49 @@ ((symbol? hook-val) (lookup-hook (prefab-registry-hook-table registry) hook-val)) (else #f)))) - (if handler (handler base) base))))))) + (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))))))) |