BirDt/imugi
1
0
Fork 0
Code Issues 14 Pull requests Projects 1 Wiki Activity Actions

Add global systems and bounce boosting

Browse source
This commit is contained in:
BirDt_ 2026-04-16 18:48:39 +08:00
parent 69477db047
commit d379cd28d7
2 changed files with 41 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

12
engine/core.scm
View file

@ -162,7 +162,7 @@
(define (make-system name priority mode criteria process)
(assert (symbol? name))
(assert (integer? priority))
(assert (member mode '(entity batch)))
(assert (member mode '(entity batch global)))
(assert (every symbol? criteria))
(assert (procedure? process))
(int:make-system name priority mode criteria process))
@ -266,10 +266,12 @@
;; Execute a single system
(define (execute-system system)
(assert (system? system))
(let ((entities (map get-entity (set->list (apply query-by-components (system-criteria system))))))
(cond
((eqv? (system-mode system) 'batch) ((system-process system) entities))
((eqv? (system-mode system) 'entity) (for-each (lambda (e) ((system-process system) e)) entities)))))
(if (eqv? (system-mode system) 'global)
((system-process system))
(let ((entities (map get-entity (set->list (apply query-by-components (system-criteria system))))))
(cond
((eqv? (system-mode system) 'batch) ((system-process system) entities))
((eqv? (system-mode system) 'entity) (for-each (lambda (e) ((system-process system) e)) entities))))))
(define (execute-systems)
(for-each

36
samples/bounce.scm
View file

@ -51,8 +51,6 @@
'(<rigidbody-2d>)
(lambda (body)
(let ((rbody (find rigidbody-2d? body)))
(display (get-fps))
(newline)
(set-rigidbody-2d-velocity! rbody
(vector-+ (rigidbody-2d-velocity rbody)
(vector-*
@ -110,6 +108,40 @@
(vector-+ (rigidbody-2d-velocity rbody)
(position transform)))))))
(define-record-type <key-press>
(make-key-press key)
key-press?
(key key-press-key))
(add-system
(make-system 'input
0
'global
'()
(lambda ()
(when (key-pressed? KEY_SPACE)
(push-event 'input 'boost (make-key-press 'space))))))
(add-system
(make-system 'boost-rigidbody
2
'entity
'(<rigidbody-2d>)
(lambda (ball)
(let ((rbody (find rigidbody-2d? ball)))
(when (peek-event 'input 'boost)
(set-rigidbody-2d-velocity! rbody
(vector-* (make-vector2 2 2)
(rigidbody-2d-velocity rbody))))))))
(add-system
(make-system 'clear-boost-input
10
'global
'()
(lambda ()
(pop-event 'input 'boost))))
(create-entity
(make-visual-2d
(make-circle-2d