; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3.  See distributed LICENSE.txt.
(in-package #:clnl-gltk)

; some notes:
; - check logic when min is greater than max
; - check logic when value is outside of bounds
;   - should make the handle disappear
; - check logic when min or max updates

; - have a hover for handle, when mousedown, do mousedown like the others
; - have a hover for the bar

; - handle "Units" from netlogo sliders
; - have display be dependent on significant digits of min/max/step

; - handle vertical sliders - this is really just the same slider just rotated, nothing special

; Height is constant for slideres in netlogo
(defvar *slider-height* 33
 "*SLIDER-HEIGHT*

VALUE TYPE:

  an integer

INITIAL VALUE:

  33

DESCRIPTION:

  The default slider height.")

(defstruct slider x y width text callback min max increment value dragging)

(defun slider (x y width text callback min max increment value)
 "SLIDER X Y WIDTH TEXT CALLBACK MIN MAX INCREMENT VALUE => SLIDER

ARGUMENTS AND VALUES:

  X: x offset, in pixels
  Y: y offset, in pixels
  WIDTH: width, in pixels
  TEXT: string for the textual display
  CALLBACK: a function
  MIN: minimum value
  MAX: maximum value
  INCREMENT: increment when moving the slider
  VALUE: inital value
  SLIDER: a slider that can later be rendered

DESCRIPTION:

  SLIDER creates a button widget.

  TODO: The rest of this description needs to be updated!"
 (make-slider
  :x x :y y :width width :text text :callback callback
  :min min :max max :value value :increment increment :dragging nil))

(defun slider-bar-left (slider)
 (with-slots (min max value width) slider
  (+ 4 (if (and value min max (/= min max)) (floor (* (- width 12) (/ value (- max min)))) 0))))

(defun set-min (slider min)
 (setf (slider-min slider) min))

(defun set-max (slider max)
 (setf (slider-max slider) max))

(defun set-value (slider value)
 (setf (slider-value slider) value))

(defun update-slider-value-from-click (slider x)
 (if
  (< x (+ (slider-x slider) (slider-bar-left slider)))
  (setf (slider-value slider) (max (slider-min slider) (- (slider-value slider) (slider-increment slider))))
  (setf (slider-value slider) (min (slider-max slider) (+ (slider-value slider) (slider-increment slider))))))

(defun update-slider-value-from-move (slider m-x)
 (with-slots (x width value min max increment) slider
  (let*
   ((left (+ x 4))
    (right (+ x width -8))
    (portion-left (/ (- m-x left) (- right left)))
    (new-value
     (max min
      (min max
       (+ min
        (* increment
         (floor
          (* portion-left (- max min))
          increment)))))))
   (when (/= value new-value)
    (setf (slider-value slider) new-value)))))

(defun in-slider (m-x m-y slider)
 (with-slots (x y width) slider
  (and (< x m-x (+ x width)) (< y m-y (+ y *slider-height*)))))

(defun in-slider-handle (m-x m-y slider)
 (and
  (in-slider-bar m-y slider)
  (let
   ((left (+ (slider-x slider) (slider-bar-left slider))))
   (< left m-x (+ left 6)))))

(defun in-slider-bar (m-y slider)
 (with-slots (y) slider
  (< (+ y 18) m-y (+ y 30))))

; Uhm, this is currently just pulled from switch, and needs to be changed to slider looking stuffs
(defmethod render ((slider slider))
 (gl:color 1f0 1f0 1f0)
 (with-slots (x y width text min max value) slider
  (gl:with-pushed-matrix
   (gl:translate x y 0)

   (gl:color 1f0 1f0 1f0)
   (gl:begin :quads)
   (gl:vertex 3 26) (gl:vertex (- width 5) 26) (gl:vertex (- width 5) 24) (gl:vertex 3 24)
   (gl:end)

   (let
    ((left (slider-bar-left slider)))
    (gl:color 0f0 0f0 0f0)
    (gl:begin :quads)
    (gl:vertex left 30) (gl:vertex (+ left 4) 30) (gl:vertex (+ left 4) 20) (gl:vertex left 20)
    (gl:end)
    (gl:color 1f0 1f0 1f0)
    (draw-border left 20 (+ left 4) 30))

   (gl:color 1f0 1f0 1f0)
   ;(gl:with-pushed-matrix (gl:translate 14 15 0) (font-print "On"))
   ;(gl:with-pushed-matrix (gl:translate 14 1 0) (font-print "Off"))

   (draw-border 0 0 width *slider-height*)

   ; when the value is large enough, value takes precidence and clips off the text, then makes the text disappear
   ; if TOO large!
   ;
   ; It also clips off text if too long, and replaces with elipses, so we can do similar
   ; (this is true for slider and switch!)
   ;  - WE HAVEN"T DONE THIS YET
   (let
    ((text
      (if (< (* *font-width* (length text)) (- width 46))
       text
       (format nil "~A..." (subseq text 0 (- (truncate (- width 46) *font-width*) 3))))))
    (gl:with-pushed-matrix
     (gl:translate 2 2 0)
     (font-print text)))

   ; Technically netlogo does not clip numbers that are too large, and just draws what it can.
   ; It's a rare edge case, but maybe we should have something to do with it
   ;  - WE HAVEN"T DONE THIS YET
   (let
    ((value-text (format nil "~A" (or value 0))))
    (gl:with-pushed-matrix
     (gl:translate (- width 4 (* (length value-text) *font-width*)) 2 0)
     (font-print value-text))))))

(defmethod reposition ((slider slider) x y)
 (setf (slider-x slider) x)
 (setf (slider-y slider) y))

(defmethod resize ((slider slider) width height)
 (declare (ignore height))
 (setf (slider-width slider) width))

(defmethod mousemove ((slider slider) m-x m-y)
 (when
  (and (slider-dragging slider) (update-slider-value-from-move slider m-x))
  (funcall (slider-callback slider) (slider-value slider))))

(defmethod mouseup ((slider slider) m-x m-y)
 (when (slider-dragging slider)
  (setf (slider-dragging slider) nil)
  (funcall (slider-callback slider) (slider-value slider))))

(defmethod mousedown ((slider slider) m-x m-y)
 (cond
  ((not (in-slider m-x m-y slider)) nil)
  ((in-slider-handle m-x m-y slider) (setf (slider-dragging slider) t))

  ; Netlogo recognizes the click even if outside the bar horizontally
  ((in-slider-bar m-y slider)
   (update-slider-value-from-click slider m-x)
   (funcall (slider-callback slider) (slider-value slider)))))