passepartout/lisp/channel-tui-view.lisp

(in-package :passepartout.channel-tui)

(defun view-status (win)
  (clear win)
  (box win 0 0)
  (add-string win
   (format nil " Passepartout  ~a  [~a]  msgs:~a  scroll:~a  Rules:~a~a"
           (if (st :connected) "● Connected" "○ Disconnected")
           (string-upcase (string (st :mode)))
           (length (st :messages))
           (if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
           (or (st :rule-count) 0)
           (if (st :busy) "  …thinking" ""))
   :y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
  ;; Second line: Focus map
  (let ((focus-info (or (st :foveal-id) "")))
    (when (and focus-info (> (length focus-info) 0))
      (add-string win (format nil " [Focus: ~a]" focus-info)
                  :y 2 :x 1 :fgcolor (theme-color :timestamp))))
  (add-string win (format nil " ~a" (now)) :y 2 :x 1 :fgcolor (theme-color :timestamp))
  (refresh win))

(defun word-wrap (text width)
  "Break text into lines at word boundaries, each <= width chars.
Returns list of trimmed strings. Single words wider than width are split."
  (let ((lines '())
        (pos 0)
        (len (length text)))
    (loop while (< pos len)
          do (let ((end (min len (+ pos width))))
               (cond
                 ((>= end len)
                  (push (string-trim '(#\Space) (subseq text pos len)) lines)
                  (setf pos len))
                 ((char= (char text (1- end)) #\Space)
                  (push (string-trim '(#\Space) (subseq text pos end)) lines)
                  (setf pos end))
                 (t
                  (let ((last-space (position #\Space text :from-end t :end (1+ end) :start pos)))
                    (if (and last-space (> last-space pos))
                        (progn
                          (push (string-trim '(#\Space) (subseq text pos last-space)) lines)
                          (setf pos (1+ last-space)))
                        (progn
                          (push (string-trim '(#\Space) (subseq text pos end)) lines)
                          (setf pos end))))))))
    (nreverse lines)))

(defun view-chat (win h)
  (clear win)
  (box win 0 0)
  (let* ((w (or (width win) 78))
         (msgs (st :messages))
         (total (length msgs))
         (max-lines (- h 2))
         (y 1))
    ;; Count visible messages from end, accounting for word wrap
    (let* ((msg-count 0)
           (lines-remaining max-lines))
      (loop for i from (1- total) downto 0
            while (> lines-remaining 0)
            do (let* ((msg (aref msgs i))
                      (role (getf msg :role))
                      (content (getf msg :content))
                      (time (or (getf msg :time) ""))
                      (prefix (case role (:user "⬆") (:agent "⬇") (t "  ")))
                      (line-text (format nil "~a [~a] ~a" prefix time content))
                      (wrapped (word-wrap line-text (- w 2)))
                      (nlines (length wrapped)))
                 (if (<= nlines lines-remaining)
                     (progn (decf lines-remaining nlines) (incf msg-count))
                     (setf lines-remaining 0))))
      ;; Render from the correct starting message
      (let* ((scroll-skip (st :scroll-offset))
             (start (max 0 (- total msg-count scroll-skip))))
        (loop for i from start below total
              while (< y (1- h))
              do (let* ((msg (aref msgs i))
                        (role (getf msg :role))
                        (content (getf msg :content))
                        (time (or (getf msg :time) ""))
                        (color (theme-color (case role (:user :user) (:agent :agent) (:system :system) (t :agent))))
                        (prefix (case role (:user "⬆") (:agent "⬇") (t "  ")))
                        (line-text (format nil "~a [~a] ~a" prefix time content))
                        (wrapped (word-wrap line-text (- w 2))))
                   (dolist (line wrapped)
                     (when (< y (1- h))
                       (add-string win line :y y :x 1 :n (1- w) :fgcolor color)
                        (incf y))))))))
  (refresh win))

(defun view-input (win)
  (let* ((text (input-string))
         (w (or (width win) 78))
         (pos (or (st :cursor-pos) 0))
         (display-start (max 0 (- pos (1- w))))
         (visible (subseq text display-start (min (length text) (+ display-start w)))))
    (clear win)
    (add-string win (format nil "~a " visible) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
    (setf (cursor-position win) (list 0 (min (- pos display-start) (1- w)))))
  (refresh win))

(defun redraw (sw cw ch iw)
  (destructuring-bind (sd cd id) (st :dirty)
    (when sd (view-status sw))
    (when cd (view-chat cw ch))
    (when id (view-input iw))
     (setf (st :dirty) (list nil nil nil))))

(in-package :passepartout)

(defun char-width (ch)
  "Returns the terminal column width of character CH.
ASCII < 128 = 1. CJK, fullwidth, emoji = 2. Combining marks = 0. Tab = 8."
  (let ((code (char-code ch)))
    (cond
      ((= code 9) 8)
      ((< code 32) 0)
      ((<= code 127) 1)
      ((<= #x4E00 code #x9FFF) 2)
      ((<= #x3400 code #x4DBF) 2)
      ((<= #x3040 code #x309F) 2)
      ((<= #x30A0 code #x30FF) 2)
      ((<= #xAC00 code #xD7AF) 2)
      ((<= #xFF01 code #xFF60) 2)
      ((<= #xFFE0 code #xFFE6) 2)
      ((<= #x1F300 code #x1F9FF) 2)
      ((<= #x2600 code #x27BF) 2)
      ((<= #x0300 code #x036F) 0)
      ((<= #x20D0 code #x20FF) 0)
      ((<= #xFE00 code #xFE0F) 0)
      (t 1))))

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :fiveam :silent t))

(defpackage :passepartout-tui-view-tests
  (:use :cl :fiveam :passepartout)
  (:export #:tui-view-suite))

(in-package :passepartout-tui-view-tests)

(def-suite tui-view-suite :description "TUI view rendering helpers")
(in-suite tui-view-suite)

(test test-char-width-ascii
  "Contract 5: ASCII characters (< 128) have width 1."
  (is (= 1 (passepartout::char-width #\a)))
  (is (= 1 (passepartout::char-width #\Space)))
  (is (= 1 (passepartout::char-width #\@))))

(test test-char-width-tab
  "Contract 5: tab character has width 8."
  (is (= 8 (passepartout::char-width #\Tab))))

(test test-char-width-cjk
  "Contract 5: CJK characters have width 2."
  (is (= 2 (passepartout::char-width #\日))))

(test test-char-width-null
  "Contract 5: null has width 0."
  (is (= 0 (passepartout::char-width #\Nul))))