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

Simplifying engine interface #14

Merged
BirDt merged 14 commits from feature/basic-samples into master 2026-04-18 09:12:01 +08:00
Conversation 0 Commits 14 Files changed 6 +57 -58
2 changed files with 57 additions and 58 deletions
Download patch file Download diff file Expand all files Collapse all files
Showing only changes of commit b37f78330c - Show all commits

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

103
samples/bounce.scm
View file

@ -17,23 +17,21 @@
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)) (when (circle-2d? (visual-2d-draw vis-2d))
(transform (find screen-transform? ball))) (let ((circle (visual-2d-draw vis-2d)))
(when (circle-2d? (visual-2d-draw vis-2d)) (push-render-object 'screen
(let ((circle (visual-2d-draw vis-2d))) (visual-2d-layer vis-2d)
(push-render-object 'screen (lambda ()
(visual-2d-layer vis-2d) ((if (circle-2d-filled? circle)
(lambda () draw-circle
((if (circle-2d-filled? circle) draw-circle-lines)
draw-circle (inexact->exact (round (+ (vector-x (position transform))
draw-circle-lines) (vector-x (circle-2d-center circle)))))
(inexact->exact (round (+ (vector-x (position transform)) (inexact->exact (round (+ (vector-y (position transform))
(vector-x (circle-2d-center circle))))) (vector-y (circle-2d-center circle)))))
(inexact->exact (round (+ (vector-y (position transform)) (circle-2d-radius circle)
(vector-y (circle-2d-center circle))))) (use-color (visual-2d-color vis-2d))))))))))
(circle-2d-radius circle)
(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)) (when (> (vector-y (position transform)) (- (cdr (*window-size*)) +ball-radius+))
(transform (find screen-transform? ball))) (set-rigidbody-2d-velocity! rbody
(when (> (vector-y (position transform)) (- (cdr (*window-size*)) +ball-radius+)) (make-vector2 (vector-x (rigidbody-2d-velocity rbody)) (* -1 (vector-y (rigidbody-2d-velocity rbody)))))))))
(set-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)) (when (or (> (vector-x (position transform)) (- (car (*window-size*)) +ball-radius+))
(transform (find screen-transform? ball))) (< (vector-x (position transform)) (+ 0 +ball-radius+)))
(when (or (> (vector-x (position transform)) (- (car (*window-size*)) +ball-radius+)) (set-rigidbody-2d-velocity! rbody
(< (vector-x (position transform)) (+ 0 +ball-radius+))) (make-vector2 (* -1 (vector-x (rigidbody-2d-velocity rbody))) (vector-y (rigidbody-2d-velocity rbody))))))))
(set-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)) (set-position! transform
(transform (find screen-transform? ball))) (vector-+ (rigidbody-2d-velocity rbody)
(set-position! transform (position transform))))))
(vector-+ (rigidbody-2d-velocity rbody)
(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