(module (bounce) ()
(import scheme
	(chicken base)
	raylib
	(engine core)
	(engine components core)
	(srfi 1)
	(srfi 99))

(*window-title* "Bounce!")
(*target-fps* 60)

(define +ball-radius+ 50)

(add-system
 (make-system 'draw-circles
	      0
	      'entity
	      '(<visual-2d> <screen-transform>)
	      (lambda (ball)
		(let ((vis-2d (find visual-2d? ball))
		      (transform (find screen-transform? ball)))
		  (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 ()
					    ((if (circle-2d-filled? circle)
						 draw-circle
						 draw-circle-lines)
					     (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)
   +ball-radius+
   #t)
  (make-color 0 0 1 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 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)
)