restructure: move backend/ and layout/ into src/; convert README to org syntax; fix demo package conflict and alien-sap ioctl; update ROADMAP with v0.15.0; remove stale files
- Move backend/ and layout/ directories into src/ - Update all path references in ASD, scripts, docs - Convert README.org from Markdown syntax to proper Org-mode - Fix demo.lisp use-package conflict (both backend and input export #:read-event) - Fix modern-backend TIOCGWINSZ ioctl alien type (alien-sap wrapper) - Add v0.15.0 section to ROADMAP, update line count to 5760 - Add known gaps (suspend/resume-backend, slot modes) to v1.0.0 checklist - Remove docs/plans/, debug-layout.lisp, system-index.txt, ci-watchdog.sh - Move tangle.py to Hermes skill (org-babel-tangle) - Add .gitignore for fasl files
This commit is contained in:
Hermes Agent
191
demo.lisp
191
demo.lisp
@@ -7,11 +7,16 @@
|
||||
(push (truename ".") asdf:*central-registry*)
|
||||
(asdf:load-system :cl-tty)
|
||||
|
||||
(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)
|
||||
;; Symbols use explicit package prefixes to avoid read-event
|
||||
;; conflict between cl-tty.backend and cl-tty.input.
|
||||
|
||||
;; Short aliases for readability
|
||||
(import '(cl-tty.input:make-text-input
|
||||
cl-tty.input:text-input-value
|
||||
cl-tty.input:handle-text-input
|
||||
cl-tty.input:make-textarea
|
||||
cl-tty.input:textarea-lines
|
||||
cl-tty.input:handle-textarea-input))
|
||||
|
||||
;;; ─── Application state ───────────────────────────────────────────────────────
|
||||
|
||||
@@ -39,120 +44,148 @@
|
||||
(defun render-tab-home (backend x y w h)
|
||||
"Welcome screen with version info."
|
||||
(declare (ignore h))
|
||||
(draw-border backend x y w 18 :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) " Ctrl+C / Esc quit" nil nil)
|
||||
(draw-text backend (+ x 2) (+ y 15) " mouse click/drag select text (test SGR mouse)" nil nil))
|
||||
(cl-tty.backend:draw-border backend x y w 18 :style :double :title " Welcome ")
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 2)
|
||||
"cl-tty — Pure CL Terminal UI Framework" :bright-white nil :bold t)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 4)
|
||||
" components: Box, Text, TextInput, TextArea, Select," nil nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 5)
|
||||
" ScrollBox, TabBar, Dialog, Toast, Markdown" nil nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 6)
|
||||
" features: 24-bit truecolor, OSC 8 links, SGR mouse," nil nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 7)
|
||||
" DECICM sync, kitty keyboard, framebuffer" nil nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 8)
|
||||
" backend: modern-backend | simple-backend (pipe-safe)" nil nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 9)
|
||||
" tests: 483, 100% passing" :green nil :bold t)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 10)
|
||||
" deps: zero FFI, zero ncurses, pure CL" :bright-cyan nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 12)
|
||||
"Controls" :bright-white nil :bold t)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 13)
|
||||
" Tab / arrows switch tabs" nil nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 14)
|
||||
" Ctrl+C / Esc quit" nil nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 15)
|
||||
" mouse click/drag select text (test SGR mouse)" nil nil))
|
||||
|
||||
(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 ")
|
||||
(cl-tty.backend:draw-border backend x y w 12 :style :single :title " Text Input ")
|
||||
(let ((val (text-input-value input)))
|
||||
(draw-text backend (+ x 2) (+ y 1) "Value: " :text-muted nil)
|
||||
(draw-text backend (+ x 10) (+ y 1) (if (plusp (length val)) val "(empty)") :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)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 1) "Value: " :text-muted nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 10) (+ y 1)
|
||||
(if (plusp (length val)) val "(empty)") :text nil))
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 3)
|
||||
"Placeholder: \"Type here...\"" :text-muted nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 5)
|
||||
"Keys: type to insert, arrows to move," nil nil)
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 6)
|
||||
"Enter to submit, Backspace to delete," nil nil)
|
||||
(cl-tty.backend: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))
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 9)
|
||||
(format nil "Submitted: ~a" (text-input-value input)) :accent nil))
|
||||
|
||||
(let ((y2 (+ y 13)))
|
||||
(draw-border backend x y2 w 10 :style :single :title " TextArea ")
|
||||
(draw-text backend (+ x 2) (+ y2 1) "Value:" :text-muted nil)
|
||||
(cl-tty.backend:draw-border backend x y2 w 10 :style :single :title " TextArea ")
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y2 1) "Value:" :text-muted nil)
|
||||
(let ((lines (textarea-lines ta)))
|
||||
(loop for line in lines
|
||||
for row from 0 below (min (length lines) 6)
|
||||
do (draw-text backend (+ x 2) (+ y2 2 row)
|
||||
(subseq (or line "") 0 (min (length line) (- w 4))) nil nil)))))
|
||||
do (cl-tty.backend:draw-text backend (+ x 2) (+ y2 2 row)
|
||||
(subseq (or line "") 0 (min (length line) (- w 4))) nil nil)))))
|
||||
|
||||
(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)
|
||||
(cl-tty.backend:draw-border backend x y w h :style :single :title " Event Log ")
|
||||
(cl-tty.backend:draw-text backend (+ x 2) (+ y 1)
|
||||
"Last 50 keyboard and mouse events:" :text-muted nil)
|
||||
(let ((lines *log*)
|
||||
(max-rows (- h 3)))
|
||||
(loop for line in (subseq lines 0 (min (length lines) max-rows))
|
||||
for row from 0 below max-rows
|
||||
do (draw-text backend (+ x 2) (+ y 3 row)
|
||||
(subseq (or line "") 0 (min (length line) (- w 4))) nil nil))))
|
||||
do (cl-tty.backend:draw-text backend (+ x 2) (+ y 3 row)
|
||||
(subseq (or 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))
|
||||
(cl-tty.input:key-event
|
||||
(let ((key (cl-tty.input:key-event-key event))
|
||||
(ctrl (cl-tty.input:key-event-ctrl event)))
|
||||
(log-append "Key: ~a (ctrl=~a alt=~a shift=~a)" key ctrl
|
||||
(cl-tty.input:key-event-alt event)
|
||||
(cl-tty.input:key-event-shift event))
|
||||
(cond
|
||||
((or (and ctrl (eql key :|C|)) (eql key :escape))
|
||||
(setf (getf *app* :running) nil) t)
|
||||
((eql key :tab)
|
||||
(incf (getf *app* :tab))
|
||||
(when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
|
||||
;; Only arrow keys switch tabs when NOT on the Widgets tab.
|
||||
;; On the Widgets tab (tab=1), Left/Right are forwarded to widgets
|
||||
;; for cursor navigation in text inputs.
|
||||
((and (not (= (getf *app* :tab) 1))
|
||||
(eql key :left))
|
||||
(decf (getf *app* :tab))
|
||||
(when (minusp (getf *app* :tab)) (setf (getf *app* :tab) 2)) t)
|
||||
((and (not (= (getf *app* :tab) 1))
|
||||
(eql key :right))
|
||||
(incf (getf *app* :tab))
|
||||
(when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
|
||||
;; Forward key to widgets only when on the Widgets tab
|
||||
(t (when (= (getf *app* :tab) 1)
|
||||
(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))
|
||||
(incf (getf *app* :tab))
|
||||
(when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
|
||||
;; Only arrow keys switch tabs when NOT on the Widgets tab.
|
||||
;; On the Widgets tab (tab=1), Left/Right are forwarded to widgets
|
||||
;; for cursor navigation in text inputs.
|
||||
((and (not (= (getf *app* :tab) 1))
|
||||
(eql key :left))
|
||||
(decf (getf *app* :tab))
|
||||
(when (minusp (getf *app* :tab)) (setf (getf *app* :tab) 2)) t)
|
||||
((and (not (= (getf *app* :tab) 1))
|
||||
(eql key :right))
|
||||
(incf (getf *app* :tab))
|
||||
(when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
|
||||
;; Forward key to widgets only when on the Widgets tab
|
||||
(t (when (= (getf *app* :tab) 1)
|
||||
(handle-text-input (getf *app* :input) event)
|
||||
(handle-textarea-input (getf *app* :textarea) event))
|
||||
t))))
|
||||
(cl-tty.input:mouse-event
|
||||
(log-append "Mouse: ~a btn=~a pos=(~d,~d)"
|
||||
(cl-tty.input:mouse-event-type event)
|
||||
(cl-tty.input:mouse-event-button event)
|
||||
(cl-tty.input:mouse-event-x event)
|
||||
(cl-tty.input:mouse-event-y event))
|
||||
(setf (getf *app* :mouse-x) (cl-tty.input:mouse-event-x event)
|
||||
(getf *app* :mouse-y) (cl-tty.input:mouse-event-y event))
|
||||
t)))
|
||||
|
||||
(defun run-demo ()
|
||||
"Run the demo. Raw terminal mode should already be set by the
|
||||
./demo.sh shell wrapper."
|
||||
(init-app-state)
|
||||
(let* ((backend (detect-backend))
|
||||
(w (multiple-value-bind (cols rows) (backend-size backend)
|
||||
(let* ((backend (cl-tty.backend:detect-backend))
|
||||
(w (multiple-value-bind (cols rows) (cl-tty.backend:backend-size backend)
|
||||
(declare (ignore rows))
|
||||
cols))
|
||||
(h (multiple-value-bind (cols rows) (backend-size backend)
|
||||
(h (multiple-value-bind (cols rows) (cl-tty.backend:backend-size backend)
|
||||
(declare (ignore cols))
|
||||
rows)))
|
||||
(initialize-backend backend)
|
||||
(cl-tty.backend:initialize-backend backend)
|
||||
(unwind-protect
|
||||
(loop while (getf *app* :running)
|
||||
do
|
||||
(backend-clear backend)
|
||||
(cl-tty.backend: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 Esc/Ctrl+C: quit"
|
||||
:bright-white nil)
|
||||
(cl-tty.backend:draw-border backend 2 1 (- w 4) 3
|
||||
:style :double :title " cl-tty v0.15.0 ")
|
||||
(cl-tty.backend:draw-text backend 4 2
|
||||
"arrows/tab: tabs type: test input mouse: test SGR Esc/Ctrl+C: quit"
|
||||
:bright-white nil)
|
||||
;; Tab bar
|
||||
(loop for (label . idx) in '((" Home " . 0) (" Widgets " . 1) (" Console " . 2))
|
||||
for x-pos = 4 then (+ x-pos label-len 2)
|
||||
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))))
|
||||
(cl-tty.backend:draw-text backend x-pos 4 label
|
||||
:bright-white :accent :bold t)
|
||||
(cl-tty.backend:draw-text backend x-pos 4 label
|
||||
:text-muted nil))))
|
||||
;; Content area
|
||||
(case (getf *app* :tab)
|
||||
(0 (render-tab-home backend 4 6 (- w 4) (- h 8)))
|
||||
@@ -164,20 +197,20 @@
|
||||
(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)))
|
||||
(cl-tty.backend:draw-text backend mx my "@" :bright-cyan nil)))
|
||||
;; Status bar
|
||||
(draw-rect backend 2 (- h 2) (- w 4) 1 :bg :blue)
|
||||
(draw-text backend 4 (- h 2)
|
||||
(format nil " Tab ~d/3 | ~d events "
|
||||
(1+ (getf *app* :tab)) (length *log*))
|
||||
:bright-white :blue :bold t)
|
||||
(cl-tty.backend:draw-rect backend 2 (- h 2) (- w 4) 1 :bg :blue)
|
||||
(cl-tty.backend:draw-text backend 4 (- h 2)
|
||||
(format nil " Tab ~d/3 | ~d events "
|
||||
(1+ (getf *app* :tab)) (length *log*))
|
||||
:bright-white :blue :bold t)
|
||||
(finish-output *standard-output*)
|
||||
;; Read event — blocks until a key or mouse event arrives
|
||||
(let ((event (read-event backend)))
|
||||
(let ((event (cl-tty.input:read-event backend)))
|
||||
(cond
|
||||
((eq event :eof) (setf (getf *app* :running) nil))
|
||||
(event (handle-event event)))))
|
||||
(shutdown-backend backend))))
|
||||
(cl-tty.backend:shutdown-backend backend))))
|
||||
|
||||
(run-demo)
|
||||
(uiop:quit 0)
|
||||
|
||||
Reference in New Issue
Block a user