From b37f78330c87f0ec3f072712dad16335daefd140 Mon Sep 17 00:00:00 2001 From: BirDt_ Date: Fri, 17 Apr 2026 17:10:00 +0800 Subject: [PATCH] Pass requested entity components as arguments to 'entity systems --- engine/core.scm | 12 +++++- samples/bounce.scm | 103 ++++++++++++++++++++------------------------- 2 files changed, 57 insertions(+), 58 deletions(-) diff --git a/engine/core.scm b/engine/core.scm index 92808e2..9a432fe 100644 --- a/engine/core.scm +++ b/engine/core.scm @@ -271,7 +271,17 @@ (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)))))) + ((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) (for-each diff --git a/samples/bounce.scm b/samples/bounce.scm index 4890d51..4849f51 100644 --- a/samples/bounce.scm +++ b/samples/bounce.scm @@ -17,23 +17,21 @@ 0 'entity '( ) - (lambda (ball) - (let ((vis-2d (find visual-2d? ball)) - (transform (find screen-transform? ball))) - (when (circle-2d? (visual-2d-draw vis-2d)) - (let ((circle (visual-2d-draw vis-2d))) - (push-render-object 'screen - (visual-2d-layer vis-2d) - (lambda () - ((if (circle-2d-filled? circle) - draw-circle - draw-circle-lines) - (inexact->exact (round (+ (vector-x (position transform)) - (vector-x (circle-2d-center circle))))) - (inexact->exact (round (+ (vector-y (position transform)) - (vector-y (circle-2d-center circle))))) - (circle-2d-radius circle) - (use-color (visual-2d-color vis-2d))))))))))) + (lambda (_ vis-2d transform) + (when (circle-2d? (visual-2d-draw vis-2d)) + (let ((circle (visual-2d-draw vis-2d))) + (push-render-object 'screen + (visual-2d-layer vis-2d) + (lambda () + ((if (circle-2d-filled? circle) + draw-circle + draw-circle-lines) + (inexact->exact (round (+ (vector-x (position transform)) + (vector-x (circle-2d-center circle))))) + (inexact->exact (round (+ (vector-y (position transform)) + (vector-y (circle-2d-center circle))))) + (circle-2d-radius circle) + (use-color (visual-2d-color vis-2d)))))))))) (define-record-type @@ -49,64 +47,56 @@ 0 'entity '() - (lambda (body) - (let ((rbody (find rigidbody-2d? body))) - (set-rigidbody-2d-velocity! rbody - (vector-+ (rigidbody-2d-velocity rbody) - (vector-* - (make-vector2 (get-frame-time) - (get-frame-time)) - +gravity+))))))) + (lambda (_ rbody) + (set-rigidbody-2d-velocity! rbody + (vector-+ (rigidbody-2d-velocity rbody) + (vector-* + (make-vector2 (get-frame-time) + (get-frame-time)) + +gravity+)))))) (add-system (make-system 'apply-bounce 1 'entity '( ) - (lambda (ball) - (let ((rbody (find rigidbody-2d? ball)) - (transform (find screen-transform? ball))) - (when (> (vector-y (position transform)) (- (cdr (*window-size*)) +ball-radius+)) - (set-rigidbody-2d-velocity! rbody - (make-vector2 (vector-x (rigidbody-2d-velocity rbody)) (* -1 (vector-y (rigidbody-2d-velocity rbody)))))))))) + (lambda (_ rbody transform) + (when (> (vector-y (position transform)) (- (cdr (*window-size*)) +ball-radius+)) + (set-rigidbody-2d-velocity! rbody + (make-vector2 (vector-x (rigidbody-2d-velocity rbody)) (* -1 (vector-y (rigidbody-2d-velocity rbody))))))))) (add-system (make-system 'apply-wall-bounce 1 'entity '( ) - (lambda (ball) - (let ((rbody (find rigidbody-2d? ball)) - (transform (find screen-transform? ball))) - (when (or (> (vector-x (position transform)) (- (car (*window-size*)) +ball-radius+)) - (< (vector-x (position transform)) (+ 0 +ball-radius+))) - (set-rigidbody-2d-velocity! rbody - (make-vector2 (* -1 (vector-x (rigidbody-2d-velocity rbody))) (vector-y (rigidbody-2d-velocity rbody))))))))) + (lambda (_ rbody transform) + (when (or (> (vector-x (position transform)) (- (car (*window-size*)) +ball-radius+)) + (< (vector-x (position transform)) (+ 0 +ball-radius+))) + (set-rigidbody-2d-velocity! rbody + (make-vector2 (* -1 (vector-x (rigidbody-2d-velocity rbody))) (vector-y (rigidbody-2d-velocity rbody)))))))) (add-system (make-system 'apply-friction 2 'entity '() - (lambda (ball) - (let ((rbody (find rigidbody-2d? ball))) - (set-rigidbody-2d-velocity! rbody - (vector-+ (rigidbody-2d-velocity rbody) - (vector-* - (make-vector2 (* (get-frame-time) +friction+) (* (get-frame-time) +friction+)) - (rigidbody-2d-velocity rbody)))))))) + (lambda (_ rbody) + (set-rigidbody-2d-velocity! rbody + (vector-+ (rigidbody-2d-velocity rbody) + (vector-* + (make-vector2 (* (get-frame-time) +friction+) (* (get-frame-time) +friction+)) + (rigidbody-2d-velocity rbody))))))) (add-system (make-system 'move-rigidbody 3 'entity '( ) - (lambda (ball) - (let ((rbody (find rigidbody-2d? ball)) - (transform (find screen-transform? ball))) - (set-position! transform - (vector-+ (rigidbody-2d-velocity rbody) - (position transform))))))) + (lambda (_ rbody transform) + (set-position! transform + (vector-+ (rigidbody-2d-velocity rbody) + (position transform)))))) (define-record-type (make-key-press key) @@ -127,12 +117,11 @@ 2 'entity '() - (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)))))))) + (lambda (_ rbody) + (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