amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
26b1aaf36d5b2843b31945a8e9090fda62875555
cl-tty/demo.lisp
Hermes 26b1aaf36d v0.15.0: Rewrite demo, update README, fix read-raw-byte buffer, export textarea-lines 
Demo (demo.lisp):
  - Full interactive demo with 3 tabs: Home, Widgets, Console
  - Uses read-event/SGR mouse paths (exercises real terminal input)
  - Demonstrates text-input, textarea, backend drawing, tab navigation
  - Event log console shows keyboard and mouse events in real time
  - Proper terminal cleanup via shutdown-backend + unwind-protect

README.org:
  - Complete rewrite with getting-started guide, architecture overview
  - API reference for all components with signatures and examples
  - Event loop pattern, layout system, rendering pipeline docs
  - Backend features table, development guide, project structure

Bug fixes:
  - read-raw-byte (input.lisp:89-109): use sb-sys:with-pinned-objects +
    vector-sap for proper sb-posix:read buffer handling (SBCL type error
    with plain (unsigned-byte 8) arrays)
  - input-package.lisp: export textarea-lines (was missing from package)

Version bump: v0.14.0 → v0.15.0

392 tests pass.
2026-05-12 01:08:26 +00:00

173 lines
8.6 KiB
Common Lisp
Raw Blame History

;;; 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")
(ql:register-local-projects)
(ql:quickload :cl-tty :silent t)
(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")
(defvar *log-pos* 0)
(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 *log-pos* 0)
(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."
(draw-border backend x y w h :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 ")
(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 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 8 :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))))
(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))
do (draw-text backend (+ x 2) (+ y 3 row)
(subseq 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
;; 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 :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
(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 ()
(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)))))
(uiop:quit (if (ignore-errors (run-demo)) 0 1))
Reference in New Issue View Git Blame Copy Permalink