passepartout/lisp/gateway-tui.lisp

(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 *input-buffer* 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 chat-render (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 input-backspace ()
  (pop *input-buffer*))

(defun input-submit (stream)
  (let ((cmd (coerce (reverse *input-buffer*) 'string)))
    (setf *input-buffer* 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 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)))
                     (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))))))))
                 (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))
               (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)
          (reader-start *stream*)
          (loop :while *is-running* :do
            (let ((msgs (message-queue-drain)))
              (when msgs 
                (dolist (m msgs) (push m *chat-history*))
                (chat-render 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))
                   (input-submit *stream*)
                   (chat-render chat-win chat-h))
                  ((or (eql ch 127) (eql ch 8) (eq ch :backspace) (eql ch #\Backspace))
                   (input-backspace))
                  ((characterp ch)
                   (push ch *input-buffer*))
                  ((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))
            (sleep 0.01))))
    (setf *is-running* nil)
    (when *socket* (ignore-errors (usocket:socket-close *socket*)))))