diff --git a/demo.lisp b/demo.lisp index 9c65f74..7fd7732 100644 --- a/demo.lisp +++ b/demo.lisp @@ -19,7 +19,6 @@ (defvar *app* nil "Application state plist") (defvar *log* nil "Circular log buffer") -(defvar *log-pos* 0) (defun log-append (fmt &rest args) (let* ((msg (apply #'format nil fmt args)) @@ -29,7 +28,7 @@ (when (> (length *log*) 100) (setf *log* (subseq *log* 0 100))))) (defun init-app-state () - (setf *log* nil *log-pos* 0) + (setf *log* nil) (setf *app* (list :tab 0 :input (make-text-input :placeholder "Type here...") :textarea (make-textarea :value "Hello\nWorld") @@ -41,7 +40,8 @@ (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 ") + (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) @@ -59,8 +59,9 @@ "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) + (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) @@ -69,23 +70,24 @@ (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 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) - (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)))) + (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))))) (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)) + (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 line 0 (min (length line) (- w 4))) nil nil)))) + (subseq (or line "") 0 (min (length line) (- w 4))) nil nil)))) ;;; ─── Main loop ────────────────────────────────────────────────────────────── @@ -97,19 +99,18 @@ (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 :tab) + (incf (getf *app* :tab)) + (when (> (getf *app* :tab) 2) (setf (getf *app* :tab) 0)) t) ((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 + ;; Forward key to widgets for testing (t (handle-text-input (getf *app* :input) event) (handle-textarea-input (getf *app* :textarea) event) t)))) @@ -121,52 +122,57 @@ t))) (defun run-demo () - (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))))) + (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) + (let* ((backend (detect-backend)) + (w 80) (h 24)) + (initialize-backend backend) + (unwind-protect + (loop while (getf *app* :running) + do + (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 = 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)))) + ;; Content area + (case (getf *app* :tab) + (0 (render-tab-home backend 4 6 72 20)) + (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 " + (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))) + (when event + (handle-event event)))) + (shutdown-backend backend)))) + (when saved + (restore-terminal-state saved))))) -(uiop:quit (if (ignore-errors (run-demo)) 0 1)) +(run-demo) +(uiop:quit 0)