diff --git a/engine/core.scm b/engine/core.scm index 92808e2..aee7e18 100644 --- a/engine/core.scm +++ b/engine/core.scm @@ -162,7 +162,7 @@ (define (make-system name priority mode criteria process) (assert (symbol? name)) (assert (integer? priority)) - (assert (member mode '(entity batch global))) + (assert (member mode '(entity batch))) (assert (every symbol? criteria)) (assert (procedure? process)) (int:make-system name priority mode criteria process)) @@ -266,12 +266,10 @@ ;; Execute a single system (define (execute-system system) (assert (system? system)) - (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)))))) + (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 diff --git a/samples/bounce.scm b/samples/bounce.scm index 4890d51..f365c9d 100644 --- a/samples/bounce.scm +++ b/samples/bounce.scm @@ -4,14 +4,11 @@ raylib (engine core) (engine components core) - (srfi 1) - (srfi 99)) + (srfi 1)) (*window-title* "Bounce!") (*target-fps* 60) -(define +ball-radius+ 50) - (add-system (make-system 'draw-circles 0 @@ -28,125 +25,19 @@ ((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))))) + (+ (vector-x (position transform)) + (vector-x (circle-2d-center circle))) + (+ (vector-y (position transform)) + (vector-y (circle-2d-center circle))) (circle-2d-radius circle) (use-color (visual-2d-color vis-2d))))))))))) -(define-record-type - (make-rigidbody-2d velocity) - rigidbody-2d? - (velocity rigidbody-2d-velocity set-rigidbody-2d-velocity!)) - -(define +gravity+ (make-vector2 0 9.8)) -(define +friction+ -0.1) - -(add-system - (make-system 'apply-gravity - 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+))))))) - -(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)))))))))) - -(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))))))))) - -(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)))))))) - -(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))))))) - -(define-record-type - (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 - '() - (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 (make-vector2 0 0) - +ball-radius+ + 50 #t) (make-color 0 0 1 1) 0) @@ -156,42 +47,7 @@ 0 (make-vector2 1 1) 'center - 'none) - (make-rigidbody-2d (make-vector2 5 1))) - -(create-entity - (make-visual-2d - (make-circle-2d - (make-vector2 0 0) - +ball-radius+ - #t) - (make-color 0 1 0 1) - 0) - (make-screen-transform - (make-vector2 100 100) - (make-vector2 0 0) - 0 - (make-vector2 1 1) - 'center - 'none) - (make-rigidbody-2d (make-vector2 -2 -2))) - -(create-entity - (make-visual-2d - (make-circle-2d - (make-vector2 0 0) - +ball-radius+ - #t) - (make-color 1 0 0 1) - 0) - (make-screen-transform - (make-vector2 100 100) - (make-vector2 0 0) - 0 - (make-vector2 1 1) - 'center - 'none) - (make-rigidbody-2d (make-vector2 10 -5))) + 'none)) (create-window) )