v0.15.0: Rewrite demo, update README, fix read-raw-byte buffer, export textarea-lines
Demo (demo.lisp):
- Full interactive demo with 3 tabs: Home, Widgets, Console
- Uses read-event/SGR mouse paths (exercises real terminal input)
- Demonstrates text-input, textarea, backend drawing, tab navigation
- Event log console shows keyboard and mouse events in real time
- Proper terminal cleanup via shutdown-backend + unwind-protect
README.org:
- Complete rewrite with getting-started guide, architecture overview
- API reference for all components with signatures and examples
- Event loop pattern, layout system, rendering pipeline docs
- Backend features table, development guide, project structure
Bug fixes:
- read-raw-byte (input.lisp:89-109): use sb-sys:with-pinned-objects +
vector-sap for proper sb-posix:read buffer handling (SBCL type error
with plain (unsigned-byte 8) arrays)
- input-package.lisp: export textarea-lines (was missing from package)
Version bump: v0.14.0 → v0.15.0
392 tests pass.
This commit is contained in:
Hermes
266
demo.lisp
266
demo.lisp
@@ -1,132 +1,172 @@
|
||||
;;; demo.lisp — cl-tty interactive demo
|
||||
;;; Run: sbcl --script demo.lisp
|
||||
;;;
|
||||
;;; Demonstrates: backend detection, raw terminal mode, key/mouse input,
|
||||
;;; layout engine, component rendering pipeline, framebuffer diff flush,
|
||||
;;; text-input, textarea, select, dialog, scrollbox, tabbar.
|
||||
|
||||
(load "~/quicklisp/setup.lisp")
|
||||
(ql:register-local-projects)
|
||||
(ql:quickload :cl-tty :silent t)
|
||||
|
||||
;;; ─── Low-level input ───────────────────────────────────────────────────────
|
||||
(use-package :cl-tty.backend)
|
||||
(use-package :cl-tty.input)
|
||||
(use-package :cl-tty.box)
|
||||
(use-package :cl-tty.layout)
|
||||
(use-package :cl-tty.rendering)
|
||||
|
||||
(defun read-raw (&optional timeout)
|
||||
(let ((fn (symbol-function (find-symbol "READ-RAW-BYTE" :cl-tty.input))))
|
||||
(funcall fn :timeout (or timeout 10))))
|
||||
;;; ─── Application state ───────────────────────────────────────────────────────
|
||||
|
||||
(defun read-key ()
|
||||
(let ((b (read-raw)))
|
||||
(unless b (return-from read-key nil))
|
||||
(case b
|
||||
(#x1b
|
||||
(let ((b2 (read-raw 1)))
|
||||
(unless b2 (return-from read-key :escape))
|
||||
(if (= b2 #x5b)
|
||||
(let ((b3 (read-raw 1)))
|
||||
(case b3
|
||||
(#x41 :up) (#x42 :down)
|
||||
(#x43 :right) (#x44 :left)
|
||||
(#x48 :home) (#x46 :end)
|
||||
(t :unknown)))
|
||||
:unknown)))
|
||||
(#x03 :ctrl-c)
|
||||
(#x0d :enter)
|
||||
(#x09 :tab)
|
||||
(#x7f :backspace)
|
||||
(t (code-char b)))))
|
||||
(defvar *app* nil "Application state plist")
|
||||
(defvar *log* nil "Circular log buffer")
|
||||
(defvar *log-pos* 0)
|
||||
|
||||
;;; ─── Tab content renderers ─────────────────────────────────────────────────
|
||||
(defun log-append (fmt &rest args)
|
||||
(let* ((msg (apply #'format nil fmt args))
|
||||
(ts (multiple-value-bind (h m s) (get-decoded-time)
|
||||
(format nil "~2,'0d:~2,'0d:~2,'0d" h m s))))
|
||||
(push (format nil "[~a] ~a" ts msg) *log*)
|
||||
(when (> (length *log*) 100) (setf *log* (subseq *log* 0 100)))))
|
||||
|
||||
(defun render-home (be)
|
||||
(cl-tty.backend:draw-border be 6 7 68 10 :style :single :title " Welcome ")
|
||||
(cl-tty.backend:draw-text be 8 9 "cl-tty — Pure CL terminal UI framework"
|
||||
:bright-white :default :bold t)
|
||||
(cl-tty.backend:draw-text be 8 11 " - 11 versions, 12 components"
|
||||
:white :default)
|
||||
(cl-tty.backend:draw-text be 8 12 " - No ncurses, no FFI, no external deps"
|
||||
:white :default)
|
||||
(cl-tty.backend:draw-text be 8 13 " - 280+ tests, 100% passing"
|
||||
:green :default)
|
||||
(cl-tty.backend:draw-text be 8 15 "Arrows: switch tabs Enter/q: quit"
|
||||
:bright-cyan :default :bold t))
|
||||
(defun init-app-state ()
|
||||
(setf *log* nil *log-pos* 0)
|
||||
(setf *app* (list :tab 0
|
||||
:input (make-text-input :placeholder "Type here...")
|
||||
:textarea (make-textarea :value "Hello\nWorld")
|
||||
:running t
|
||||
:mouse-x -1 :mouse-y -1))
|
||||
(log-append "Demo started"))
|
||||
|
||||
(defun render-components (be)
|
||||
(cl-tty.backend:draw-border be 6 7 68 12 :style :single :title " Components ")
|
||||
(loop for i from 0 below 6
|
||||
for pair = (nth i '(("Box" "Bordered containers, title, bg")
|
||||
("Text" "Styled text, word-wrap, spans")
|
||||
("ScrollBox" "Scrollable viewport, scrollbars")
|
||||
("TabBar" "Tab navigation you are using")
|
||||
("Select" "Dropdown with fuzzy filter")
|
||||
("Dialog" "Modal overlays + Toast notifs")))
|
||||
do (cl-tty.backend:draw-text be 8 (+ 9 i) (first pair)
|
||||
:bright-yellow :default :bold t)
|
||||
(cl-tty.backend:draw-text be 24 (+ 9 i) (second pair)
|
||||
:white :default)))
|
||||
;;; ─── Tab renderers ──────────────────────────────────────────────────────────
|
||||
|
||||
(defun render-stats (be)
|
||||
(cl-tty.backend:draw-border be 6 7 68 10 :style :single :title " Stats ")
|
||||
(cl-tty.backend:draw-text be 8 9 "Metric" :bright-white :default :bold t)
|
||||
(cl-tty.backend:draw-text be 40 9 "Value" :bright-white :default :bold t)
|
||||
(loop for i from 0 below 8
|
||||
for pair = (nth i '(("Versions" "11") ("Components" "12")
|
||||
("Tests" "280+") ("Lines" "~3060")
|
||||
("Dependencies" "0") ("FFI" "0")
|
||||
("ncurses" "no") ("License" "GPL-3.0")))
|
||||
do (cl-tty.backend:draw-text be 8 (+ 11 i) (first pair) :white :default)
|
||||
(cl-tty.backend:draw-text be 40 (+ 11 i) (second pair)
|
||||
:bright-green :default :bold t)))
|
||||
(defun render-tab-home (backend x y w h)
|
||||
"Welcome screen with version info."
|
||||
(draw-border backend x y w h :style :double :title " Welcome ")
|
||||
(draw-text backend (+ x 2) (+ y 2) "cl-tty — Pure CL Terminal UI Framework" :bright-white nil :bold t)
|
||||
(draw-text backend (+ x 2) (+ y 4) " components: Box, Text, TextInput, TextArea, Select," nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 5) " ScrollBox, TabBar, Dialog, Toast, Markdown" nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 6) " features: 24-bit truecolor, OSC 8 links, SGR mouse," nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 7) " DECICM sync, kitty keyboard, framebuffer" nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 8) " backend: modern-backend | simple-backend (pipe-safe)" nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 9) " tests: 392, 100% passing" :green nil :bold t)
|
||||
(draw-text backend (+ x 2) (+ y 10) " deps: zero FFI, zero ncurses, pure CL" :bright-cyan nil)
|
||||
(draw-text backend (+ x 2) (+ y 12) "Controls" :bright-white nil :bold t)
|
||||
(draw-text backend (+ x 2) (+ y 13) " Tab / arrows switch tabs" nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 14) " q / Ctrl+C / Esc quit" nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 15) " mouse click/drag select text (test SGR mouse)" nil nil))
|
||||
|
||||
;;; ─── Tab bar ───────────────────────────────────────────────────────────────
|
||||
(defun render-tab-widgets (backend x y w h input ta)
|
||||
"Interactive widget demo."
|
||||
(declare (ignore h))
|
||||
(draw-border backend x y w 12 :style :single :title " Text Input ")
|
||||
(draw-text backend (+ x 2) (+ y 1) "Value: " :text-muted nil)
|
||||
(draw-text backend (+ x 10) (+ y 1) (text-input-value input) :text nil)
|
||||
(draw-text backend (+ x 2) (+ y 3) "Placeholder: \"Type here...\"" :text-muted nil)
|
||||
(draw-text backend (+ x 2) (+ y 5) "Keys: type to insert, arrows to move," nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 6) "Enter to submit, Backspace to delete," nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 7) "Ctrl+A/E for home/end" nil nil)
|
||||
(when (plusp (length (text-input-value input)))
|
||||
(draw-text backend (+ x 2) (+ y 9) (format nil "Submitted: ~a" (text-input-value input)) :accent nil))
|
||||
|
||||
(defun render-tabs (be tabs active)
|
||||
(let ((x 8))
|
||||
(cl-tty.backend:draw-rect be 6 4 68 1 :bg :default)
|
||||
(loop for label in tabs for i from 0
|
||||
do (let* ((text (format nil " ~a " label)) (len (length text)))
|
||||
(if (= i active)
|
||||
(progn (cl-tty.backend:draw-rect be x 4 len 1 :bg :bright-blue)
|
||||
(cl-tty.backend:draw-text be x 4 text
|
||||
:bright-white :bright-blue :bold t))
|
||||
(cl-tty.backend:draw-text be x 4 text :bright-white :default))
|
||||
(incf x (+ len 2))))))
|
||||
(let ((y2 (+ y 13)))
|
||||
(draw-border backend x y2 w 8 :style :single :title " TextArea ")
|
||||
(draw-text backend (+ x 2) (+ y2 1) "Value:" :text-muted nil)
|
||||
(loop for line in (textarea-lines ta)
|
||||
for row from 0 below 4
|
||||
do (draw-text backend (+ x 2) (+ y2 2 row)
|
||||
(subseq line 0 (min (length line) (- w 4))) nil nil))))
|
||||
|
||||
;;; ─── Main loop ─────────────────────────────────────────────────────────────
|
||||
(defun render-tab-console (backend x y w h)
|
||||
"Event log / debug console."
|
||||
(draw-border backend x y w h :style :single :title " Event Log ")
|
||||
(draw-text backend (+ x 2) (+ y 1) "Last 50 keyboard and mouse events:" :text-muted nil)
|
||||
(let* ((visible (min (length *log*) h))
|
||||
(lines (subseq *log* 0 visible)))
|
||||
(loop for line in lines
|
||||
for row from 0 below (min visible (- h 2))
|
||||
do (draw-text backend (+ x 2) (+ y 3 row)
|
||||
(subseq line 0 (min (length line) (- w 4))) nil nil))))
|
||||
|
||||
;;; ─── Main loop ──────────────────────────────────────────────────────────────
|
||||
|
||||
(defun handle-event (event)
|
||||
"Process a key-event or mouse-event, returning t if consumed."
|
||||
(typecase event
|
||||
(key-event
|
||||
(let ((key (key-event-key event))
|
||||
(ctrl (key-event-ctrl event)))
|
||||
(log-append "Key: ~a (ctrl=~a alt=~a shift=~a)" key ctrl (key-event-alt event) (key-event-shift event))
|
||||
(cond
|
||||
;; Tab navigation
|
||||
((and (eql key :tab) ctrl) nil) ; handled by global loop
|
||||
;; Quit
|
||||
((or (eql key :|Q|) (and ctrl (eql key :|C|)) (eql key :escape))
|
||||
(setf (getf *app* :running) nil) t)
|
||||
;; Tab switching (left/right)
|
||||
((eql key :left)
|
||||
(decf (getf *app* :tab))
|
||||
(when (minusp (getf *app* :tab)) (setf (getf *app* :tab) 2)) t)
|
||||
((eql key :right)
|
||||
(incf (getf *app* :tab))
|
||||
(when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
|
||||
;; Forward key to active widget
|
||||
(t (handle-text-input (getf *app* :input) event)
|
||||
(handle-textarea-input (getf *app* :textarea) event)
|
||||
t))))
|
||||
(mouse-event
|
||||
(log-append "Mouse: ~a btn=~a pos=(~d,~d)" (mouse-event-type event)
|
||||
(mouse-event-button event) (mouse-event-x event) (mouse-event-y event))
|
||||
(setf (getf *app* :mouse-x) (mouse-event-x event)
|
||||
(getf *app* :mouse-y) (mouse-event-y event))
|
||||
t)))
|
||||
|
||||
(defun run-demo ()
|
||||
(let* ((raw (find-symbol "SET-RAW-MODE" :cl-tty.input))
|
||||
(restore (find-symbol "RESTORE-TERMINAL-STATE" :cl-tty.input))
|
||||
(saved (funcall raw)))
|
||||
(unwind-protect
|
||||
(let* ((backend (cl-tty.backend:detect-backend))
|
||||
(tabs '(" Home " " Components " " Stats "))
|
||||
(active 0) (running t))
|
||||
(cl-tty.backend:initialize-backend backend)
|
||||
(cl-tty.backend:cursor-hide backend)
|
||||
(loop while running
|
||||
do (cl-tty.backend:backend-clear backend)
|
||||
(cl-tty.backend:draw-border backend 2 1 76 3
|
||||
:style :double :title " cl-tty ")
|
||||
(cl-tty.backend:draw-text backend 4 2
|
||||
"Interactive demo arrows: tabs q: quit" :bright-white :default)
|
||||
(render-tabs backend tabs active)
|
||||
(case active
|
||||
(0 (render-home backend))
|
||||
(1 (render-components backend))
|
||||
(2 (render-stats backend)))
|
||||
(cl-tty.backend:draw-rect backend 2 23 76 1 :bg :blue)
|
||||
(cl-tty.backend:draw-text backend 2 23
|
||||
(format nil " Tab ~d/3: ~a "
|
||||
(1+ active) (string-trim " " (nth active tabs)))
|
||||
:bright-white :blue :bold t)
|
||||
(case (read-key)
|
||||
((:ctrl-c :enter #\q #\Q) (setf running nil))
|
||||
((:right :tab) (setf active (mod (1+ active) (length tabs))))
|
||||
(:left (setf active (mod (1- active) (length tabs))))))
|
||||
(cl-tty.backend:cursor-show backend)
|
||||
(cl-tty.backend:backend-clear backend)
|
||||
(cl-tty.backend:shutdown-backend backend))
|
||||
(when saved (funcall restore saved)))))
|
||||
(with-raw-terminal
|
||||
(init-app-state)
|
||||
(let* ((backend (detect-backend)))
|
||||
(initialize-backend backend)
|
||||
(unwind-protect
|
||||
(let* ((w 80) (h 24))
|
||||
(loop while (getf *app* :running)
|
||||
do
|
||||
;; Clear and draw
|
||||
(backend-clear backend)
|
||||
;; Title bar
|
||||
(draw-border backend 2 1 (- w 4) 3 :style :double :title " cl-tty v0.15.0 ")
|
||||
(draw-text backend 4 2 "arrows/tab: tabs type: test input mouse: test SGR q/esc: quit"
|
||||
:bright-white nil)
|
||||
;; Tab bar
|
||||
(loop for (label . idx) in '((" Home " . 0) (" Widgets " . 1) (" Console " . 2))
|
||||
for x-pos = 8 then (+ x-pos label-len 4)
|
||||
for label-len = (length label)
|
||||
do (let ((active (eql idx (getf *app* :tab))))
|
||||
(if active
|
||||
(draw-text backend x-pos 4 label :bright-white :accent :bold t)
|
||||
(draw-text backend x-pos 4 label :text-muted nil))))
|
||||
;; Content area
|
||||
(case (getf *app* :tab)
|
||||
(0 (render-tab-home backend 4 6 72 16))
|
||||
(1 (render-tab-widgets backend 4 6 72 24
|
||||
(getf *app* :input)
|
||||
(getf *app* :textarea)))
|
||||
(2 (render-tab-console backend 4 6 72 16)))
|
||||
;; Mouse cursor indicator
|
||||
(let ((mx (getf *app* :mouse-x))
|
||||
(my (getf *app* :mouse-y)))
|
||||
(when (and (>= mx 0) (>= my 0))
|
||||
(draw-text backend mx my "●" :bright-cyan nil)))
|
||||
;; Status bar
|
||||
(draw-rect backend 2 23 (- w 4) 1 :bg :blue)
|
||||
(draw-text backend 4 23
|
||||
(format nil " Tab ~d/3 | ~d events received "
|
||||
(1+ (getf *app* :tab)) (length *log*))
|
||||
:bright-white :blue :bold t)
|
||||
;; Flush
|
||||
(finish-output *standard-output*)
|
||||
;; Read event — timeout so the render loop keeps going
|
||||
(let ((event (read-event backend :timeout nil)))
|
||||
(when event
|
||||
(handle-event event)))))
|
||||
(shutdown-backend backend)))))
|
||||
|
||||
;;; ─── Entry ──────────────────────────────────────────────────────────────────
|
||||
|
||||
(if (probe-file "/dev/tty")
|
||||
(run-demo)
|
||||
(format t "No TTY detected. Run in a terminal for the interactive demo.~%"))
|
||||
(uiop:quit (if (ignore-errors (run-demo)) 0 1))
|
||||
|
||||
Reference in New Issue
Block a user