diff --git a/samples/bounce.scm b/samples/bounce.scm index f365c9d..896a09d 100644 --- a/samples/bounce.scm +++ b/samples/bounce.scm @@ -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 + (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 + '() + (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 + '( ) + (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 + '( ) + (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 + '() + (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 + '( ) + (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) )