blob: 56bc60a5eb5f6e277ffae978c48e2b34da307730 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
(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 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))))
(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)))
;; 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)))
(make-prefab-registry
prefabs: prefab-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)))))))
|
