7f4f712399
Bug fixes:
- read-raw-byte now returns (values nil :eof) on stdin EOF
instead of just nil, so callers can distinguish EOF from
timeout. Previously, non-TTY stdin (pipes, /dev/null)
caused a busy-spin: sb-posix:read returned 0 immediately,
read-raw-byte returned nil, the demo loop treated nil as
'no event yet' and spun at 100% CPU producing 86MB of
repeated rendering frames.
- %read-escape-sequence now uses a 50ms timeout on the first
follow-up byte to resolve the classic Escape-key ambiguity:
a lone Escape press returned an :escape key-event instead of
blocking indefinitely on VMIN=1 VTIME=0. All callers
(SS3, CSI, Alt+char) propagate :eof instead of faking
:escape events when EOF occurs mid-sequence.
- parse-csi-params now uses multiple-value-bind on read-raw-byte
to preserve the :eof signal through CSI parsing.
- simple-backend draw-border now renders :title on the top
edge instead of declaring it (ignore). The title was
silently swallowed — the box rendered with the right border
frame but the title text was never written.
- demo.lisp: removed 'q' as quit key (conflicted with text
input). Only Esc and Ctrl+C quit. Widget event forwarding
scoped to tab 1 (Widgets tab). EOF handling in main loop.
- Stale help text (still said 'q/esc: quit') updated.
Verification infrastructure:
- PTY-based demo test (17 checks) spawns the demo in a real
pseudo-terminal, sends actual keystrokes, reads terminal
output back. Verifies: startup rendering, tab switching,
key dispatch, 'q' doesn't quit, Escape quits via timeout,
Ctrl+C quits, EOF clean exit, no busy-spin.
- API feature verification (29 checks) exercises every major
component through the actual exported API: Simple backend,
Box with title, Text attributes, draw-rect, TextInput
(insert/backspace/cursor/Ctrl-A/E), TextArea, key/mouse
events, Layout flex, Markdown, Theme presets (dark/light/
nord), Select filtering, Dialog stack, Mouse hit-test,
Framebuffer, Dirty tracking, Modern backend, draw-ellipsis/
draw-link, Render dispatch, Detection, Capabilities.
- Testing pattern saved as skill (tui-pty-testing) for reuse.
Unit tests: 392/392 passing. All 12 test suites green.
89 lines
3.3 KiB
Common Lisp
89 lines
3.3 KiB
Common Lisp
(in-package :cl-tty.backend)
|
|
|
|
(defclass simple-backend (backend)
|
|
((output-stream :initform *standard-output*
|
|
:initarg :output-stream
|
|
:accessor backend-output-stream)))
|
|
|
|
(defun make-simple-backend (&key output-stream)
|
|
(make-instance 'simple-backend
|
|
:output-stream (or output-stream *standard-output*)))
|
|
|
|
(defmethod initialize-backend ((b simple-backend))
|
|
b)
|
|
|
|
(defmethod shutdown-backend ((b simple-backend))
|
|
(values))
|
|
|
|
(defmethod backend-size ((b simple-backend))
|
|
;; Try ioctl, fall back to 80x24
|
|
(values 80 24))
|
|
|
|
(defmethod backend-write ((b simple-backend) string)
|
|
(let ((stream (backend-output-stream b)))
|
|
(write-string string stream)
|
|
(finish-output stream)
|
|
(length string)))
|
|
|
|
(defmethod draw-text ((b simple-backend) x y string fg bg
|
|
&key bold italic underline reverse dim blink)
|
|
(declare (ignore x y fg bg bold italic underline reverse dim blink))
|
|
(backend-write b string))
|
|
|
|
(defun %simple-border-char (edge-style pos)
|
|
"Return ASCII border character for EDGE-STYLE at POS.
|
|
POS is :top-left, :top-right, :bottom-left, :bottom-right,
|
|
:horizontal, or :vertical."
|
|
(case pos
|
|
((:top-left :top-right :bottom-left :bottom-right) #\+)
|
|
(:horizontal #\-)
|
|
(:vertical #\|)))
|
|
|
|
(defmethod draw-border ((b simple-backend) x y width height
|
|
&key style fg bg title title-align)
|
|
(declare (ignore style fg bg title-align))
|
|
(let ((h (%simple-border-char nil :horizontal))
|
|
(v (%simple-border-char nil :vertical)))
|
|
;; Position cursor with newlines and spaces (no escape sequences)
|
|
(dotimes (row y) (backend-write b (string #\Newline)))
|
|
;; Top edge with optional title
|
|
(backend-write b (make-string x :initial-element #\space))
|
|
(if title
|
|
(let* ((tlen (length title))
|
|
(space-left (- width tlen 2))
|
|
(left (max 0 (floor space-left 2)))
|
|
(right (max 0 (- space-left left))))
|
|
(backend-write b (make-string left :initial-element h))
|
|
(backend-write b (string #\space))
|
|
(backend-write b title)
|
|
(backend-write b (string #\space))
|
|
(backend-write b (make-string right :initial-element h)))
|
|
(backend-write b (make-string width :initial-element h)))
|
|
;; Sides
|
|
(loop for i from 1 below (1- height)
|
|
do (backend-write b (string #\Newline))
|
|
(backend-write b (make-string x :initial-element #\space))
|
|
(backend-write b (string v))
|
|
(backend-write b (make-string (- width 2) :initial-element #\space))
|
|
(backend-write b (string v)))
|
|
;; Bottom edge
|
|
(backend-write b (string #\Newline))
|
|
(backend-write b (make-string x :initial-element #\space))
|
|
(backend-write b (make-string width :initial-element h))))
|
|
|
|
(defmethod draw-rect ((b simple-backend) x y width height
|
|
&key bg)
|
|
(declare (ignore x y width height bg))
|
|
;; On simple backend, background fill is a no-op
|
|
(values))
|
|
|
|
(defmethod draw-link ((b simple-backend) x y string url
|
|
&key fg bg)
|
|
(declare (ignore url fg bg))
|
|
(draw-text b x y string nil nil))
|
|
|
|
(defmethod draw-ellipsis ((b simple-backend) x y width
|
|
&key fg bg)
|
|
(declare (ignore x y width fg bg))
|
|
(backend-write b "..."))
|