(module (bounce) ()
(import scheme
	(chicken base)
	raylib
	(engine core)
	(engine components core)
	(engine math)
	(engine drawing)
	(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 (_ 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>
  (make-rigidbody-2d velocity)
  rigidbody-2d?
  (velocity rigidbody-2d-velocity set-rigidbody-2d-velocity!))

(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+))))))

(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)))))))

(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)))))))

(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)))))))

(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))))))

(register-action 'boost 'key-press KEY_SPACE)

(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)))))))

(add-system
 (make-system 'clear-boost
	      4
	      'global
	      '()
	      (lambda ()
		(pop-event 'input 'boost))))

(define (make-ball position velocity color)
  (create-entity
   (make-visual-2d
    (make-circle-2d
     (vec 0 0)
     +ball-radius+
     #t)
    color
    0)
   (make-screen-transform
    position
    (vec 0 0)
    0
    (vec 1 1)
    'center
    'none)
   (make-rigidbody-2d velocity)))

(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 300 300)
	   (vec -2 -2)
	   (make-color 1 0 0 1))

(create-window)
)