passepartout/literate/tui-client.org

OpenCortex TUI Client (Standalone)

• Overview
• Implementation

Overview

The OpenCortex TUI Client is a standalone Common Lisp application built on Croatoan (a high-level CLOS wrapper for ncurses). It provides a real-time, multi-window interface for interacting with the OpenCortex daemon.

Implementation

(in-package :cl-user)
(defpackage :opencortex.tui
  (:use :cl :croatoan)
  (: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* (list))
(defvar *status-text* "Connecting...")
(defvar *input-buffer* (make-array 0 :element-type 'char :fill-pointer 0 :adjustable t))
(defvar *is-running* t)
(defvar *queue-lock* (bt:make-lock))
(defvar *incoming-msgs* nil)

(defun enqueue-msg (msg)
  (bt:with-lock-held (*queue-lock*)
    (push msg *incoming-msgs*)))

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

(defun listen-thread ()
  (loop while *is-running* do
    (handler-case
        (when (and *stream* (open-stream-p *stream*))
          (let ((msg (opencortex:read-framed-message *stream*)))
            (cond ((eq msg :eof) (setf *is-running* nil))
                  ((eq msg :error) (setf *status-text* "Protocol Error"))
                  ((and (listp msg) (eq (getf msg :type) :EVENT))
                   (let ((payload (getf msg :payload)))
                     (when (eq (getf payload :action) :handshake)
                       (setf *status-text* "Ready"))))
                  ((and (listp msg) (eq (getf msg :type) :STATUS))
                   (setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]" 
                                               (getf msg :scribe)
                                               (getf msg :gardener))))
                  ((and (listp msg) (eq (getf msg :type) :CHAT))
                   (enqueue-msg (getf msg :text)))
                  (t (enqueue-msg (format nil "~s" msg))))))
      (error (c) (setf *status-text* (format nil "Net Error: ~a" c)) (setf *is-running* nil)))
    (sleep 0.05)))

(defun main ()
  (handler-case
      (setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
    (error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
  (setf *stream* (usocket:socket-stream *socket*))
  (bt:make-thread #'listen-thread :name "tui-listener")
  
  (unwind-protect
      (with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t)
        (let* ((h (height scr))
               (w (width scr))
               (chat-win (make-instance 'window :height (- h 2) :width w :position (list 0 0)))
               (status-win (make-instance 'window :height 1 :width w :position (list (- h 2) 0)))
               (input-win (make-instance 'window :height 1 :width w :position (list (- h 1) 0)))
               (last-status nil))
          
          (setf (function-keys-enabled-p input-win) t)
          (setf (input-blocking input-win) nil)

          (loop while *is-running* do
            ;; 1. Handle incoming messages
            (let ((new-msgs (dequeue-msgs)))
              (when new-msgs
                (dolist (msg new-msgs)
                  (push msg *chat-history*)
                  (setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))
                
                (clear chat-win)
                (let ((line-num 0))
                  (dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- h 3)))))
                    (add-string chat-win m :y line-num :x 0)
                    (incf line-num)))
                (refresh chat-win)))

            ;; 2. Render Status Bar
            (unless (equal *status-text* last-status)
              (clear status-win)
              (add-string status-win *status-text* :attributes '(:reverse))
              (refresh status-win)
              (setf last-status *status-text*))

            ;; 3. Handle Keyboard Input
            (let* ((event (get-wide-event input-win))
                   (ch (and event (typep event 'event) (event-key event))))
              (when ch
                (cond
                  ((or (eq ch #\Newline) (eq ch #\Return))
                   (let ((cmd (coerce *input-buffer* 'string)))
                     (setf (fill-pointer *input-buffer*) 0)
                     (when (> (length cmd) 0)
                       (let ((framed (opencortex:frame-message (format nil "~s" (list :type :EVENT :payload (list :sensor :chat-message :text cmd))))))
                         (format *stream* "~a" framed)
                         (finish-output *stream*)))
                     (when (string= cmd "/exit") (setf *is-running* nil))))
                  ((or (eq ch :backspace) (eq ch #\Backspace) (eq ch #\Rubout) (eq ch #\Del))
                   (when (> (length *input-buffer*) 0)
                     (decf (fill-pointer *input-buffer*))))
                  ((characterp ch)
                   (vector-push-extend ch *input-buffer*))))
              (clear input-win)
              (add-string input-win (concatenate 'string "> " (coerce *input-buffer* 'string)))
              (move input-win 0 (+ 2 (length *input-buffer*)))
              (refresh input-win))
            
            (sleep 0.02))))
    (setf *is-running* nil)
    (when *socket* (usocket:socket-close *socket*))))