diff --git a/README.org b/README.org index bf5726d..4fc5fab 100644 --- a/README.org +++ b/README.org @@ -8,12 +8,28 @@ Pure CL terminal UI framework. No ncurses, no FFI, no external dependencies. ## Quick start +The simplest possible cl-tty program — detect the terminal, draw some text, +read a key, and shut down: + ```lisp -;; Create a modern terminal backend -(let ((backend (make-instance 'cl-tty.backend:modern-backend))) - (cl-tty.backend:initialize-backend backend) - ;; Backend is ready — write text, draw boxes, handle input - (cl-tty.backend:shutdown-backend backend)) +(sb-posix:with-raw-terminal + (let* ((be (cl-tty.backend:detect-backend)) + (w 80) (h 24)) + (cl-tty.backend:initialize-backend be) + (unwind-protect + (progn + (cl-tty.backend:draw-text be 0 0 "Hello, terminal!" :green nil :bold t) + (cl-tty.backend:draw-border be 0 1 30 5 :style :single) + (finish-output) + ;; Read one key (blocks) + (cl-tty.input:read-event be)) + (cl-tty.backend:shutdown-backend be)))) +``` + +Or run the full interactive demo: + +```bash +sbcl --script demo.lisp ``` ## Architecture @@ -22,26 +38,251 @@ Two backends, one protocol: - **modern-backend** — truecolor 24-bit, OSC 8 hyperlinks, DECICM sync, SGR mouse, kitty keyboard, bold/italic/underline, box-drawing chars -- **simple-backend** — ASCII art, no color, universal compatibility +- **simple-backend** — ASCII art, no color, universal compatibility (pipe-safe) Everything is pure escape sequences (no curses, no terminfo, no FFI). +### Backend protocol + +Every drawing operation is a CLOS generic function dispatched on the backend +class. Programs never call terminal codes directly: + +```lisp +;; Lifecycle +(initialize-backend backend) +(shutdown-backend backend) + +;; Drawing +(draw-text backend x y string fg bg &key bold italic underline reverse dim) +(draw-border backend x y width height &key style fg bg title) +(draw-rect backend x y width height &key bg) +(draw-link backend x y string url &key fg bg) + +;; Input +(read-event backend &key timeout) → key-event or mouse-event +(backend-size backend) → (values columns lines) + +;; Cursor +(cursor-move backend x y) +(cursor-hide backend) +(cursor-show backend) +(cursor-style backend shape &key blink) ;; :bar :block :underline +``` + +### Event loop pattern + +```lisp +(let ((be (detect-backend))) + (initialize-backend be) + (loop with running = t + while running + do (backend-clear be) + ;; ... draw frame ... + (finish-output *standard-output*) + (let ((event (read-event be))) + (typecase event + (key-event + (when (eql (key-event-key event) :escape) + (setf running nil))) + (mouse-event + ;; handle mouse + )))) + (shutdown-backend be)) +``` + +### Layout system + +Pure CL flexbox layout engine. No C dependencies, no Yoga FFI. + +```lisp +;; Macros build layout-trees: +(vbox (:gap 1 :padding 1) + (header "Title") + (hbox (:grow 1) + (sidebar (:width 30) ...) + (content ...))) +``` + +Layout properties: `:direction` (`:row` / `:column`), `:grow`, `:shrink`, +`:basis`, `:gap`, `:padding`, `:margin`, `:width`, `:height`, `:wrap`. + +See `layout/layout.lisp` or `org/layout-engine.org` for the full API. + +### Rendering pipeline + +Component trees render through a coordinated pipeline: + +1. **Layout pass** — `compute-layout` traverses dirty branches, solves flex constraints +2. **Render dispatch** — `render` generic dispatches per component type +3. **Framebuffer** — (optional) `make-framebuffer-backend` captures to a cell array, + `diff-framebuffers` computes minimal changes, `flush-framebuffer` writes only + changed cells + +```lisp +;; Full pipeline with framebuffer +(let* ((fb-be (make-framebuffer-backend :width 80 :height 24)) + (fb (fb-framebuffer fb-be))) + (render my-component fb-be) + (flush-framebuffer prev-fb fb real-backend)) +``` + ## Components -| Component | What it does | Version | -|-------------|------------------------------------------------------|---------| -| Box | Bordered container with background, title | v0.2.0 | -| Text | Styled text with word-wrap, spans | v0.2.0 | -| ScrollBox | Scrollable viewport with scrollbars | v0.6.0 | -| TabBar | Horizontal tab navigation | v0.6.0 | -| Select | Dropdown with fuzzy filter, category headers | v0.7.0 | -| TextInput | Single-line text input with readline keybindings | v0.5.0 | -| TextArea | Multi-line input with undo/redo, selection | v0.5.0 | -| Markdown | Renders markdown with syntax highlighting + diffs | v0.8.0 | -| Dialog | Modal overlays with stack management | v0.9.0 | -| Toast | Transient notifications (info/success/warning/error) | v0.9.0 | -| Mouse | Event handlers, hit-testing, text selection | v0.10.0 | -| Slot | Plugin system — named slots for extensible UI | v0.11.0 | +| Component | What it does | Status | +|-------------|------------------------------------------------------|--------| +| Box | Bordered container with background, title | stable | +| Text | Styled text with word-wrap, spans | stable | +| ScrollBox | Scrollable viewport with scrollbars | stable | +| TabBar | Horizontal tab navigation | stable | +| Select | Dropdown with fuzzy filter, category headers | stable | +| TextInput | Single-line text input with readline keybindings | stable | +| TextArea | Multi-line input with undo/redo, cursor movement | stable | +| Markdown | Renders markdown with syntax highlighting + diffs | stable | +| Dialog | Modal overlays with stack management | stable | +| Toast | Transient notifications (info/success/warning/error) | stable | +| Mouse | Event handlers, hit-testing, text selection | stable | +| Slot | Plugin system — named slots for extensible UI | stable | + +Each component follows a consistent pattern: + +```lisp +;; 1. Create — factory function returns instance +(let ((input (make-text-input :placeholder "Type here...")) + (box (make-box :border-style :single :title "My Box"))) + + ;; 2. Layout — macros compose components + (vbox (:gap 1) + box + (hbox (:grow 1) + input + (make-select :options '((:title "Option A") (:title "Option B"))))) + + ;; 3. Render — dispatches through the component protocol + (render my-component backend)) +``` + +### Box + +Bordered container. Draws borders using Unicode box-drawing characters +(modern) or ASCII `+`/`-`/`|` (simple). Supports background fill, titled +borders. See `org/box-renderable.org`. + +```lisp +(make-box &key (border-style :single) title (title-align :left) fg bg width height) +``` + +### Text + +Styled text with inline spans and word wrapping. Spans support per-run +attributes (bold, italic, underline, fg, bg). See `org/box-renderable.org`. + +```lisp +(make-text content &key fg bg wrap-mode width height spans) +;; Span example: +(span "hello" :bold t :fg :bright-yellow) +``` + +### TextInput + +Single-line text editor with emacs-style keybindings. Supports placeholder, +max-length, on-submit callback. See `org/text-input.org`. + +```lisp +(make-text-input &key value cursor placeholder max-length on-submit) +;; Widget logic (input-level, no backend needed): +(handle-text-input input (make-key-event :key :a :code (char-code #\a))) +``` + +### TextArea + +Multi-line text editor. Supports undo/redo (Ctrl+Z/Y), cursor movement, +line joining on backspace. See `org/text-input.org`. + +```lisp +(make-textarea &key value on-submit) +``` + +### ScrollBox + +Scrollable viewport with a list of children. Only renders children +intersecting the visible area (viewport culling). Scrollbars drawn +at the right/bottom edges. See `org/scrollbox-tabbar.org`. + +```lisp +(make-scroll-box &key children scroll-y scroll-x sticky-scroll-p) +(scroll-by sb dy dx) +``` + +### TabBar + +Horizontal tab navigation. Renders tab labels, highlights active tab. +Left/right arrows cycle through tabs. See `org/scrollbox-tabbar.org`. + +```lisp +(make-tab-bar &key tabs active) +(tab-bar-add tb id title) +(tab-bar-next tb) / (tab-bar-prev tb) +(tab-bar-handle-key tb event) +``` + +### Select + +Dropdown/filter widget. Options can have categories (rendered as +non-selectable headers). Fuzzy fallback: matching > 30% character +overlap. Arrow keys navigate, Enter selects. See `org/select.org`. + +```lisp +(make-select &key options filter on-select) +;; Options format: (:title "Name" :category "Group") or (:title "Name") +``` + +### Markdown + +Parsed markdown AST with rendering. Supports headings, paragraphs, +bold, italic, inline code, links, code blocks with syntax highlighting, +diff blocks, blockquotes, lists, thematic breaks. See +`org/markdown-renderer.org`. + +```lisp +(render-markdown "# Hello\n\nThis is **bold**.") +``` + +### Dialog + Toast + +Modal dialog stack. `alert-dialog`, `confirm-dialog`, `select-dialog`, +`prompt-dialog` are convenience constructors. Toasts are transient +notifications that auto-dismiss. See `org/dialog.org`. + +```lisp +(push-dialog (make-instance 'dialog :size :medium)) +(alert-dialog "Notice" "Operation complete") +(toast "Saved!" :variant :success) +``` + +### Mouse + +Mixin class providing mouse event handler slots. `hit-test` finds the +deepest component at a coordinate. Text selection tracks drag gestures. +Scrollboxes integrate wheel events. See `org/mouse.org`. + +```lisp +(defclass my-panel (mouse-mixin) ...) +(handle-mouse-event component mouse-event) +(hit-test root x y) → deepest matching component +``` + +### Slot system + +Plugin system for extensible rendering slots. Register named rendering +functions, then render them by slot name. Useful for toolbars, status +bars, and plugin architectures. + +```lisp +(defslot :status-bar :order 0 + (lambda (&rest args) + (draw-text backend 0 0 "Ready" :text-muted nil))) +(slot-render :status-bar) +``` ## Backend features @@ -56,18 +297,80 @@ Everything is pure escape sequences (no curses, no terminfo, no FFI). | Box drawing chars | Unicode| ASCII | | Pipe-safe | No | Yes | +Backend selection happens automatically via `detect-backend`. It checks: +1. Is stdout a TTY? (if not → simple-backend) +2. Does `COLORTERM` contain "truecolor" or "24bit"? +3. Send DA1 query — does the terminal respond with modern feature codes? + +Result is cached in `*detected-backend*`. + ## Development ```bash -# Run all tests +# Run all tests (392 checks, 12 suites) sbcl --script run-all-tests.lisp -# Tangle org files -emacs --batch --eval "(progn (require 'org) (find-file \"org/FILE.org\") (org-babel-tangle) (kill-buffer))" +# Run interactive demo +sbcl --script demo.lisp + +# Tangle org files (regenerate .lisp from .org sources) +for f in org/*.org; do + emacs --batch --eval "(progn (require 'org) (find-file \"$f\") (org-babel-tangle) (kill-buffer))" 2>&1 +done ``` -Literate programming: `.org` files in `org/` are the source of truth. -`.lisp` files are generated by tangling. +Literate programming: `.org` files in `org/` are the source of truth for +the input system, scrollbox/tabbar, dialog, mouse, select, slot, +framebuffer, and markdown modules. The backend (`modern.lisp`, +`simple.lisp`) and basic components (`box.lisp`, `text.lisp`, `render.lisp`, +`theme.lisp`, `dirty.lisp`) are written directly. + +Project structure: + +``` +cl-tty/ +├── cl-tty.asd # ASDF system definition +├── demo.lisp # Interactive demo +├── run-all-tests.lisp # Test runner +├── backend/ # Backend protocol + implementations +│ ├── package.lisp +│ ├── classes.lisp # Generic definitions +│ ├── simple.lisp # ASCII fallback backend +│ ├── modern.lisp # Truecolor escape backend +│ └── detection.lisp # Auto-detect backend from env +├── layout/ # Flexbox layout engine +│ └── layout.lisp +├── src/ +│ ├── rendering/ # Framebuffer backend + diff + flush +│ │ └── framebuffer.lisp +│ └── components/ # Widgets +│ ├── box.lisp, text.lisp, render.lisp, theme.lisp +│ ├── dirty.lisp, input-package.lisp, input.lisp +│ ├── text-input.lisp, textarea.lisp, keybindings.lisp +│ ├── scrollbox.lisp, tabbar.lisp, container-package.lisp +│ ├── select.lisp, select-package.lisp +│ ├── markdown.lisp, markdown-package.lisp +│ ├── dialog.lisp, dialog-package.lisp +│ ├── mouse.lisp, mouse-package.lisp +│ └── slot.lisp, slot-package.lisp +├── tests/ # Test files +├── org/ # Literate source files +│ ├── text-input.org +│ ├── scrollbox-tabbar.org +│ ├── dialog.org +│ ├── mouse.org +│ ├── select.org +│ ├── slot.org +│ ├── framebuffer.org +│ ├── markdown-renderer.org +│ ├── detection.org +│ ├── modern-backend.org +│ ├── box-renderable.org +│ └── layout-engine.org +└── docs/ + ├── ROADMAP.org # Versioned roadmap + └── ARCHITECTURE.org # Design docs +``` ## License diff --git a/cl-tty.asd b/cl-tty.asd index c96cba6..064288f 100644 --- a/cl-tty.asd +++ b/cl-tty.asd @@ -2,7 +2,7 @@ (asdf:defsystem :cl-tty :description "Reusable Common Lisp Terminal UI Framework" :author "Amr Gharbeia" - :version "0.14.0" + :version "0.15.0" :license "GPL-3.0" :depends-on (:sb-posix) :components diff --git a/demo.lisp b/demo.lisp index de2b165..9c65f74 100644 --- a/demo.lisp +++ b/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)) diff --git a/src/components/input-package.lisp b/src/components/input-package.lisp index 941f8dc..852926d 100644 --- a/src/components/input-package.lisp +++ b/src/components/input-package.lisp @@ -26,6 +26,7 @@ #:textarea-value #:textarea-cursor-row #:textarea-cursor-col #:textarea-on-submit #:textarea-undo-stack #:textarea-redo-stack #:textarea-layout-node + #:textarea-lines #:handle-textarea-input #:render-textarea ;; Keybindings #:keymap #:make-keymap #:keymap-name #:keymap-bindings #:keymap-parent diff --git a/src/components/input.lisp b/src/components/input.lisp index 419837f..eae07e8 100644 --- a/src/components/input.lisp +++ b/src/components/input.lisp @@ -87,26 +87,27 @@ ;;; Low-level byte reading ;;; --------------------------------------------------------------------------- (defun read-raw-byte (&key timeout) - (if timeout - (let ((deadline (+ (get-universal-time) timeout))) - (loop while (< (get-universal-time) deadline) - do (handler-case - (let ((buf (make-array 1 :element-type '(unsigned-byte 8)))) - (let ((n (sb-posix:read 0 buf 1))) - (when (plusp n) - (return-from read-raw-byte (aref buf 0))))) - (sb-posix:syscall-error () - (return-from read-raw-byte nil))) - (sleep 0.01)) - nil) - (let ((buf (make-array 1 :element-type '(unsigned-byte 8)))) - (multiple-value-bind (n err) - (ignore-errors (sb-posix:read 0 buf 1)) - (if (and (integerp n) (plusp n)) - (aref buf 0) - (progn - (when err (format *error-output* "read error: ~A~%" err)) - nil)))))) + (flet ((read-one () + (let ((buf (make-array 1 :element-type '(unsigned-byte 8)))) + ;; Use sb-sys:with-pinned-objects so sb-posix:read can access the buffer + (sb-sys:with-pinned-objects (buf) + (let ((n (sb-posix:read 0 (sb-sys:vector-sap buf) 1))) + (when (plusp n) + (return-from read-raw-byte (aref buf 0)))))))) + (if timeout + (let ((deadline (+ (get-universal-time) timeout))) + (loop while (< (get-universal-time) deadline) + do (handler-case + (read-one) + (sb-posix:syscall-error () + (return-from read-raw-byte nil))) + (sleep 0.01)) + nil) + (handler-case + (read-one) + (sb-posix:syscall-error (e) + (format *error-output* "read error: ~A~%" e) + nil))))) ;;; --------------------------------------------------------------------------- ;;; CSI parameter parser