(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*)))))