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

Pass requested entity components as arguments to 'entity systems

Browse source
This commit is contained in:
BirDt_ 2026-04-17 17:10:00 +08:00
parent d379cd28d7
commit b37f78330c
2 changed files with 57 additions and 58 deletions
Download patch file Download diff file Expand all files Collapse all files

12
engine/core.scm
View file

@ -271,7 +271,17 @@
(let ((entities (map get-entity (set->list (apply query-by-components (system-criteria system)))))) (let ((entities (map get-entity (set->list (apply query-by-components (system-criteria system))))))
(cond (cond
((eqv? (system-mode system) 'batch) ((system-process system) entities)) ((eqv? (system-mode system) 'batch) ((system-process system) entities))
((eqv? (system-mode system) 'entity) (for-each (lambda (e) ((system-process system) e)) entities)))))) ((eqv? (system-mode system) 'entity)
(for-each (lambda (e)
(apply (system-process system)
(cons e
(map (lambda (component)
(find (lambda (c)
(eqv? (rtd-name (record-rtd c))
component))
e))
(system-criteria system)))))
entities))))))
(define (execute-systems) (define (execute-systems)
(for-each (for-each

39
samples/bounce.scm
View file

@ -17,9 +17,7 @@
0 0
'entity 'entity
'(<visual-2d> <screen-transform>) '(<visual-2d> <screen-transform>)
(lambda (ball) (lambda (_ vis-2d transform)
(let ((vis-2d (find visual-2d? ball))
(transform (find screen-transform? ball)))
(when (circle-2d? (visual-2d-draw vis-2d)) (when (circle-2d? (visual-2d-draw vis-2d))
(let ((circle (visual-2d-draw vis-2d))) (let ((circle (visual-2d-draw vis-2d)))
(push-render-object 'screen (push-render-object 'screen
@ -33,7 +31,7 @@
(inexact->exact (round (+ (vector-y (position transform)) (inexact->exact (round (+ (vector-y (position transform))
(vector-y (circle-2d-center circle))))) (vector-y (circle-2d-center circle)))))
(circle-2d-radius circle) (circle-2d-radius circle)
(use-color (visual-2d-color vis-2d))))))))))) (use-color (visual-2d-color vis-2d))))))))))
(define-record-type <rigidbody-2d> (define-record-type <rigidbody-2d>
@ -49,64 +47,56 @@
0 0
'entity 'entity
'(<rigidbody-2d>) '(<rigidbody-2d>)
(lambda (body) (lambda (_ rbody)
(let ((rbody (find rigidbody-2d? body)))
(set-rigidbody-2d-velocity! rbody (set-rigidbody-2d-velocity! rbody
(vector-+ (rigidbody-2d-velocity rbody) (vector-+ (rigidbody-2d-velocity rbody)
(vector-* (vector-*
(make-vector2 (get-frame-time) (make-vector2 (get-frame-time)
(get-frame-time)) (get-frame-time))
+gravity+))))))) +gravity+))))))
(add-system (add-system
(make-system 'apply-bounce (make-system 'apply-bounce
1 1
'entity 'entity
'(<rigidbody-2d> <screen-transform>) '(<rigidbody-2d> <screen-transform>)
(lambda (ball) (lambda (_ rbody transform)
(let ((rbody (find rigidbody-2d? ball))
(transform (find screen-transform? ball)))
(when (> (vector-y (position transform)) (- (cdr (*window-size*)) +ball-radius+)) (when (> (vector-y (position transform)) (- (cdr (*window-size*)) +ball-radius+))
(set-rigidbody-2d-velocity! rbody (set-rigidbody-2d-velocity! rbody
(make-vector2 (vector-x (rigidbody-2d-velocity rbody)) (* -1 (vector-y (rigidbody-2d-velocity rbody)))))))))) (make-vector2 (vector-x (rigidbody-2d-velocity rbody)) (* -1 (vector-y (rigidbody-2d-velocity rbody)))))))))
(add-system (add-system
(make-system 'apply-wall-bounce (make-system 'apply-wall-bounce
1 1
'entity 'entity
'(<rigidbody-2d> <screen-transform>) '(<rigidbody-2d> <screen-transform>)
(lambda (ball) (lambda (_ rbody transform)
(let ((rbody (find rigidbody-2d? ball))
(transform (find screen-transform? ball)))
(when (or (> (vector-x (position transform)) (- (car (*window-size*)) +ball-radius+)) (when (or (> (vector-x (position transform)) (- (car (*window-size*)) +ball-radius+))
(< (vector-x (position transform)) (+ 0 +ball-radius+))) (< (vector-x (position transform)) (+ 0 +ball-radius+)))
(set-rigidbody-2d-velocity! rbody (set-rigidbody-2d-velocity! rbody
(make-vector2 (* -1 (vector-x (rigidbody-2d-velocity rbody))) (vector-y (rigidbody-2d-velocity rbody))))))))) (make-vector2 (* -1 (vector-x (rigidbody-2d-velocity rbody))) (vector-y (rigidbody-2d-velocity rbody))))))))
(add-system (add-system
(make-system 'apply-friction (make-system 'apply-friction
2 2
'entity 'entity
'(<rigidbody-2d>) '(<rigidbody-2d>)
(lambda (ball) (lambda (_ rbody)
(let ((rbody (find rigidbody-2d? ball)))
(set-rigidbody-2d-velocity! rbody (set-rigidbody-2d-velocity! rbody
(vector-+ (rigidbody-2d-velocity rbody) (vector-+ (rigidbody-2d-velocity rbody)
(vector-* (vector-*
(make-vector2 (* (get-frame-time) +friction+) (* (get-frame-time) +friction+)) (make-vector2 (* (get-frame-time) +friction+) (* (get-frame-time) +friction+))
(rigidbody-2d-velocity rbody)))))))) (rigidbody-2d-velocity rbody)))))))
(add-system (add-system
(make-system 'move-rigidbody (make-system 'move-rigidbody
3 3
'entity 'entity
'(<rigidbody-2d> <screen-transform>) '(<rigidbody-2d> <screen-transform>)
(lambda (ball) (lambda (_ rbody transform)
(let ((rbody (find rigidbody-2d? ball))
(transform (find screen-transform? ball)))
(set-position! transform (set-position! transform
(vector-+ (rigidbody-2d-velocity rbody) (vector-+ (rigidbody-2d-velocity rbody)
(position transform))))))) (position transform))))))
(define-record-type <key-press> (define-record-type <key-press>
(make-key-press key) (make-key-press key)
@ -127,12 +117,11 @@
2 2
'entity 'entity
'(<rigidbody-2d>) '(<rigidbody-2d>)
(lambda (ball) (lambda (_ rbody)
(let ((rbody (find rigidbody-2d? ball)))
(when (peek-event 'input 'boost) (when (peek-event 'input 'boost)
(set-rigidbody-2d-velocity! rbody (set-rigidbody-2d-velocity! rbody
(vector-* (make-vector2 2 2) (vector-* (make-vector2 2 2)
(rigidbody-2d-velocity rbody)))))))) (rigidbody-2d-velocity rbody)))))))
(add-system (add-system
(make-system 'clear-boost-input (make-system 'clear-boost-input