Compare commits
3 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
| ae994fa452 | |||
| 9350cb855e | |||
| 0861ac26f1 |
@@ -88,6 +88,22 @@
|
||||
(progn (funcall 'unfocus)
|
||||
(add-msg :system "Popped context"))
|
||||
(add-msg :system "Context manager not loaded")))
|
||||
;; /quit — save history and exit
|
||||
((or (string-equal text "/quit") (string-equal text "/q"))
|
||||
(let ((hist-file (merge-pathnames ".cache/passepartout/history"
|
||||
(user-homedir-pathname))))
|
||||
(uiop:ensure-all-directories-exist (list hist-file))
|
||||
(with-open-file (out hist-file :direction :output
|
||||
:if-exists :supersede :if-does-not-exist :create)
|
||||
(dolist (entry (reverse (st :input-history)))
|
||||
(write-line entry out))))
|
||||
(add-msg :system "* Goodbye *")
|
||||
(send-daemon (list :type :event :payload '(:action :quit)))
|
||||
(setf (st :running) nil))
|
||||
;; /reconnect — re-establish daemon connection
|
||||
((string-equal text "/reconnect")
|
||||
(disconnect-daemon)
|
||||
(connect-daemon))
|
||||
;; Normal message
|
||||
(t
|
||||
(add-msg :user text)
|
||||
@@ -95,6 +111,7 @@
|
||||
(send-daemon (list :type :event
|
||||
:payload (list :sensor :user-input :text text)))))
|
||||
(setf (st :input-buffer) nil)
|
||||
(setf (st :cursor-pos) 0)
|
||||
(setf (st :dirty) (list t t t))))))
|
||||
;; Tab — command completion
|
||||
((or (eql ch 9) (eq ch :tab))
|
||||
@@ -113,8 +130,18 @@
|
||||
;; Backspace
|
||||
((or (eq ch :backspace) (eql ch 127) (eql ch 8)
|
||||
(eql ch #\Backspace))
|
||||
(when (st :input-buffer) (pop (st :input-buffer)))
|
||||
(input-delete-char)
|
||||
(setf (st :dirty) (list nil nil t)))
|
||||
;; Left arrow
|
||||
((or (eq ch :left) (eql ch 260))
|
||||
(when (> (or (st :cursor-pos) 0) 0)
|
||||
(decf (st :cursor-pos))
|
||||
(setf (st :dirty) (list nil nil t))))
|
||||
;; Right arrow
|
||||
((or (eq ch :right) (eql ch 261))
|
||||
(when (< (or (st :cursor-pos) 0) (length (st :input-buffer)))
|
||||
(incf (st :cursor-pos))
|
||||
(setf (st :dirty) (list nil nil t))))
|
||||
;; Up arrow
|
||||
((or (eq ch :up) (eql ch 259))
|
||||
(let* ((h (st :input-history)) (p (st :input-hpos)))
|
||||
@@ -135,7 +162,8 @@
|
||||
(setf (st :dirty) (list nil nil t)))))
|
||||
;; PageUp
|
||||
((or (eq ch :ppage) (eql ch 339))
|
||||
(incf (st :scroll-offset) 5)
|
||||
(let ((max-offset (max 0 (- (length (st :messages)) 1))))
|
||||
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 5))))
|
||||
(setf (st :dirty) (list nil t nil)))
|
||||
;; PageDown
|
||||
((or (eq ch :npage) (eql ch 338))
|
||||
@@ -148,7 +176,7 @@
|
||||
(integer (code-char ch))
|
||||
(t nil))))
|
||||
(when (and chr (graphic-char-p chr))
|
||||
(push chr (st :input-buffer))
|
||||
(input-insert-char chr)
|
||||
(setf (st :dirty) (list nil nil t))))))))
|
||||
|
||||
(defun on-daemon-msg (msg)
|
||||
@@ -190,11 +218,28 @@
|
||||
(error () nil)))
|
||||
|
||||
(defun reader-loop (s)
|
||||
(let ((consecutive-nils 0))
|
||||
(loop while (and (st :running) (open-stream-p s))
|
||||
do (let ((msg (recv-daemon s)))
|
||||
(if msg
|
||||
(queue-event (list :type :daemon :payload msg))
|
||||
(sleep 0.5)))))
|
||||
(progn (queue-event (list :type :daemon :payload msg))
|
||||
(setf consecutive-nils 0))
|
||||
(progn (sleep 0.5)
|
||||
(incf consecutive-nils)
|
||||
(when (> consecutive-nils 10)
|
||||
(queue-event (list :type :disconnected))
|
||||
(return))))))))
|
||||
|
||||
(defun load-history ()
|
||||
"Load input history from disk on TUI startup."
|
||||
(let ((hist-file (merge-pathnames ".cache/passepartout/history"
|
||||
(user-homedir-pathname))))
|
||||
(when (uiop:file-exists-p hist-file)
|
||||
(with-open-file (in hist-file :direction :input)
|
||||
(loop for line = (read-line in nil nil)
|
||||
while line
|
||||
do (push line (st :input-history))))
|
||||
(setf (st :input-history) (nreverse (st :input-history))))))
|
||||
|
||||
(defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
|
||||
(add-msg :system "* Connecting to daemon... *")
|
||||
@@ -228,6 +273,7 @@
|
||||
|
||||
(defun tui-main ()
|
||||
(init-state)
|
||||
(load-history)
|
||||
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
|
||||
(let* ((h (or (height scr) 24))
|
||||
(w (or (width scr) 80))
|
||||
@@ -240,7 +286,9 @@
|
||||
4006)))
|
||||
(setf (function-keys-enabled-p iw) t
|
||||
(input-blocking iw) nil
|
||||
(st :dirty) (list t t t))
|
||||
(st :dirty) (list t t t)
|
||||
;; Store windows in state for SIGWINCH handler
|
||||
(st :scr) scr (st :sw) sw (st :cw) cw (st :iw) iw)
|
||||
(connect-daemon)
|
||||
(when (> swank-port 0)
|
||||
(handler-case
|
||||
@@ -258,11 +306,34 @@
|
||||
(refresh scr)
|
||||
(loop while (st :running) do
|
||||
(dolist (ev (drain-queue))
|
||||
(when (eq (getf ev :type) :daemon)
|
||||
(on-daemon-msg (getf ev :payload))))
|
||||
(cond
|
||||
((eq (getf ev :type) :daemon)
|
||||
(on-daemon-msg (getf ev :payload)))
|
||||
((eq (getf ev :type) :disconnected)
|
||||
(setf (st :connected) nil
|
||||
(st :busy) nil)
|
||||
(add-msg :system "* Connection lost — type /reconnect to retry *"))))
|
||||
(let ((ch (get-char iw)))
|
||||
(when (and ch (not (equal ch -1)))
|
||||
(on-key ch)))
|
||||
(cond
|
||||
((or (not ch) (equal ch -1)) nil)
|
||||
;; KEY_RESIZE — terminal was resized (SIGWINCH from ncurses)
|
||||
((eql ch 410)
|
||||
(let* ((new-h (or (height scr) 24))
|
||||
(new-w (or (width scr) 80))
|
||||
(new-ch (- new-h 5)))
|
||||
(setq sw (make-instance 'window :height 3 :width (- new-w 2) :y 0 :x 1)
|
||||
ch new-ch
|
||||
cw (make-instance 'window :height new-ch :width (- new-w 2) :y 3 :x 1)
|
||||
iw (make-instance 'window :height 1 :width (- new-w 2) :y (- new-h 1) :x 1)
|
||||
w new-w
|
||||
h new-h)
|
||||
(setf (function-keys-enabled-p iw) t
|
||||
(input-blocking iw) nil
|
||||
(st :dirty) (list t t t)
|
||||
(st :sw) sw (st :cw) cw (st :iw) iw)
|
||||
(redraw sw cw ch iw)
|
||||
(refresh scr)))
|
||||
(t (on-key ch))))
|
||||
(redraw sw cw ch iw)
|
||||
(refresh scr)
|
||||
(sleep 0.03))
|
||||
|
||||
@@ -28,7 +28,8 @@
|
||||
(setf *state*
|
||||
(list :running t :mode :chat :connected nil :stream nil
|
||||
:input-buffer nil :input-history nil :input-hpos 0
|
||||
:messages nil :scroll-offset 0 :busy nil
|
||||
:messages (make-array 16 :adjustable t :fill-pointer 0)
|
||||
:scroll-offset 0 :busy nil :cursor-pos 0
|
||||
:dirty (list nil nil nil))))
|
||||
|
||||
(defun now ()
|
||||
@@ -39,8 +40,27 @@
|
||||
(defun input-string ()
|
||||
(coerce (reverse (st :input-buffer)) 'string))
|
||||
|
||||
(defun input-insert-char (ch)
|
||||
"Insert character at cursor position into the input buffer."
|
||||
(let* ((buf (st :input-buffer))
|
||||
(pos (or (st :cursor-pos) 0))
|
||||
(s (coerce (reverse buf) 'string))
|
||||
(new (concatenate 'string (subseq s 0 pos) (string ch) (subseq s pos))))
|
||||
(setf (st :input-buffer) (reverse (coerce new 'list)))
|
||||
(setf (st :cursor-pos) (1+ pos))))
|
||||
|
||||
(defun input-delete-char ()
|
||||
"Delete character before cursor position (standard backspace)."
|
||||
(let* ((buf (st :input-buffer))
|
||||
(pos (or (st :cursor-pos) 0)))
|
||||
(when (and buf (> pos 0))
|
||||
(let* ((s (coerce (reverse buf) 'string))
|
||||
(new (concatenate 'string (subseq s 0 (1- pos)) (subseq s pos))))
|
||||
(setf (st :input-buffer) (reverse (coerce new 'list)))
|
||||
(setf (st :cursor-pos) (1- pos))))))
|
||||
|
||||
(defun add-msg (role content)
|
||||
(push (list :role role :content content :time (now)) (st :messages))
|
||||
(vector-push-extend (list :role role :content content :time (now)) (st :messages))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
|
||||
(defun queue-event (ev)
|
||||
|
||||
@@ -14,42 +14,84 @@
|
||||
(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 (reverse (st :messages)))
|
||||
(max-lines (- h 2))
|
||||
(msgs (st :messages))
|
||||
(total (length msgs))
|
||||
(start (max 0 (- total max-lines (st :scroll-offset))))
|
||||
(max-lines (- h 2))
|
||||
(y 1))
|
||||
(loop for i from start below total
|
||||
while (< y (1- h))
|
||||
do (let ((msg (nth i msgs)))
|
||||
(let* ((role (getf msg :role))
|
||||
;; 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) ""))
|
||||
(label (case role
|
||||
(:user (format nil "⬆ [~a] ~a" time content))
|
||||
(:agent (format nil "⬇ [~a] ~a" time content))
|
||||
(:system (format nil " [~a] ~a" time content))
|
||||
(t (format nil " [~a] ~a" time content))))
|
||||
(color (theme-color (case role
|
||||
(:user :user)
|
||||
(:agent :agent)
|
||||
(:system :system)
|
||||
(t :agent)))))
|
||||
(add-string win label :y y :x 1 :n (1- w) :fgcolor color)
|
||||
(incf y)))))
|
||||
(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))
|
||||
(clip (min (length text) (1- w))))
|
||||
(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 " text) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
|
||||
(setf (cursor-position win) (list 0 clip)))
|
||||
(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)
|
||||
|
||||
@@ -116,6 +116,22 @@ Event handlers + daemon I/O + main loop.
|
||||
(progn (funcall 'unfocus)
|
||||
(add-msg :system "Popped context"))
|
||||
(add-msg :system "Context manager not loaded")))
|
||||
;; /quit — save history and exit
|
||||
((or (string-equal text "/quit") (string-equal text "/q"))
|
||||
(let ((hist-file (merge-pathnames ".cache/passepartout/history"
|
||||
(user-homedir-pathname))))
|
||||
(uiop:ensure-all-directories-exist (list hist-file))
|
||||
(with-open-file (out hist-file :direction :output
|
||||
:if-exists :supersede :if-does-not-exist :create)
|
||||
(dolist (entry (reverse (st :input-history)))
|
||||
(write-line entry out))))
|
||||
(add-msg :system "* Goodbye *")
|
||||
(send-daemon (list :type :event :payload '(:action :quit)))
|
||||
(setf (st :running) nil))
|
||||
;; /reconnect — re-establish daemon connection
|
||||
((string-equal text "/reconnect")
|
||||
(disconnect-daemon)
|
||||
(connect-daemon))
|
||||
;; Normal message
|
||||
(t
|
||||
(add-msg :user text)
|
||||
@@ -123,6 +139,7 @@ Event handlers + daemon I/O + main loop.
|
||||
(send-daemon (list :type :event
|
||||
:payload (list :sensor :user-input :text text)))))
|
||||
(setf (st :input-buffer) nil)
|
||||
(setf (st :cursor-pos) 0)
|
||||
(setf (st :dirty) (list t t t))))))
|
||||
;; Tab — command completion
|
||||
((or (eql ch 9) (eq ch :tab))
|
||||
@@ -141,8 +158,18 @@ Event handlers + daemon I/O + main loop.
|
||||
;; Backspace
|
||||
((or (eq ch :backspace) (eql ch 127) (eql ch 8)
|
||||
(eql ch #\Backspace))
|
||||
(when (st :input-buffer) (pop (st :input-buffer)))
|
||||
(input-delete-char)
|
||||
(setf (st :dirty) (list nil nil t)))
|
||||
;; Left arrow
|
||||
((or (eq ch :left) (eql ch 260))
|
||||
(when (> (or (st :cursor-pos) 0) 0)
|
||||
(decf (st :cursor-pos))
|
||||
(setf (st :dirty) (list nil nil t))))
|
||||
;; Right arrow
|
||||
((or (eq ch :right) (eql ch 261))
|
||||
(when (< (or (st :cursor-pos) 0) (length (st :input-buffer)))
|
||||
(incf (st :cursor-pos))
|
||||
(setf (st :dirty) (list nil nil t))))
|
||||
;; Up arrow
|
||||
((or (eq ch :up) (eql ch 259))
|
||||
(let* ((h (st :input-history)) (p (st :input-hpos)))
|
||||
@@ -163,7 +190,8 @@ Event handlers + daemon I/O + main loop.
|
||||
(setf (st :dirty) (list nil nil t)))))
|
||||
;; PageUp
|
||||
((or (eq ch :ppage) (eql ch 339))
|
||||
(incf (st :scroll-offset) 5)
|
||||
(let ((max-offset (max 0 (- (length (st :messages)) 1))))
|
||||
(setf (st :scroll-offset) (min max-offset (+ (st :scroll-offset) 5))))
|
||||
(setf (st :dirty) (list nil t nil)))
|
||||
;; PageDown
|
||||
((or (eq ch :npage) (eql ch 338))
|
||||
@@ -176,7 +204,7 @@ Event handlers + daemon I/O + main loop.
|
||||
(integer (code-char ch))
|
||||
(t nil))))
|
||||
(when (and chr (graphic-char-p chr))
|
||||
(push chr (st :input-buffer))
|
||||
(input-insert-char chr)
|
||||
(setf (st :dirty) (list nil nil t))))))))
|
||||
|
||||
(defun on-daemon-msg (msg)
|
||||
@@ -221,11 +249,28 @@ Event handlers + daemon I/O + main loop.
|
||||
(error () nil)))
|
||||
|
||||
(defun reader-loop (s)
|
||||
(let ((consecutive-nils 0))
|
||||
(loop while (and (st :running) (open-stream-p s))
|
||||
do (let ((msg (recv-daemon s)))
|
||||
(if msg
|
||||
(queue-event (list :type :daemon :payload msg))
|
||||
(sleep 0.5)))))
|
||||
(progn (queue-event (list :type :daemon :payload msg))
|
||||
(setf consecutive-nils 0))
|
||||
(progn (sleep 0.5)
|
||||
(incf consecutive-nils)
|
||||
(when (> consecutive-nils 10)
|
||||
(queue-event (list :type :disconnected))
|
||||
(return))))))))
|
||||
|
||||
(defun load-history ()
|
||||
"Load input history from disk on TUI startup."
|
||||
(let ((hist-file (merge-pathnames ".cache/passepartout/history"
|
||||
(user-homedir-pathname))))
|
||||
(when (uiop:file-exists-p hist-file)
|
||||
(with-open-file (in hist-file :direction :input)
|
||||
(loop for line = (read-line in nil nil)
|
||||
while line
|
||||
do (push line (st :input-history))))
|
||||
(setf (st :input-history) (nreverse (st :input-history))))))
|
||||
#+end_src
|
||||
|
||||
** Connection
|
||||
@@ -265,6 +310,7 @@ Event handlers + daemon I/O + main loop.
|
||||
#+begin_src lisp
|
||||
(defun tui-main ()
|
||||
(init-state)
|
||||
(load-history)
|
||||
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
|
||||
(let* ((h (or (height scr) 24))
|
||||
(w (or (width scr) 80))
|
||||
@@ -277,7 +323,9 @@ Event handlers + daemon I/O + main loop.
|
||||
4006)))
|
||||
(setf (function-keys-enabled-p iw) t
|
||||
(input-blocking iw) nil
|
||||
(st :dirty) (list t t t))
|
||||
(st :dirty) (list t t t)
|
||||
;; Store windows in state for SIGWINCH handler
|
||||
(st :scr) scr (st :sw) sw (st :cw) cw (st :iw) iw)
|
||||
(connect-daemon)
|
||||
(when (> swank-port 0)
|
||||
(handler-case
|
||||
@@ -295,11 +343,34 @@ Event handlers + daemon I/O + main loop.
|
||||
(refresh scr)
|
||||
(loop while (st :running) do
|
||||
(dolist (ev (drain-queue))
|
||||
(when (eq (getf ev :type) :daemon)
|
||||
(on-daemon-msg (getf ev :payload))))
|
||||
(cond
|
||||
((eq (getf ev :type) :daemon)
|
||||
(on-daemon-msg (getf ev :payload)))
|
||||
((eq (getf ev :type) :disconnected)
|
||||
(setf (st :connected) nil
|
||||
(st :busy) nil)
|
||||
(add-msg :system "* Connection lost — type /reconnect to retry *"))))
|
||||
(let ((ch (get-char iw)))
|
||||
(when (and ch (not (equal ch -1)))
|
||||
(on-key ch)))
|
||||
(cond
|
||||
((or (not ch) (equal ch -1)) nil)
|
||||
;; KEY_RESIZE — terminal was resized (SIGWINCH from ncurses)
|
||||
((eql ch 410)
|
||||
(let* ((new-h (or (height scr) 24))
|
||||
(new-w (or (width scr) 80))
|
||||
(new-ch (- new-h 5)))
|
||||
(setq sw (make-instance 'window :height 3 :width (- new-w 2) :y 0 :x 1)
|
||||
ch new-ch
|
||||
cw (make-instance 'window :height new-ch :width (- new-w 2) :y 3 :x 1)
|
||||
iw (make-instance 'window :height 1 :width (- new-w 2) :y (- new-h 1) :x 1)
|
||||
w new-w
|
||||
h new-h)
|
||||
(setf (function-keys-enabled-p iw) t
|
||||
(input-blocking iw) nil
|
||||
(st :dirty) (list t t t)
|
||||
(st :sw) sw (st :cw) cw (st :iw) iw)
|
||||
(redraw sw cw ch iw)
|
||||
(refresh scr)))
|
||||
(t (on-key ch))))
|
||||
(redraw sw cw ch iw)
|
||||
(refresh scr)
|
||||
(sleep 0.03))
|
||||
|
||||
@@ -48,7 +48,8 @@ All state mutation flows through event handlers in the controller.
|
||||
(setf *state*
|
||||
(list :running t :mode :chat :connected nil :stream nil
|
||||
:input-buffer nil :input-history nil :input-hpos 0
|
||||
:messages nil :scroll-offset 0 :busy nil
|
||||
:messages (make-array 16 :adjustable t :fill-pointer 0)
|
||||
:scroll-offset 0 :busy nil :cursor-pos 0
|
||||
:dirty (list nil nil nil))))
|
||||
#+end_src
|
||||
|
||||
@@ -62,8 +63,27 @@ All state mutation flows through event handlers in the controller.
|
||||
(defun input-string ()
|
||||
(coerce (reverse (st :input-buffer)) 'string))
|
||||
|
||||
(defun input-insert-char (ch)
|
||||
"Insert character at cursor position into the input buffer."
|
||||
(let* ((buf (st :input-buffer))
|
||||
(pos (or (st :cursor-pos) 0))
|
||||
(s (coerce (reverse buf) 'string))
|
||||
(new (concatenate 'string (subseq s 0 pos) (string ch) (subseq s pos))))
|
||||
(setf (st :input-buffer) (reverse (coerce new 'list)))
|
||||
(setf (st :cursor-pos) (1+ pos))))
|
||||
|
||||
(defun input-delete-char ()
|
||||
"Delete character before cursor position (standard backspace)."
|
||||
(let* ((buf (st :input-buffer))
|
||||
(pos (or (st :cursor-pos) 0)))
|
||||
(when (and buf (> pos 0))
|
||||
(let* ((s (coerce (reverse buf) 'string))
|
||||
(new (concatenate 'string (subseq s 0 (1- pos)) (subseq s pos))))
|
||||
(setf (st :input-buffer) (reverse (coerce new 'list)))
|
||||
(setf (st :cursor-pos) (1- pos))))))
|
||||
|
||||
(defun add-msg (role content)
|
||||
(push (list :role role :content content :time (now)) (st :messages))
|
||||
(vector-push-extend (list :role role :content content :time (now)) (st :messages))
|
||||
(setf (st :dirty) (list t t nil)))
|
||||
#+end_src
|
||||
|
||||
|
||||
@@ -39,33 +39,73 @@ State is read via ~(st :key)~ — no mutation here.
|
||||
|
||||
** Chat Area
|
||||
#+begin_src lisp
|
||||
(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 (reverse (st :messages)))
|
||||
(max-lines (- h 2))
|
||||
(msgs (st :messages))
|
||||
(total (length msgs))
|
||||
(start (max 0 (- total max-lines (st :scroll-offset))))
|
||||
(max-lines (- h 2))
|
||||
(y 1))
|
||||
(loop for i from start below total
|
||||
while (< y (1- h))
|
||||
do (let ((msg (nth i msgs)))
|
||||
(let* ((role (getf msg :role))
|
||||
;; 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) ""))
|
||||
(label (case role
|
||||
(:user (format nil "⬆ [~a] ~a" time content))
|
||||
(:agent (format nil "⬇ [~a] ~a" time content))
|
||||
(:system (format nil " [~a] ~a" time content))
|
||||
(t (format nil " [~a] ~a" time content))))
|
||||
(color (theme-color (case role
|
||||
(:user :user)
|
||||
(:agent :agent)
|
||||
(:system :system)
|
||||
(t :agent)))))
|
||||
(add-string win label :y y :x 1 :n (1- w) :fgcolor color)
|
||||
(incf y)))))
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
@@ -74,10 +114,12 @@ State is read via ~(st :key)~ — no mutation here.
|
||||
(defun view-input (win)
|
||||
(let* ((text (input-string))
|
||||
(w (or (width win) 78))
|
||||
(clip (min (length text) (1- w))))
|
||||
(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 " text) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
|
||||
(setf (cursor-position win) (list 0 clip)))
|
||||
(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))
|
||||
#+end_src
|
||||
|
||||
|
||||
Reference in New Issue
Block a user