(in-package :cl-tui.box)

;; ── Text Renderable ────────────────────────────────────────────

(defclass span ()
  ((text :initarg :text :accessor span-text)
   (bold :initform nil :initarg :bold :accessor span-bold)
   (italic :initform nil :initarg :italic :accessor span-italic)
   (underline :initform nil :initarg :underline :accessor span-underline)
   (reverse :initform nil :initarg :reverse :accessor span-reverse)
   (dim :initform nil :initarg :dim :accessor span-dim)
   (fg :initform nil :initarg :fg :accessor span-fg)
   (bg :initform nil :initarg :bg :accessor span-bg)))

(defun span (text &key bold italic underline reverse dim fg bg)
  (make-instance 'span
    :text text :bold bold :italic italic
    :underline underline :reverse reverse :dim dim
    :fg fg :bg bg))

(defclass text (dirty-mixin)
  ((layout-node :initform (make-layout-node) :accessor text-layout-node
     :initarg :layout-node)
   (content :initform "" :initarg :content :accessor text-content)
   (spans :initform nil :initarg :spans :accessor text-spans)
   (fg :initform nil :initarg :fg :accessor text-fg)
   (bg :initform nil :initarg :bg :accessor text-bg)
   (wrap-mode :initform :word :initarg :wrap-mode :accessor text-wrap-mode)))

(defun make-text (content &key fg bg wrap-mode width height spans)
  (make-instance 'text
    :content content
    :fg fg :bg bg
    :wrap-mode (or wrap-mode :word)
    :spans spans
    :layout-node (make-layout-node :direction :column
                               :width width :height height)))

(defun render-text (text-object backend)
  "Render TEXT-OBJECT at its computed layout position using BACKEND."
  (let ((ln (text-layout-node text-object))
        (content (text-content text-object))
        (fg (text-fg text-object))
        (bg (text-bg text-object))
        (wrap (text-wrap-mode text-object))
        (spans (text-spans text-object)))
    (declare (ignore spans))
    (let ((x (layout-node-x ln))
          (y (layout-node-y ln))
          (w (layout-node-width ln))
          (h (layout-node-height ln)))
      (when (or (zerop (length content)) (zerop w) (zerop h))
        (return-from render-text (values)))
      (if (eql wrap :none)
          (let ((display (subseq content 0 (min (length content) w))))
            (draw-text backend x y display fg bg))
          (let ((lines (word-wrap content w))
                (max-lines h))
            (loop for line in lines
                  for row from 0 below max-lines
                  do (draw-text backend x (+ y row) line fg bg)))))))

(defun word-wrap (text max-width)
  "Split TEXT into lines, each <= MAX-WIDTH chars.
Breaks at word boundaries. Words exceeding MAX-WIDTH are hard-broken."
  (if (or (zerop max-width) (zerop (length text)))
      (list "")
      (let ((words (split-string text)) (lines nil) (current nil) (current-len 0))
        (dolist (word words)
          (let ((wl (length word)))
            (cond ((<= wl max-width)
                   (if (and current (<= (+ current-len 1 wl) max-width))
                       (push word current)
                       (progn
                         (when current
                           (push (format nil "~{~A~^ ~}" (nreverse current)) lines))
                         (setf current (list word))
                         (setf current-len wl))))
                  (t
                   (when current
                     (push (format nil "~{~A~^ ~}" (nreverse current)) lines)
                     (setf current nil)
                     (setf current-len 0))
                   (loop for i from 0 below wl by max-width
                         do (push (subseq word i (min (+ i max-width) wl)) lines))))))
        (when current
          (push (format nil "~{~A~^ ~}" (nreverse current)) lines))
        (or (nreverse lines) (list "")))))

(defun split-string (string)
  "Split STRING into words separated by whitespace."
  (loop with words = nil
        with start = 0
        with len = (length string)
        while (< start len)
        do (let ((ws-start (position-if (lambda (c) (find c '(#\Space #\Tab #\Newline)))
                                        string :start start)))
             (if ws-start
                 (progn
                   (when (> ws-start start)
                     (push (subseq string start ws-start) words))
                   (setf start (1+ ws-start)))
                 (progn
                   (push (subseq string start) words)
                   (setf start len))))
        finally (return (nreverse words))))