passepartout/harness/tui-client.lisp

(in-package :cl-user)
(defpackage :opencortex.tui
  (:use :cl :croatoan :usocket :bordeaux-threads)
  (:export :main))
(in-package :opencortex.tui)

(defvar *daemon-host* "127.0.0.1")
(defvar *daemon-port* 9105)
(defvar *socket* nil)
(defvar *stream* nil)
(defvar *chat-history* nil)
(defvar *input-list* nil) ; List of characters (stored in reverse)
(defvar *is-running* t)
(defvar *queue-lock* (bt:make-lock))
(defvar *incoming-msgs* nil)

(defun log-debug (msg &rest args)
  (ignore-errors
    (with-open-file (s "/tmp/opencortex-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 enqueue-msg (msg)
  (bt:with-lock-held (*queue-lock*)
    (setf *incoming-msgs* (append *incoming-msgs* (list msg)))))

(defun dequeue-msgs ()
  (bt:with-lock-held (*queue-lock*)
    (let ((msgs *incoming-msgs*))
      (setf *incoming-msgs* nil)
      msgs)))

(defun render-chat (win h)
  (when (and win (integerp h))
    (clear win)
    (box win 0 0)
    (let* ((view-height (- h 2))
           (history (copy-list *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))))
    (refresh win)))

(defun handle-backspace ()
  (pop *input-list*))

(defun handle-return (stream)
  (let ((cmd (coerce (reverse *input-list*) 'string)))
    (setf *input-list* nil)
    (log-debug "SUBMITTING: '~a'" cmd)
    (when (> (length cmd) 0)
      (push (format nil "⬆ ~a" cmd) *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))))

(defun start-background-reader (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)))
                     (let ((payload (getf msg :payload)))
                       (cond
                         ((eq (getf payload :action) :handshake)
                          (enqueue-msg "* Connected *"))
                         (t
                          (let ((text (or (getf payload :text) (format nil "~a" payload))))
                            (enqueue-msg (format nil "⬇ ~a" text))))))))
                 (sleep 0.05)))
         (error (c)
           (when *is-running*
             (log-debug "READER ERROR: ~a" c)
             (enqueue-msg "ERROR: Connection lost.")
             (setf *is-running* nil))))))
   :name "opencortex-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))
               (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)))
          (setf (input-blocking input-win) nil)
          (start-background-reader *stream*)
          (loop :while *is-running* :do
            (let ((msgs (dequeue-msgs)))
              (when msgs 
                (dolist (m msgs) (push m *chat-history*))
                (render-chat chat-win chat-h)))
            (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))
                   (handle-return *stream*)
                   (render-chat chat-win chat-h))
                  ((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
                   (handle-backspace))
                  ((characterp ch)
                   (push ch *input-list*))
                  ((integerp ch)
                   (let ((converted (code-char ch)))
                     (when (graphic-char-p converted)
                       (push converted *input-list*))))))
              (clear input-win)
              (add-string input-win (format nil "▶ ~a" (coerce (reverse *input-list*) 'string)) :y 0 :x 1)
              (refresh input-win))
            (sleep 0.01))))
    (setf *is-running* nil)
    (when *socket* (ignore-errors (usocket:socket-close *socket*)))))