Files

Deploy (Gitea) / deploy (push) Failing after 2s

Details

v0.3.3: left/right cursor movement in input

Adds :cursor-pos to TUI state. New functions:
- input-insert-char(ch): insert at cursor position, advance cursor
- input-delete-char(): delete char before cursor (standard backspace)

on-key handlers:
- Left arrow: decrement cursor-pos (clamped >= 0)
- Right arrow: increment cursor-pos (clamped <= buffer-len)
- Character input: input-insert-char at cursor position
- Backspace: input-delete-char at cursor position
- Enter: reset cursor-pos to 0

view-input: cursor at visual position matching cursor-pos

Test: (init-state) → (input-insert-char #\h) → (input-insert-char #\i)
→ (setf cursor-pos 1) → (input-insert-char #\X) → 'hXi' at pos 2

2026-05-06 17:46:49 -04:00

3.4 KiB

Raw Blame History

Passepartout TUI — Model

Model

Model

The TUI state is a single plist accessed via st / (setf st). All state mutation flows through event handlers in the controller.

Contract

(init-state): returns a fresh state plist with :msgs list, :input buffer, :dirty flag, :busy flag, and :connection status.
(add-msg type text): appends a message to the :msgs list in *state*, tagged with a timestamp and type. Truncates at the message buffer limit.
(queue-event ev): thread-safely enqueues an event for the reader loop. (drain-queue) returns and clears the queue.

Package + State

(defpackage :passepartout.gateway-tui
  (:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
  (:export :tui-main :st :add-msg :now :input-string
           :queue-event :drain-queue :init-state
           :view-status :view-chat :view-input :redraw
           :on-key :on-daemon-msg :send-daemon
           :connect-daemon :disconnect-daemon
           :*tui-theme* :theme-color))
(in-package :passepartout.gateway-tui)

(defvar *state* nil)
(defvar *event-queue* nil)
(defvar *event-lock* (bt:make-lock "tui-event-lock"))

(defvar *tui-theme*
  '(:user :green :agent :white :system :yellow :input :cyan
    :connected :green :disconnected :red :timestamp :yellow)
  "Color theme plist. Keys are semantic roles, values are Croatoan colors.")

(defun theme-color (role)
  "Returns the Croatoan color for a semantic role."
  (or (getf *tui-theme* role) :white))

(defun st (key) (getf *state* key))
(defun (setf st) (val key) (setf (getf *state* key) val))

(defun init-state ()
  (setf *state*
        (list :running t :mode :chat :connected nil :stream nil
              :input-buffer nil :input-history nil :input-hpos 0
              :messages nil :scroll-offset 0 :busy nil :cursor-pos 0
              :dirty (list nil nil nil))))

Helpers

(defun now ()
  (multiple-value-bind (s m h) (get-decoded-time)
    (declare (ignore s))
    (format nil "~2,'0d:~2,'0d" h m)))

(defun input-string ()
  (coerce (reverse (st :input-buffer)) 'string))

(defun input-insert-char (ch)
  "Insert character at cursor position into the input buffer."
  (let* ((buf (st :input-buffer))
         (pos (or (st :cursor-pos) 0))
         (s (coerce (reverse buf) 'string))
         (new (concatenate 'string (subseq s 0 pos) (string ch) (subseq s pos))))
    (setf (st :input-buffer) (reverse (coerce new 'list)))
    (setf (st :cursor-pos) (1+ pos))))

(defun input-delete-char ()
  "Delete character before cursor position (standard backspace)."
  (let* ((buf (st :input-buffer))
         (pos (or (st :cursor-pos) 0)))
    (when (and buf (> pos 0))
      (let* ((s (coerce (reverse buf) 'string))
             (new (concatenate 'string (subseq s 0 (1- pos)) (subseq s pos))))
        (setf (st :input-buffer) (reverse (coerce new 'list)))
        (setf (st :cursor-pos) (1- pos))))))

(defun add-msg (role content)
  (push (list :role role :content content :time (now)) (st :messages))
  (setf (st :dirty) (list t t nil)))

Event Queue

(defun queue-event (ev)
  (bt:with-lock-held (*event-lock*) (push ev *event-queue*)))

(defun drain-queue ()
  (bt:with-lock-held (*event-lock*)
    (let ((evs (nreverse *event-queue*)))
      (setf *event-queue* nil) evs)))

3.4 KiB Raw Blame History