(in-package :cl-user) (defpackage :passepartout.gateway-tui (:use :cl :croatoan :usocket :bordeaux-threads) (:export :main)) (in-package :passepartout.gateway-tui) (defvar *daemon-host* "localhost") (defvar *daemon-port* 9105) (defvar *socket* nil) (defvar *stream* nil) (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")) (defvar *incoming* nil) (defun log-debug (msg &rest args) (ignore-errors (with-open-file (s "/tmp/passepartout-tui-debug.log" :direction :output :if-exists :append :if-does-not-exist :create) (format s "[~a] " (get-universal-time)) (apply #'format s msg args) (terpri s) (finish-output s)))) (defun message-queue-push (msg) (bt:with-lock-held (*queue-lock*) (setf *incoming* (append *incoming* (list msg))))) (defun message-queue-drain () (bt:with-lock-held (*queue-lock*) (let ((msgs *incoming*)) (setf *incoming* nil) msgs))) (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 *chat-history*) (len (length history)) (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) (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 :META (list :SOURCE :tui) :PAYLOAD (list :SENSOR :user-input :TEXT cmd))) (payload (format nil "~s" msg)) (len (length payload))) (format stream "~6,'0x~a" len payload) (finish-output stream) (log-debug "SENT WIRE: ~a" payload)) (push "⬇ [--:--] ERROR: Not connected." *chat-history*))) (error (c) (log-debug "SEND ERROR: ~a" c) (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) (setf *chat-scroll-pos* 0)))) (defun reader-start (stream) (bt:make-thread (lambda () (loop while *is-running* do (handler-case (let* ((len-buf (make-string 6)) (count (read-sequence len-buf stream))) (if (= count 6) (let* ((msg-len (parse-integer len-buf :radix 16)) (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)) (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.") (setf *is-running* nil)))))) :name "passepartout-tui-reader")) (defun main () (log-debug "=== START ===") (handler-case (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)) (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) (setf (function-keys-enabled-p input-win) t) (setf (function-keys-enabled-p chat-win) t) (reader-start *stream*) (loop :while *is-running* :do (let ((msgs (message-queue-drain))) (when msgs (dolist (m msgs) (push m *chat-history*)) (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 ;; 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 0) (status-render status-win)) ;; Backspace ((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\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*) (input-render input-win)) ;; Integer key code → character ((integerp ch) (let ((converted (code-char ch))) (when (graphic-char-p converted) (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*)))))