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

Finish bouncing balls example

Browse source
This commit is contained in:
BirDt_ 2026-04-16 17:37:38 +08:00
parent d9f8f6f0d2
commit 69477db047
1 changed files with 119 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

126
samples/bounce.scm
View file

@ -4,11 +4,14 @@
raylib
(engine core)
(engine components core)
(srfi 1))
(srfi 1)
(srfi 99))
(*window-title* "Bounce!")
(*target-fps* 60)
(define +ball-radius+ 50)
(add-system
(make-system 'draw-circles
0
@ -25,19 +28,93 @@
((if (circle-2d-filled? circle)
draw-circle
draw-circle-lines)
(+ (vector-x (position transform))
(vector-x (circle-2d-center circle)))
(+ (vector-y (position transform))
(vector-y (circle-2d-center circle)))
(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)))))
(circle-2d-radius circle)
(use-color (visual-2d-color vis-2d)))))))))))
(define-record-type <rigidbody-2d>
(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
'(<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-*
(make-vector2 (get-frame-time)
(get-frame-time))
+gravity+)))))))
(add-system
(make-system 'apply-bounce
1
'entity
'(<rigidbody-2d> <screen-transform>)
(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
'(<rigidbody-2d> <screen-transform>)
(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
'(<rigidbody-2d>)
(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
'(<rigidbody-2d> <screen-transform>)
(lambda (ball)
(let ((rbody (find rigidbody-2d? ball))
(transform (find screen-transform? ball)))
(set-position! transform
(vector-+ (rigidbody-2d-velocity rbody)
(position transform)))))))
(create-entity
(make-visual-2d
(make-circle-2d
(make-vector2 0 0)
50
+ball-radius+
#t)
(make-color 0 0 1 1)
0)
@ -47,7 +124,42 @@
0
(make-vector2 1 1)
'center
'none))
'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)))
(create-window)
)