v0.15.0: Critical input/rendering fixes, subagent-reviewed #7

Merged
amr merged 36 commits from feature/v0.11.0-slots into main 2026-05-11 22:03:18 -04:00
Showing only changes of commit a888eb2c76 - Show all commits

View File

@@ -19,7 +19,6 @@
(defvar *app* nil "Application state plist") (defvar *app* nil "Application state plist")
(defvar *log* nil "Circular log buffer") (defvar *log* nil "Circular log buffer")
(defvar *log-pos* 0)
(defun log-append (fmt &rest args) (defun log-append (fmt &rest args)
(let* ((msg (apply #'format nil fmt args)) (let* ((msg (apply #'format nil fmt args))
@@ -29,7 +28,7 @@
(when (> (length *log*) 100) (setf *log* (subseq *log* 0 100))))) (when (> (length *log*) 100) (setf *log* (subseq *log* 0 100)))))
(defun init-app-state () (defun init-app-state ()
(setf *log* nil *log-pos* 0) (setf *log* nil)
(setf *app* (list :tab 0 (setf *app* (list :tab 0
:input (make-text-input :placeholder "Type here...") :input (make-text-input :placeholder "Type here...")
:textarea (make-textarea :value "Hello\nWorld") :textarea (make-textarea :value "Hello\nWorld")
@@ -41,7 +40,8 @@
(defun render-tab-home (backend x y w h) (defun render-tab-home (backend x y w h)
"Welcome screen with version info." "Welcome screen with version info."
(draw-border backend x y w h :style :double :title " Welcome ") (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 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 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 5) " ScrollBox, TabBar, Dialog, Toast, Markdown" nil nil)
@@ -59,8 +59,9 @@
"Interactive widget demo." "Interactive widget demo."
(declare (ignore h)) (declare (ignore h))
(draw-border backend x y w 12 :style :single :title " Text Input ") (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 2) (+ y 1) "Value: " :text-muted nil)
(draw-text backend (+ x 10) (+ y 1) (text-input-value input) :text 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 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 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 6) "Enter to submit, Backspace to delete," nil nil)
@@ -69,23 +70,24 @@
(draw-text backend (+ x 2) (+ y 9) (format nil "Submitted: ~a" (text-input-value input)) :accent nil)) (draw-text backend (+ x 2) (+ y 9) (format nil "Submitted: ~a" (text-input-value input)) :accent nil))
(let ((y2 (+ y 13))) (let ((y2 (+ y 13)))
(draw-border backend x y2 w 8 :style :single :title " TextArea ") (draw-border backend x y2 w 10 :style :single :title " TextArea ")
(draw-text backend (+ x 2) (+ y2 1) "Value:" :text-muted nil) (draw-text backend (+ x 2) (+ y2 1) "Value:" :text-muted nil)
(loop for line in (textarea-lines ta) (let ((lines (textarea-lines ta)))
for row from 0 below 4 (loop for line in lines
for row from 0 below (min (length lines) 6)
do (draw-text backend (+ x 2) (+ y2 2 row) do (draw-text backend (+ x 2) (+ y2 2 row)
(subseq line 0 (min (length line) (- w 4))) nil nil)))) (subseq (or line "") 0 (min (length line) (- w 4))) nil nil)))))
(defun render-tab-console (backend x y w h) (defun render-tab-console (backend x y w h)
"Event log / debug console." "Event log / debug console."
(draw-border backend x y w h :style :single :title " Event Log ") (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) (draw-text backend (+ x 2) (+ y 1) "Last 50 keyboard and mouse events:" :text-muted nil)
(let* ((visible (min (length *log*) h)) (let ((lines *log*)
(lines (subseq *log* 0 visible))) (max-rows (- h 3)))
(loop for line in lines (loop for line in (subseq lines 0 (min (length lines) max-rows))
for row from 0 below (min visible (- h 2)) for row from 0 below max-rows
do (draw-text backend (+ x 2) (+ y 3 row) do (draw-text backend (+ x 2) (+ y 3 row)
(subseq line 0 (min (length line) (- w 4))) nil nil)))) (subseq (or line "") 0 (min (length line) (- w 4))) nil nil))))
;;; ─── Main loop ────────────────────────────────────────────────────────────── ;;; ─── Main loop ──────────────────────────────────────────────────────────────
@@ -97,19 +99,18 @@
(ctrl (key-event-ctrl 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)) (log-append "Key: ~a (ctrl=~a alt=~a shift=~a)" key ctrl (key-event-alt event) (key-event-shift event))
(cond (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)) ((or (eql key :|Q|) (and ctrl (eql key :|C|)) (eql key :escape))
(setf (getf *app* :running) nil) t) (setf (getf *app* :running) nil) t)
;; Tab switching (left/right) ((eql key :tab)
(incf (getf *app* :tab))
(when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
((eql key :left) ((eql key :left)
(decf (getf *app* :tab)) (decf (getf *app* :tab))
(when (minusp (getf *app* :tab)) (setf (getf *app* :tab) 2)) t) (when (minusp (getf *app* :tab)) (setf (getf *app* :tab) 2)) t)
((eql key :right) ((eql key :right)
(incf (getf *app* :tab)) (incf (getf *app* :tab))
(when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t) (when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t)
;; Forward key to active widget ;; Forward key to widgets for testing
(t (handle-text-input (getf *app* :input) event) (t (handle-text-input (getf *app* :input) event)
(handle-textarea-input (getf *app* :textarea) event) (handle-textarea-input (getf *app* :textarea) event)
t)))) t))))
@@ -121,15 +122,18 @@
t))) t)))
(defun run-demo () (defun run-demo ()
(with-raw-terminal (let ((saved (ignore-errors (set-raw-mode))))
(unless saved
(format *error-output* "Failed to set raw mode, trying pipe-safe mode~%"))
(unwind-protect
(progn
(init-app-state) (init-app-state)
(let* ((backend (detect-backend))) (let* ((backend (detect-backend))
(w 80) (h 24))
(initialize-backend backend) (initialize-backend backend)
(unwind-protect (unwind-protect
(let* ((w 80) (h 24))
(loop while (getf *app* :running) (loop while (getf *app* :running)
do do
;; Clear and draw
(backend-clear backend) (backend-clear backend)
;; Title bar ;; Title bar
(draw-border backend 2 1 (- w 4) 3 :style :double :title " cl-tty v0.15.0 ") (draw-border backend 2 1 (- w 4) 3 :style :double :title " cl-tty v0.15.0 ")
@@ -137,7 +141,7 @@
:bright-white nil) :bright-white nil)
;; Tab bar ;; Tab bar
(loop for (label . idx) in '((" Home " . 0) (" Widgets " . 1) (" Console " . 2)) (loop for (label . idx) in '((" Home " . 0) (" Widgets " . 1) (" Console " . 2))
for x-pos = 8 then (+ x-pos label-len 4) for x-pos = 4 then (+ x-pos label-len 2)
for label-len = (length label) for label-len = (length label)
do (let ((active (eql idx (getf *app* :tab)))) do (let ((active (eql idx (getf *app* :tab))))
(if active (if active
@@ -145,7 +149,7 @@
(draw-text backend x-pos 4 label :text-muted nil)))) (draw-text backend x-pos 4 label :text-muted nil))))
;; Content area ;; Content area
(case (getf *app* :tab) (case (getf *app* :tab)
(0 (render-tab-home backend 4 6 72 16)) (0 (render-tab-home backend 4 6 72 20))
(1 (render-tab-widgets backend 4 6 72 24 (1 (render-tab-widgets backend 4 6 72 24
(getf *app* :input) (getf *app* :input)
(getf *app* :textarea))) (getf *app* :textarea)))
@@ -154,19 +158,21 @@
(let ((mx (getf *app* :mouse-x)) (let ((mx (getf *app* :mouse-x))
(my (getf *app* :mouse-y))) (my (getf *app* :mouse-y)))
(when (and (>= mx 0) (>= my 0)) (when (and (>= mx 0) (>= my 0))
(draw-text backend mx my "" :bright-cyan nil))) (draw-text backend mx my "@" :bright-cyan nil)))
;; Status bar ;; Status bar
(draw-rect backend 2 23 (- w 4) 1 :bg :blue) (draw-rect backend 2 23 (- w 4) 1 :bg :blue)
(draw-text backend 4 23 (draw-text backend 4 23
(format nil " Tab ~d/3 | ~d events received " (format nil " Tab ~d/3 | ~d events "
(1+ (getf *app* :tab)) (length *log*)) (1+ (getf *app* :tab)) (length *log*))
:bright-white :blue :bold t) :bright-white :blue :bold t)
;; Flush
(finish-output *standard-output*) (finish-output *standard-output*)
;; Read event — timeout so the render loop keeps going ;; Read event — blocks until a key or mouse event arrives
(let ((event (read-event backend :timeout nil))) (let ((event (read-event backend)))
(when event (when event
(handle-event event))))) (handle-event event))))
(shutdown-backend backend))))) (shutdown-backend backend))))
(when saved
(restore-terminal-state saved)))))
(uiop:quit (if (ignore-errors (run-demo)) 0 1)) (run-demo)
(uiop:quit 0)