;;; 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") ;; Register local project in case it's not symlinked into quicklisp/local-projects/ (let ((cl-tty-path (truename "."))) (pushnew cl-tty-path ql:*local-project-directories* :test #'equal)) (ql:register-local-projects) (ignore-errors (ql:quickload :cl-tty :silent t)) ;; Fallback: load via asdf directly if quicklisp didn't find it (unless (find-package :cl-tty.backend) (load "cl-tty.asd") (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) ;;; ─── Application state ─────────────────────────────────────────────────────── (defvar *app* nil "Application state plist") (defvar *log* nil "Circular log buffer") (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 init-app-state () (setf *log* nil) (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")) ;;; ─── Tab renderers ────────────────────────────────────────────────────────── (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) " q / Ctrl+C / Esc quit" nil nil) (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 ") (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) (when (plusp (length (text-input-value input))) (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) (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 ((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)))) ;;; ─── 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 ((or (eql key :|Q|) (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) ((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 widgets for testing (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 ((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))))) (run-demo) (uiop:quit 0)