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

feature/basic-samples #13

Merged
BirDt merged 2 commits from feature/basic-samples into master 2026-04-16 18:52:07 +08:00
Conversation 0 Commits 2 Files changed 2 +41 -7
2 changed files with 41 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files
Showing only changes of commit d379cd28d7 - Show all commits

6
engine/core.scm
View file

@ -162,7 +162,7 @@
(define (make-system name priority mode criteria process) (define (make-system name priority mode criteria process)
(assert (symbol? name)) (assert (symbol? name))
(assert (integer? priority)) (assert (integer? priority))
(assert (member mode '(entity batch))) (assert (member mode '(entity batch global)))
(assert (every symbol? criteria)) (assert (every symbol? criteria))
(assert (procedure? process)) (assert (procedure? process))
(int:make-system name priority mode criteria process)) (int:make-system name priority mode criteria process))
@ -266,10 +266,12 @@
;; Execute a single system ;; Execute a single system
(define (execute-system system) (define (execute-system system)
(assert (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)))))) (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) ((system-process system) e)) entities))))))
(define (execute-systems) (define (execute-systems)
(for-each (for-each

36
samples/bounce.scm
View file

@ -51,8 +51,6 @@
'(<rigidbody-2d>) '(<rigidbody-2d>)
(lambda (body) (lambda (body)
(let ((rbody (find rigidbody-2d? body))) (let ((rbody (find rigidbody-2d? body)))
(display (get-fps))
(newline)
(set-rigidbody-2d-velocity! rbody (set-rigidbody-2d-velocity! rbody
(vector-+ (rigidbody-2d-velocity rbody) (vector-+ (rigidbody-2d-velocity rbody)
(vector-* (vector-*
@ -110,6 +108,40 @@
(vector-+ (rigidbody-2d-velocity rbody) (vector-+ (rigidbody-2d-velocity rbody)
(position transform))))))) (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 (create-entity
(make-visual-2d (make-visual-2d
(make-circle-2d (make-circle-2d