feat: TUI Experience — scrollback, input history, status bar, timestamps

lisp/gateway-tui.lisp

@@ -14,8 +14,13 @@
 
 (defvar *chat-history* nil)
 
+(defvar *chat-scroll-pos* 0)
+
 (defvar *input-buffer* nil)
 
+(defvar *input-history* nil)
+(defvar *input-history-pos* nil)
+
 (defvar *is-running* t)
 
 (defvar *queue-lock* (bt:make-lock "incoming-queue-lock"))
@@ -40,34 +45,92 @@
       (setf *incoming* nil)
       msgs)))
 
-(defun chat-render (win h)
+(defun timestamp-now ()
+  "Return a short HH:MM timestamp string."
+  (multiple-value-bind (s m h) (decode-universal-time (get-universal-time))
+    (declare (ignore s))
+    (format nil "~2,'0d:~2,'0d" h m)))
+
+(defun input-render (win)
+  (clear win)
+  (let ((text (coerce (reverse *input-buffer*) 'string)))
+    (if (> (length text) 0)
+        (add-string win (format nil "▶ ~a" text) :y 0 :x 1)
+        (add-string win "▶ " :y 0 :x 1)))
+  (refresh win))
+
+(defun chat-render (win h &optional (offset 0))
   (when (and win (integerp h))
     (clear win)
     (box win 0 0)
     (let* ((view-height (- h 2))
-           (history (copy-list *chat-history*))
+           (history *chat-history*)
            (len (length history))
-           (num-to-draw (min len view-height))
-           (slice (subseq history 0 num-to-draw)))
-      (loop for i from 0 below num-to-draw
-            for msg in (reverse slice)
-            do (when msg
-                 (add-string win (format nil "│ ~a" msg) :y (1+ i) :x 2))))
+           (start (max 0 (- len view-height offset)))
+           (end (min len (+ start view-height))))
+      (loop for i from start below end
+            for msg in (subseq history start end)
+            for row from 1
+            do (add-string win (format nil "│ ~a" msg) :y row :x 2)))
     (refresh win)))
 
+(defun status-render (win)
+  (when win
+    (clear win)
+    (box win 0 0)
+    (let* ((status (if (and *stream* (open-stream-p *stream*)) "●" "○"))
+           (msgs (length *chat-history*))
+           (scroll-indicator (if (> *chat-scroll-pos* 0)
+                                 (format nil " ↑~a" *chat-scroll-pos*)
+                                 ""))
+           (time (timestamp-now)))
+      (add-string win (format nil "│ ~a PASSEPARTOUT [~a msgs]~a  ~a"
+                              status msgs scroll-indicator time)
+                  :y 1 :x 2)))
+  (refresh win))
+
 (defun input-backspace ()
   (pop *input-buffer*))
 
+(defun input-history-push (cmd)
+  (when (> (length cmd) 0)
+    (setf *input-history* (cons cmd *input-history*))
+    (setf *input-history-pos* nil)))
+
+(defun input-history-nav (direction)
+  (let ((len (length *input-history*)))
+    (if (= len 0)
+        nil
+        (case direction
+          (:up
+           (let ((pos (if *input-history-pos*
+                          (min (1+ *input-history-pos*) (1- len))
+                          0)))
+             (setf *input-history-pos* pos)
+             (nth pos *input-history*)))
+          (:down
+           (if *input-history-pos*
+               (if (= *input-history-pos* 0)
+                   (progn (setf *input-history-pos* nil) nil)
+                   (let ((pos (1- *input-history-pos*)))
+                     (setf *input-history-pos* pos)
+                     (nth pos *input-history*)))
+               nil))))))
+
 (defun input-submit (stream)
   (let ((cmd (coerce (reverse *input-buffer*) 'string)))
     (setf *input-buffer* nil)
+    (setf *input-history-pos* nil)
     (log-debug "SUBMITTING: '~a'" cmd)
     (when (> (length cmd) 0)
-      (push (format nil "⬆ ~a" cmd) *chat-history*)
+      (input-history-push cmd)
+      (let* ((ts (timestamp-now))
+             (display (format nil "⬆ [~a] ~a" ts cmd)))
+        (push display *chat-history*))
       (handler-case
           (progn
             (if (and stream (open-stream-p stream))
-                (let* ((msg (list :TYPE :EVENT 
+                (let* ((msg (list :TYPE :EVENT
                                  :META (list :SOURCE :tui)
                                  :PAYLOAD (list :SENSOR :user-input :TEXT cmd)))
                        (payload (format nil "~s" msg))
@@ -75,13 +138,13 @@
                   (format stream "~6,'0x~a" len payload)
                   (finish-output stream)
                   (log-debug "SENT WIRE: ~a" payload))
-                (push "ERROR: Not connected." *chat-history*)))
+                (push "⬇ [--:--] ERROR: Not connected." *chat-history*)))
         (error (c)
           (log-debug "SEND ERROR: ~a" c)
-          (push (format nil "ERROR: ~a" c) *chat-history*)
+          (push (format nil "⬇ [--:--] ERROR: ~a" c) *chat-history*)
           (setf *is-running* nil))))
     (when (string= cmd "/exit") (setf *is-running* nil))
-    (when (string= cmd "/clear") (setf *chat-history* nil))))
+    (when (string= cmd "/clear") (setf *chat-history* nil) (setf *chat-scroll-pos* 0))))
 
 (defun reader-start (stream)
   (bt:make-thread
@@ -95,19 +158,20 @@
                         (msg-buf (make-string msg-len)))
                    (read-sequence msg-buf stream)
                    (log-debug "DAEMON MSG: ~a" msg-buf)
-                   (let ((msg (read-from-string msg-buf)))
-                     (let ((payload (getf msg :payload)))
-                       (cond
-                         ((eq (getf payload :action) :handshake)
-                          (message-queue-push "* Connected *"))
-                         (t
-                          (let ((text (or (getf payload :text) (format nil "~a" payload))))
-                            (message-queue-push (format nil "⬇ ~a" text))))))))
+                   (let* ((msg (read-from-string msg-buf))
+                          (payload (getf msg :payload))
+                          (ts (timestamp-now)))
+                     (cond
+                       ((eq (getf payload :action) :handshake)
+                        (message-queue-push (format nil "⬇ [~a] * Connected *" ts)))
+                       (t
+                        (let ((text (or (getf payload :text) (format nil "~a" payload))))
+                          (message-queue-push (format nil "⬇ [~a] ~a" ts text)))))))
                  (sleep 0.05)))
          (error (c)
            (when *is-running*
              (log-debug "READER ERROR: ~a" c)
-             (message-queue-push "ERROR: Connection lost.")
+             (message-queue-push "⬇ [--:--] ERROR: Connection lost.")
              (setf *is-running* nil))))))
    :name "passepartout-tui-reader"))
 
@@ -117,39 +181,81 @@
       (setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
     (error (e) (format t "Offline: ~a~%" e) (return-from main)))
   (setf *stream* (usocket:socket-stream *socket*))
-  
+
   (unwind-protect
       (with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t)
         (let* ((h (or (height scr) 24))
                (w (or (width scr) 80))
-               (chat-h (- h 4))
-               (chat-win (make-instance 'window :height chat-h :width (- w 2) :y 1 :x 1))
-               (input-win (make-instance 'window :height 1 :width (- w 2) :y (- h 2) :x 1)))
+               (status-h 3)
+               (input-h 1)
+               (chat-h (- h status-h input-h 1))
+               (status-win (make-instance 'window :height status-h :width (- w 2) :y 0 :x 1))
+               (chat-win (make-instance 'window :height chat-h :width (- w 2) :y status-h :x 1))
+               (input-win (make-instance 'window :height input-h :width (- w 2) :y (- h input-h 1) :x 1)))
           (setf (input-blocking input-win) nil)
           (reader-start *stream*)
           (loop :while *is-running* :do
             (let ((msgs (message-queue-drain)))
-              (when msgs 
+              (when msgs
                 (dolist (m msgs) (push m *chat-history*))
-                (chat-render chat-win chat-h)))
+                (when (> *chat-scroll-pos* 0)
+                  (incf *chat-scroll-pos* (length msgs)))
+                (chat-render chat-win chat-h *chat-scroll-pos*)
+                (status-render status-win)))
             (let ((ch (get-char input-win)))
               (when (and ch (not (equal ch -1)))
                 (log-debug "KEY: ~s" ch)
                 (cond
-                  ((or (eql ch 10) (eql ch 13) (eq ch :enter) (eql ch #\Newline) (eql ch #\Return))
+                  ;; Enter / Return — submit
+                  ((or (eql ch 10) (eql ch 13) (eq ch :enter)
+                       (eql ch #\Newline) (eql ch #\Return))
+                   (setf *chat-scroll-pos* 0)
                    (input-submit *stream*)
-                   (chat-render chat-win chat-h))
+                   (chat-render chat-win chat-h 0)
+                   (status-render status-win))
+                  ;; Backspace
                   ((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
-                   (input-backspace))
+                   (input-backspace)
+                   (input-render input-win))
+                  ;; Up arrow — history back
+                  ((or (eq ch :up) (eql ch 259))
+                   (let ((prev (input-history-nav :up)))
+                     (when prev
+                       (setf *input-buffer* (reverse (coerce prev 'list)))
+                       (input-render input-win))))
+                  ;; Down arrow — history forward
+                  ((or (eq ch :down) (eql ch 258))
+                   (let ((next (input-history-nav :down)))
+                     (if next
+                         (setf *input-buffer* (reverse (coerce next 'list)))
+                         (setf *input-buffer* nil))
+                     (input-render input-win)))
+                  ;; Page Up — scroll chat back
+                  ((or (eq ch :ppage) (eql ch 339))
+                   (let* ((hist-len (length *chat-history*))
+                          (view-h (- chat-h 2))
+                          (max-offset (max 0 (- hist-len view-h))))
+                     (setf *chat-scroll-pos*
+                           (min (+ *chat-scroll-pos* view-h) max-offset))
+                     (chat-render chat-win chat-h *chat-scroll-pos*)
+                     (status-render status-win)))
+                  ;; Page Down — scroll chat forward
+                  ((or (eq ch :npage) (eql ch 338))
+                   (setf *chat-scroll-pos* (max 0 (- *chat-scroll-pos* (- chat-h 2))))
+                   (chat-render chat-win chat-h *chat-scroll-pos*)
+                   (status-render status-win))
+                  ;; Printable character
                   ((characterp ch)
-                   (push ch *input-buffer*))
+                   (push ch *input-buffer*)
+                   (input-render input-win))
+                  ;; Integer key code → character
                   ((integerp ch)
                    (let ((converted (code-char ch)))
                      (when (graphic-char-p converted)
-                       (push converted *input-buffer*))))))
-              (clear input-win)
-              (add-string input-win (format nil "▶ ~a" (coerce (reverse *input-buffer*) 'string)) :y 0 :x 1)
-              (refresh input-win))
+                       (push converted *input-buffer*)
+                       (input-render input-win))))))
+              ;; Re-render input on every tick (no key = buffer unchanged)
+              (input-render input-win))
             (sleep 0.01))))
     (setf *is-running* nil)
     (when *socket* (ignore-errors (usocket:socket-close *socket*)))))