Add global systems and bounce boosting
This commit is contained in:
parent
69477db047
commit
d379cd28d7
2 changed files with 41 additions and 7 deletions
|
|
@ -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))
|
||||
(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)))))
|
||||
((eqv? (system-mode system) 'entity) (for-each (lambda (e) ((system-process system) e)) entities))))))
|
||||
|
||||
(define (execute-systems)
|
||||
(for-each
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue