v0.15.0: Critical input/rendering fixes, subagent-reviewed #7
70
demo.lisp
70
demo.lisp
@@ -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)
|
||||||
|
|||||||
Reference in New Issue
Block a user