(module (bd ui) ()
(import scheme
	(chicken base)
	(chicken module)
	raylib
	(imugi core)
	(imugi math)
	(imugi drawing)
	(imugi resource)
	(imugi input)
	(srfi 1)
	(srfi 4)
	(srfi 99))

(define base-font (font "../res/fonts/Felipa-Regular.ttf"))

(define-record-type <label>
  (int:make-label position centered? layer font font-size color text)
  label?
  (position label-pos set-label-pos!)
  (centered? label-centered? set-label-centered!)
  (layer label-layer set-label-layer!)
  (font-size label-size set-label-size!)
  (font label-font set-label-font!)
  (color label-color set-label-color!)
  (text label-text set-label-text!))

(export title)
(define (title position text
	       #!key
	       (centered (cons #f #f))
	       (layer 0)
	       (font base-font)
	       (size 128)
	       (color (make-color 0 0 0 1)))
  (int:make-label position centered layer font size color text))

(export subtitle)
(define (subtitle position text
		  #!key
		  (centered (cons #f #f))
		  (layer 0)
		  (font base-font)
		  (size 36)
		  (color (make-color 0 0 0 1)))
  (int:make-label position centered layer font size color text))

(export footer)
(define (footer position text
		#!key
		(centered (cons #f #f))
		(layer 0)
		(font base-font)
		(size 24)
		(color (make-color 0 0 0 1)))
  (int:make-label position centered layer font size color text))

(export draw-labels)
(define draw-labels
  (make-system
   'draw-labels
   10
   'entity
   '(<label>)
   (lambda (_ label)
     (push-render-object
      'screen
      (label-layer label)
      (lambda ()
	(let* (;; measure text length in pixels in case
	       ;; we need it for horizontal centering
	       (text-length (f32vector->list
			     (measure-text-ex
			      (resource-contents (label-font label))
			      (label-text label)
			      (label-size label)
			      1)))
	       ;; center the x/y of the position
	       ;; based on label-centered?
	       (draw-pos (vec
			  (if (car (label-centered? label))
			      (- (/ (car (*window-size*))
				    2)
				 (/ (car text-length)
				    2))
			      (v-x (label-pos label)))
			  (if (cdr (label-centered? label))
			      (- (/ (cdr (*window-size*))
				    2)
				 (cadr text-length))
			      (v-y (label-pos label))))))
	  (draw-font-text-2d
	   draw-pos
	   (label-text label)
	   (label-size label)
	   (label-color label)
	   (label-font label))))))))

(define-record-type <button>
  (int:make-button position size layer label state click-fn colors)
  button?
  (position button-pos set-button-pos!)
  (size button-size set-button-size!)
  (layer button-layer set-button-layer!)
  (label button-label set-button-label!)
  (state button-state set-button-state!)
  (click-fn button-click-fn set-button-click-fn!)
  (colors button-colors set-button-colors!))

(export button)
(define (button position label click-fn
		#!key
		(layer 0)
		(size (vec 100 60))
		(colors (list (make-color 0.48 0.48 0.48 1)
			      (make-color 0.63 0.63 0.63 1)
			      (make-color 0.39 0.39 0.39 1))))
  (int:make-button position size layer label 'ready click-fn colors))

(define (check-button-state button)
  (let ((x-range (cons (v-x (button-pos button))
		       (+ (v-x (button-pos button))
			  (v-x (button-size button)))))
	(y-range (cons (v-y (button-pos button))
		       (+ (v-y (button-pos button))
			  (v-y (button-size button)))))
	(mouse-pos (cons (get-mouse-x) (get-mouse-y))))
    (if (and (< (car x-range) (car mouse-pos) (cdr x-range))
	     (< (car y-range) (cdr mouse-pos) (cdr y-range)))
	(if (peek-event 'input 'click)
	    (set-button-state! button 'clicked)
	    (set-button-state! button 'hovered))
	(set-button-state! button 'ready))))

(define (draw-button button)
  (push-render-object
   'screen
   (button-layer button)
   (lambda ()
     (draw-rectangle-2d
      (button-pos button)
      (number->integer (v-x (button-size button)))
      (number->integer (v-y (button-size button)))
      (list-ref (button-colors button)
		(case (button-state button)
		  ((ready) 0)
		  ((hovered) 1)
		  ((clicked) 2)))
      #t
      1)))
  (let* ((txt (button-label button))
	 (text-length (f32vector->list
		       (measure-text-ex
			(resource-contents (label-font txt))
			(label-text txt)
			(label-size txt)
			1)))
	 (center-offset (vec (- (/ (v-x (button-size button))
				   2)
				(/ (car text-length)
				   2))
			     (- (/ (v-y (button-size button))
				   2)
				(/ (cadr text-length)
				   2)))))
    (push-render-object
     'screen
     (+ 1 (button-layer button))
     (lambda ()
       (draw-font-text-2d
	(v+ (button-pos button)
	    center-offset)
	(label-text txt)
	(label-size txt)
	(label-color txt)
	(label-font txt))))))

(define (do-button-callback button)
  (when (eqv? 'clicked (button-state button))
    ((button-click-fn button))))

(export handle-buttons)
(define handle-buttons
  (make-system
   'handle-buttons
   10
   'batch
   '(<button>)
   (lambda (buttons)
     (for-each
      (lambda (b)	
	(let ((button (find button? b)))
	  (check-button-state button)
	  (draw-button button)
	  (do-button-callback button)))
      buttons)
     (pop-event 'input 'click))))
)