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

Add scene system and update example

Browse source
This commit is contained in:
BirDt_ 2026-04-19 10:15:18 +08:00
parent e7bfc01f7b
commit f54f9c4b40
3 changed files with 197 additions and 115 deletions
Download patch file Download diff file Expand all files Collapse all files

222
samples/bounce.scm
View file

@ -6,6 +6,7 @@
(engine components core)
(engine math)
(engine drawing)
(engine scene)
(srfi 1)
(srfi 99))
@ -14,24 +15,24 @@
(define +ball-radius+ 50)
(add-system
(make-system 'draw-circles
0
'entity
'(<visual-2d> <screen-transform>)
(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 ()
(let ((draw-pos (v+ (position transform)
(circle-2d-center circle))))
(draw-circle-2d
draw-pos
(circle-2d-radius circle)
(visual-2d-color vis-2d)
(circle-2d-filled? circle))))))))))
(define draw-circles
(make-system 'draw-circles
0
'entity
'(<visual-2d> <screen-transform>)
(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 ()
(let ((draw-pos (v+ (position transform)
(circle-2d-center circle))))
(draw-circle-2d
draw-pos
(circle-2d-radius circle)
(visual-2d-color vis-2d)
(circle-2d-filled? circle))))))))))
(define-record-type <rigidbody-2d>
@ -42,85 +43,96 @@
(define +gravity+ (vec 0 9.8))
(define +friction+ -0.1)
(add-system
(make-system 'apply-gravity
0
'entity
'(<rigidbody-2d>)
(lambda (_ rbody)
(set-rigidbody-2d-velocity! rbody
(v+ (rigidbody-2d-velocity rbody)
(v* (get-frame-time)
+gravity+))))))
(define apply-gravity
(make-system 'apply-gravity
0
'entity
'(<rigidbody-2d>)
(lambda (_ rbody)
(set-rigidbody-2d-velocity! rbody
(v+ (rigidbody-2d-velocity rbody)
(v* (get-frame-time)
+gravity+))))))
(add-system
(make-system 'apply-bounce
1
'entity
'(<rigidbody-2d> <screen-transform>)
(lambda (_ rbody transform)
(when (> (v-y (position transform)) (- (cdr (*window-size*)) +ball-radius+))
(set-rigidbody-2d-velocity! rbody
(v* (rigidbody-2d-velocity rbody)
(vec 1 -1)))))))
(define apply-bounce
(make-system 'apply-bounce
1
'entity
'(<rigidbody-2d> <screen-transform>)
(lambda (_ rbody transform)
(when (> (v-y (position transform)) (- (cdr (*window-size*)) +ball-radius+))
(set-rigidbody-2d-velocity! rbody
(v* (rigidbody-2d-velocity rbody)
(vec 1 -1)))))))
(add-system
(make-system 'apply-wall-bounce
1
'entity
'(<rigidbody-2d> <screen-transform>)
(lambda (_ rbody transform)
(when (or (> (v-x (position transform)) (- (car (*window-size*)) +ball-radius+))
(< (v-x (position transform)) (+ 0 +ball-radius+)))
(set-rigidbody-2d-velocity! rbody
(v* (rigidbody-2d-velocity rbody)
(vec -1 1)))))))
(define apply-wall-bounce
(make-system 'apply-wall-bounce
1
'entity
'(<rigidbody-2d> <screen-transform>)
(lambda (_ rbody transform)
(when (or (> (v-x (position transform)) (- (car (*window-size*)) +ball-radius+))
(< (v-x (position transform)) (+ 0 +ball-radius+)))
(set-rigidbody-2d-velocity! rbody
(v* (rigidbody-2d-velocity rbody)
(vec -1 1)))))))
(add-system
(make-system 'apply-friction
2
'entity
'(<rigidbody-2d>)
(lambda (_ rbody)
(set-rigidbody-2d-velocity! rbody
(v+ (rigidbody-2d-velocity rbody)
(v* (get-frame-time)
+friction+
(rigidbody-2d-velocity rbody)))))))
(define apply-friction
(make-system 'apply-friction
2
'entity
'(<rigidbody-2d>)
(lambda (_ rbody)
(set-rigidbody-2d-velocity! rbody
(v+ (rigidbody-2d-velocity rbody)
(v* (get-frame-time)
+friction+
(rigidbody-2d-velocity rbody)))))))
(add-system
(make-system 'move-rigidbody
3
'entity
'(<rigidbody-2d> <screen-transform>)
(lambda (_ rbody transform)
(set-position! transform
(v+ (rigidbody-2d-velocity rbody)
(position transform))))))
(define move-rigidbody
(make-system 'move-rigidbody
3
'entity
'(<rigidbody-2d> <screen-transform>)
(lambda (_ rbody transform)
(set-position! transform
(v+ (rigidbody-2d-velocity rbody)
(position transform))))))
(register-action 'boost 'key-press KEY_SPACE)
(register-action 'reset 'key-press KEY_R)
(add-system
(make-system 'boost-rigidbody
2
'entity
'(<rigidbody-2d>)
(lambda (_ rbody)
(when (peek-event 'input 'boost)
(set-rigidbody-2d-velocity! rbody
(v* 2
(rigidbody-2d-velocity rbody)))))))
(define boost-rigidbody
(make-system 'boost-rigidbody
2
'entity
'(<rigidbody-2d>)
(lambda (_ rbody)
(when (peek-event 'input 'boost)
(set-rigidbody-2d-velocity! rbody
(v* 2
(rigidbody-2d-velocity rbody)))))))
(add-system
(make-system 'clear-boost
4
'global
'()
(lambda ()
(pop-event 'input 'boost))))
(define clear-boost
(make-system 'clear-boost
4
'global
'()
(lambda ()
(pop-event 'input 'boost))))
(define *bounce-scene* (make-parameter (lambda () #f)))
(define reload-scene
(make-system 'reload-scene
4
'global
'()
(lambda ()
(when (pop-event 'input 'reset)
(((*bounce-scene*)))))))
(define (make-ball position velocity color)
(create-entity
(entity
(make-visual-2d
(make-circle-2d
(vec 0 0)
@ -134,20 +146,36 @@
0
(vec 1 1)
'center
'none)
'())
(make-rigidbody-2d velocity)))
(make-ball (vec 100 100)
(vec 5 1)
(make-color 0 0 1 1))
(*bounce-scene*
(lambda ()
(scene
push-actions
draw-circles
apply-gravity
apply-bounce
apply-wall-bounce
apply-friction
move-rigidbody
boost-rigidbody
clear-boost
reload-scene
(make-ball (vec 100 100)
(vec 5 1)
(make-color 0 0 1 1))
(make-ball (vec 200 200)
(vec -2 -2)
(make-color 0 1 0 1))
(make-ball (vec 200 200)
(vec -2 -2)
(make-color 0 1 0 1))
(make-ball (vec 300 300)
(vec -2 -2)
(make-color 1 0 0 1))
(make-ball (vec 300 300)
(vec -2 -2)
(make-color 1 0 0 1)))))
(((*bounce-scene*)))
(create-window)
)