(in-package #:cl-tty.input)

;;; ---------------------------------------------------------------------------
;;; Textarea class
;;; ---------------------------------------------------------------------------
(defclass textarea (dirty-mixin)
  ((value :initform "" :initarg :value :accessor textarea-value :type string)
   (cursor-row :initform 0 :accessor textarea-cursor-row :type fixnum)
   (cursor-col :initform 0 :accessor textarea-cursor-col :type fixnum)
   (selection-start :initform nil :accessor textarea-selection-start)
   (undo-stack :initform (make-array 100 :fill-pointer 0)
               :accessor textarea-undo-stack)
   (redo-stack :initform (make-array 100 :fill-pointer 0)
               :accessor textarea-redo-stack)
   (on-submit :initform nil :initarg :on-submit :accessor textarea-on-submit)
   (layout-node :initform (make-layout-node) :accessor textarea-layout-node)
   (focusable :initform t :accessor textarea-focusable)))

(defun make-textarea (&key value on-submit)
  (make-instance 'textarea
    :value (or value "")
    :on-submit on-submit))

;;; ---------------------------------------------------------------------------
;;; Line helpers
;;; ---------------------------------------------------------------------------
(defun textarea-lines (ta)
  "Split value into lines."
  (%split-string (textarea-value ta) #\Newline))

(defun textarea-line-count (ta)
  "Number of lines in value."
  (length (textarea-lines ta)))

(defun textarea-ensure-cursor (ta)
  "Clamp cursor to valid range."
  (let ((lines (textarea-lines ta)))
    (setf (textarea-cursor-row ta)
          (max 0 (min (textarea-cursor-row ta) (1- (length lines)))))
    (let ((line-len (length (nth (textarea-cursor-row ta) lines))))
      (setf (textarea-cursor-col ta)
            (max 0 (min (textarea-cursor-col ta) line-len))))))

;;; ---------------------------------------------------------------------------
;;; Utility: join strings with newline
;;; ---------------------------------------------------------------------------
(defun %join-lines (lines)
  "Join a sequence of strings with newlines."
  (with-output-to-string (s)
    (loop for line across (if (listp lines) (coerce lines 'vector) lines)
          for first = t then nil
          do (unless first (write-char #\Newline s))
             (write-string line s))))

;;; ---------------------------------------------------------------------------
;;; Text manipulation
;;; ---------------------------------------------------------------------------
(defun textarea-insert-char (ta char)
  "Insert CHAR at the cursor position."
  (textarea-push-undo ta)
  (let* ((lines (coerce (textarea-lines ta) 'vector))
         (row (textarea-cursor-row ta))
         (col (textarea-cursor-col ta)))
    (if (< row (length lines))
        (let* ((line (aref lines row))
               (new-line (concatenate 'string
                           (subseq line 0 col)
                           (string char)
                           (subseq line col))))
          (setf (aref lines row) new-line)
          (setf (textarea-value ta)
                (%join-lines lines))
          (incf (textarea-cursor-col ta))
          (mark-dirty ta))
        (progn
          (setf (textarea-value ta)
                (concatenate 'string (textarea-value ta) (string char)))
          (incf (textarea-cursor-col ta))
          (mark-dirty ta)))))

(defun textarea-newline (ta)
  "Insert a newline at the cursor."
  (textarea-push-undo ta)
  (let* ((lines (coerce (textarea-lines ta) 'vector))
         (row (textarea-cursor-row ta))
         (col (textarea-cursor-col ta)))
    (if (< row (length lines))
        (let* ((line (aref lines row))
               (before (subseq line 0 col))
               (after (subseq line col)))
          (setf (aref lines row) before)
          (let ((new-lines (concatenate 'vector
                            (subseq lines 0 (1+ row))
                            (vector after)
                            (subseq lines (1+ row)))))
            (setf (textarea-value ta)
                  (%join-lines new-lines)))
          (incf (textarea-cursor-row ta))
          (setf (textarea-cursor-col ta) 0)
          (mark-dirty ta))
        (progn
          (setf (textarea-value ta)
                (concatenate 'string (textarea-value ta) (string #\Newline)))
          (incf (textarea-cursor-row ta))
          (setf (textarea-cursor-col ta) 0)
          (mark-dirty ta)))))

(defun textarea-backspace (ta)
  "Delete character before cursor."
  (textarea-push-undo ta)
  (let* ((lines (coerce (textarea-lines ta) 'vector))
         (row (textarea-cursor-row ta))
         (col (textarea-cursor-col ta)))
    (cond
      ((and (zerop row) (zerop col))
       nil)  ;; nothing to delete
      ((zerop col)
       ;; Join with previous line
       (let* ((prev (aref lines (1- row)))
              (curr (aref lines row))
              (new-pos (length prev)))
         (setf (aref lines (1- row))
               (concatenate 'string prev curr))
         (let ((new-lines (concatenate 'vector
                           (subseq lines 0 row)
                           (subseq lines (1+ row)))))
           (setf (textarea-value ta)
                 (%join-lines new-lines)))
         (decf (textarea-cursor-row ta))
         (setf (textarea-cursor-col ta) new-pos)
         (mark-dirty ta)))
      (t
       (let* ((line (aref lines row))
              (new-line (concatenate 'string
                          (subseq line 0 (1- col))
                          (subseq line col))))
         (setf (aref lines row) new-line)
         (setf (textarea-value ta)
               (%join-lines lines))
         (decf (textarea-cursor-col ta))
         (mark-dirty ta))))))

;;; ---------------------------------------------------------------------------
;;; Cursor movement
;;; ---------------------------------------------------------------------------
(defun textarea-move-up (ta)
  (decf (textarea-cursor-row ta))
  (textarea-ensure-cursor ta))

(defun textarea-move-down (ta)
  (incf (textarea-cursor-row ta))
  (textarea-ensure-cursor ta))

;;; ---------------------------------------------------------------------------
;;; Undo/redo
;;; ---------------------------------------------------------------------------
(defun textarea-push-undo (ta)
  "Save current value on undo stack."
  (let ((stack (textarea-undo-stack ta)))
    (when (>= (length stack) (array-total-size stack))
      (loop for i from 1 below (length stack)
            do (setf (aref stack (1- i)) (aref stack i)))
      (decf (fill-pointer stack)))
    (vector-push (textarea-value ta) stack)
    (setf (fill-pointer (textarea-redo-stack ta)) 0)))

(defun textarea-undo (ta)
  (let ((stack (textarea-undo-stack ta)))
    (when (plusp (length stack))
      (let ((prev (vector-pop stack)))
        (vector-push (textarea-value ta) (textarea-redo-stack ta))
        (setf (textarea-value ta) prev)
        (textarea-ensure-cursor ta)
        (mark-dirty ta)))))

(defun textarea-redo (ta)
  (let ((stack (textarea-redo-stack ta)))
    (when (plusp (length stack))
      (let ((next (vector-pop stack)))
        (vector-push (textarea-value ta) (textarea-undo-stack ta))
        (setf (textarea-value ta) next)
        (textarea-ensure-cursor ta)
        (mark-dirty ta)))))

;;; ---------------------------------------------------------------------------
;;; Key event handler
;;; ---------------------------------------------------------------------------
(defun handle-textarea-input (ta event)
  "Process a key-event on a textarea widget."
  (cond
    ((key-event-ctrl event)
     (case (key-event-key event)
       (:z (textarea-undo ta))
       (:y (textarea-redo ta))
       ;; Ctrl+A/E: home/end
       (:a (setf (textarea-cursor-col ta) 0))
       (:e (let ((lines (textarea-lines ta)))
             (when (< (textarea-cursor-row ta) (length lines))
               (setf (textarea-cursor-col ta)
                     (length (nth (textarea-cursor-row ta) lines))))))
        (t nil)))
    (t
     (case (key-event-key event)
       (:left (decf (textarea-cursor-col ta))
              (textarea-ensure-cursor ta))
       (:right (incf (textarea-cursor-col ta))
               (textarea-ensure-cursor ta))
       (:up (textarea-move-up ta))
       (:down (textarea-move-down ta))
       (:home (setf (textarea-cursor-col ta) 0))
       (:end (let ((lines (textarea-lines ta)))
               (when (< (textarea-cursor-row ta) (length lines))
                 (setf (textarea-cursor-col ta)
                       (length (nth (textarea-cursor-row ta) lines))))))
       (:enter (let ((cb (textarea-on-submit ta)))
                 (if cb
                     (funcall cb (textarea-value ta))
                     (textarea-newline ta))))
       (:backspace (textarea-backspace ta))
       (:delete (let* ((lines (textarea-lines ta))
                       (row (textarea-cursor-row ta))
                       (col (textarea-cursor-col ta))
                       (line (nth row lines)))
                  (when (and line (< col (length line)))
                    (textarea-push-undo ta)
                    (setf (nth row lines)
                          (concatenate 'string
                            (subseq line 0 col)
                            (subseq line (1+ col))))
                    (setf (textarea-value ta)
                          (%join-lines lines))
                    (mark-dirty ta))))
       ;; Character insertion
       (otherwise
        (let ((ch (code-char (key-event-code event))))
          (when (and ch (graphic-char-p ch))
            (textarea-insert-char ta ch))))))))

;;; ---------------------------------------------------------------------------
;;; Rendering
;;; ---------------------------------------------------------------------------
(defmethod render ((ta textarea) (backend t))
  "Render textarea lines at layout position."
  (let* ((ln (textarea-layout-node ta))
         (x (if ln (layout-node-x ln) 0))
         (y (if ln (layout-node-y ln) 0))
         (w (if ln (layout-node-width ln) 80))
         (h (if ln (layout-node-height ln) 24))
         (lines (textarea-lines ta))
         (max-lines (min (length lines) h)))
    (loop for i from 0 below max-lines
          for line in lines
          do (draw-text backend x (+ y i)
                        (subseq line 0 (min (length line) w))
                        nil nil))))