backend/modern-tests.lisp

@@ -0,0 +1,124 @@
+(defpackage :cl-tui-modern-backend-test
+  (:use :cl :fiveam :cl-tui.backend)
+  (:export #:run-tests))
+(in-package :cl-tui-modern-backend-test)
+
+(def-suite modern-backend-suite :description "Modern backend tests")
+(in-suite modern-backend-suite)
+
+(defun run-tests ()
+  (let ((result (run 'modern-backend-suite)))
+    (fiveam:explain! result)
+    (uiop:quit 0)))
+
+;; ── Constructor ────────────────────────────────────────────────
+
+(test make-modern-backend-creates
+  "make-modern-backend returns a modern-backend instance"
+  (let ((b (make-modern-backend)))
+    (is (typep b 'cl-tui.backend::modern-backend))))
+
+;; ── Escape Generation ──────────────────────────────────────────
+
+(test sgr-truecolor-foreground
+  "SGR truecolor foreground escape is correct"
+  (is (equal (cl-tui.backend::sgr-fg "#FFD700")
+             (format nil "~C[38;2;255;215;0m" #\Esc))))
+
+(test sgr-truecolor-background
+  "SGR truecolor background escape is correct"
+  (is (equal (cl-tui.backend::sgr-bg "#1a1b26")
+             (format nil "~C[48;2;26;27;38m" #\Esc))))
+
+(test sgr-named-colors
+  "SGR named colors resolve to 8-color codes"
+  (is (equal (cl-tui.backend::sgr-fg :red)
+             (format nil "~C[31m" #\Esc)))
+  (is (equal (cl-tui.backend::sgr-bg :blue)
+             (format nil "~C[44m" #\Esc))))
+
+(test sgr-bold-italic
+  "SGR attribute escapes are correct"
+  (is (equal (cl-tui.backend::sgr-attr :bold) (format nil "~C[1m" #\Esc)))
+  (is (equal (cl-tui.backend::sgr-attr :italic) (format nil "~C[3m" #\Esc)))
+  (is (equal (cl-tui.backend::sgr-attr :underline) (format nil "~C[4m" #\Esc)))
+  (is (equal (cl-tui.backend::sgr-attr :reset) (format nil "~C[0m" #\Esc))))
+
+;; ── Cursor ─────────────────────────────────────────────────────
+
+(test cursor-move-escape
+  "cursor-move generates correct CSI escape"
+  (let ((b (make-modern-backend)))
+    (is (equal (cl-tui.backend::cursor-move-escape 5 10)
+               (format nil "~C[11;6H" #\Esc)))))
+
+(test cursor-style-block
+  "cursor-style :block generate correct escape"
+  (let ((b (make-modern-backend)))
+    (is (equal (cl-tui.backend::cursor-style-escape :block nil)
+               (format nil "~C[2 q" #\Esc)))))
+
+(test cursor-style-bar
+  "cursor-style :bar generate correct escape"
+  (let ((b (make-modern-backend)))
+    (is (equal (cl-tui.backend::cursor-style-escape :bar nil)
+               (format nil "~C[6 q" #\Esc)))))
+
+(test cursor-style-underline-blink
+  "cursor-style :underline with blink"
+  (let ((b (make-modern-backend)))
+    (is (equal (cl-tui.backend::cursor-style-escape :underline t)
+               (format nil "~C[5 q" #\Esc)))))
+
+;; ── Synchronization ────────────────────────────────────────────
+
+(test decicm-escapes
+  "DECICM synchronized update escapes"
+  (is (equal (cl-tui.backend::decicm-begin) (format nil "~C[?2026h" #\Esc)))
+  (is (equal (cl-tui.backend::decicm-end) (format nil "~C[?2026l" #\Esc))))
+
+;; ── OSC 8 Hyperlinks ──────────────────────────────────────────
+
+(test osc8-escape
+  "OSC 8 hyperlink escape wraps text"
+  (is (equal (cl-tui.backend::osc8-link "http://example.com" "click here")
+             (format nil "~C]8;;http://example.com~C\\click here~C]8;;~C\\"
+                     #\Esc #\Esc #\Esc #\Esc))))
+
+;; ── Hex Parsing ────────────────────────────────────────────────
+
+(test hex-color-parsing
+  "hex-to-rgb parses valid hex colors"
+  (multiple-value-bind (r g b) (cl-tui.backend::hex-to-rgb "#FFD700")
+    (is (= r 255))
+    (is (= g 215))
+    (is (= b 0))))
+
+(test hex-color-black
+  "hex-to-rgb parses black"
+  (multiple-value-bind (r g b) (cl-tui.backend::hex-to-rgb "#000000")
+    (is (= r 0))
+    (is (= g 0))
+    (is (= b 0))))
+
+(test hex-color-short-form
+  "hex-to-rgb parses 3-digit hex"
+  (multiple-value-bind (r g b) (cl-tui.backend::hex-to-rgb "#F00")
+    (is (= r 255))
+    (is (= g 0))
+    (is (= b 0))))
+
+;; ── Border Characters ──────────────────────────────────────────
+
+(test border-char-rounded
+  "modern-border-char returns Unicode box-drawing for rounded style"
+  (is (equal (cl-tui.backend::border-char :rounded :top-left) "╭"))
+  (is (equal (cl-tui.backend::border-char :rounded :horizontal) "─"))
+  (is (equal (cl-tui.backend::border-char :rounded :vertical) "│"))
+  (is (equal (cl-tui.backend::border-char :rounded :bottom-right) "╯")))
+
+(test border-char-double
+  "modern-border-char returns double-line chars"
+  (is (equal (cl-tui.backend::border-char :double :top-left) "╔"))
+  (is (equal (cl-tui.backend::border-char :double :horizontal) "═"))
+  (is (equal (cl-tui.backend::border-char :double :vertical) "║")))

backend/modern.lisp

@@ -0,0 +1,245 @@
+;;; modern-backend — Raw escape sequence backend
+;;; Generated from org/modern-backend.org
+;;; DO NOT EDIT — edit the .org file instead
+
+;; In package.lisp, add to :export:
+;;   #:modern-backend #:make-modern-backend
+;; Internal symbols (not exported, used by tests):
+;;   sgr-fg sgr-bg sgr-attr cursor-move-escape cursor-style-escape
+;;   decicm-begin decicm-end osc8-link hex-to-rgb border-char
+
+(in-package :cl-tui.backend)
+
+(defun hex-to-rgb (hex)
+  "Parse a hex color string like \"#FFD700\" into (values r g b).
+  Also handles 3-digit hex like \"#F00\" (expands to \"#FF0000\")."
+  (let ((clean (string-trim '(#\# #\Space) hex)))
+    (if (= (length clean) 3)
+        ;; Expand 3-digit: #F00 -> #FF0000
+        (let* ((r (parse-integer (subseq clean 0 1) :radix 16 :junk-allowed t))
+               (g (parse-integer (subseq clean 1 2) :radix 16 :junk-allowed t))
+               (b (parse-integer (subseq clean 2 3) :radix 16 :junk-allowed t)))
+          (values (+ r (* r 16)) (+ g (* g 16)) (+ b (* b 16))))
+        (values (parse-integer (subseq clean 0 2) :radix 16 :junk-allowed t)
+                (parse-integer (subseq clean 2 4) :radix 16 :junk-allowed t)
+                (parse-integer (subseq clean 4 6) :radix 16 :junk-allowed t)))))
+
+(defparameter *named-colors*
+  '((:black . 0) (:red . 1) (:green . 2) (:yellow . 3)
+    (:blue . 4) (:magenta . 5) (:cyan . 6) (:white . 7)))
+
+(defun sgr-fg (color)
+  "Return SGR foreground escape for COLOR.
+  Color can be a hex string, a keyword name, or nil."
+  (if (null color) ""
+      (cond ((and (stringp color) (char= (char color 0) #\#))
+             (multiple-value-bind (r g b) (hex-to-rgb color)
+               (format nil "~C[38;2;~d;~d;~dm" #\Esc r g b)))
+            ((keywordp color)
+             (let ((index (cdr (assoc color *named-colors*))))
+               (if index
+                   (format nil "~C[~dm" #\Esc (+ 30 index))
+                   "")))
+            (t ""))))
+
+(defun sgr-bg (color)
+  "Return SGR background escape for COLOR."
+  (if (null color) ""
+      (cond ((and (stringp color) (char= (char color 0) #\#))
+             (multiple-value-bind (r g b) (hex-to-rgb color)
+               (format nil "~C[48;2;~d;~d;~dm" #\Esc r g b)))
+            ((keywordp color)
+             (let ((index (cdr (assoc color *named-colors*))))
+               (if index
+                   (format nil "~C[~dm" #\Esc (+ 40 index))
+                   "")))
+            (t ""))))
+
+(defparameter *sgr-attr-codes*
+  '((:bold . 1) (:dim . 2) (:italic . 3) (:underline . 4)
+    (:blink . 5) (:reverse . 7) (:reset . 0)))
+
+(defun sgr-attr (attr)
+  "Return SGR attribute escape for ATTR keyword."
+  (let ((code (cdr (assoc attr *sgr-attr-codes*))))
+    (if code
+        (format nil "~C[~dm" #\Esc code)
+        "")))
+
+(defun cursor-move-escape (x y)
+  "Return CSI escape to move cursor to (x, y), 1-indexed."
+  (format nil "~C[~d;~dH" #\Esc (1+ y) (1+ x)))
+
+(defun cursor-style-escape (shape blink)
+  "Return DECSTR escape for cursor shape.
+  :block = 2, :underline = 4, :bar = 6.
+  Add 1 for blink variants."
+  (let* ((base (case shape
+                 (:block 2) (:underline 4) (:bar 6)
+                 (t 2)))
+         (code (if blink (1+ base) base)))
+    (format nil "~C[~d q" #\Esc code)))
+
+(defun decicm-begin ()
+  "Return escape to enable synchronized updates."
+  (format nil "~C[?2026h" #\Esc))
+
+(defun decicm-end ()
+  "Return escape to disable synchronized updates."
+  (format nil "~C[?2026l" #\Esc))
+
+(defun osc8-link (url text)
+  "Wrap TEXT in an OSC 8 hyperlink to URL."
+  (format nil "~C]8;;~A~C\\~A~C]8;;~C\\"
+          #\Esc url #\Esc text #\Esc #\Esc))
+
+(defparameter *border-chars*
+  '(((:single :top-left) . "┌") ((:single :top-right) . "┐")
+    ((:single :bottom-left) . "└") ((:single :bottom-right) . "┘")
+    ((:single :horizontal) . "─") ((:single :vertical) . "│")
+    ((:double :top-left) . "╔") ((:double :top-right) . "╗")
+    ((:double :bottom-left) . "╚") ((:double :bottom-right) . "╝")
+    ((:double :horizontal) . "═") ((:double :vertical) . "║")
+    ((:rounded :top-left) . "╭") ((:rounded :top-right) . "╮")
+    ((:rounded :bottom-left) . "╰") ((:rounded :bottom-right) . "╯")
+    ((:rounded :horizontal) . "─") ((:rounded :vertical) . "│")))
+
+(defun border-char (style pos)
+  "Return the Unicode box-drawing character for STYLE at POS."
+  (let ((char (cdr (assoc (list style pos) *border-chars* :test #'equal))))
+    (or char (if (member pos '(:horizontal :vertical))
+                 (case pos (:horizontal "─") (:vertical "│"))
+                 "+"))))
+
+(defclass modern-backend ()
+  ((output-stream :initform *standard-output*
+                  :accessor backend-output-stream)
+   (in-sync-p :initform nil :accessor in-sync-p)))
+
+(defun make-modern-backend (&key color-palette)
+  (declare (ignore color-palette))
+  (make-instance 'modern-backend))
+
+(defmethod initialize-backend ((b modern-backend))
+  ;; Enter raw mode, enable mouse, bracketed paste
+  (backend-write b (format nil "~C[?1049h" #\Esc))  ; alt screen
+  (backend-write b (format nil "~C[?1000h" #\Esc))  ; mouse basic
+  (backend-write b (format nil "~C[?1002h" #\Esc))  ; mouse drag
+  (backend-write b (format nil "~C[?1006h" #\Esc))  ; SGR mouse
+  (backend-write b (format nil "~C[?2004h" #\Esc))  ; bracketed paste
+  (cursor-hide b)
+  (finish-output (backend-output-stream b))
+  b)
+
+(defmethod shutdown-backend ((b modern-backend))
+  (cursor-show b)
+  (backend-write b (format nil "~C[?2004l" #\Esc))  ; disable bracketed paste
+  (backend-write b (format nil "~C[?1006l" #\Esc))  ; disable SGR mouse
+  (backend-write b (format nil "~C[?1002l" #\Esc))
+  (backend-write b (format nil "~C[?1000l" #\Esc))
+  (backend-write b (format nil "~C[?1049l" #\Esc))  ; normal screen
+  (finish-output (backend-output-stream b))
+  (values))
+
+(defmethod backend-size ((b modern-backend))
+  ;; Default fallback — real implementation queries terminal
+  (values 80 24))
+
+(defmethod backend-write ((b modern-backend) string)
+  (let ((stream (backend-output-stream b)))
+    (write-string string stream)
+    (length string)))
+
+(defmethod capable-p ((b modern-backend) feature)
+  (member feature '(:truecolor :osc8 :sync :mouse
+                    :bracketed-paste :cursor-style
+                    :kitty-keyboard)))
+
+(defmethod draw-text ((b modern-backend) x y string fg bg
+                      &key bold italic underline reverse dim blink)
+  (let ((parts (list (cursor-move-escape x y)
+                     (sgr-fg fg) (sgr-bg bg)
+                     (when bold (sgr-attr :bold))
+                     (when italic (sgr-attr :italic))
+                     (when underline (sgr-attr :underline))
+                     (when reverse (sgr-attr :reverse))
+                     (when dim (sgr-attr :dim))
+                     (when blink (sgr-attr :blink))
+                     string
+                     (sgr-attr :reset))))
+    (backend-write b (apply #'concatenate 'string parts))))
+
+(defmethod draw-border ((b modern-backend) x y width height
+                        &key style fg bg title title-align)
+  (declare (ignore title title-align))
+  (let* ((s (or style :single))
+         (tl (border-char s :top-left))
+         (tr (border-char s :top-right))
+         (bl (border-char s :bottom-left))
+         (br (border-char s :bottom-right))
+         (h  (border-char s :horizontal))
+         (v  (border-char s :vertical))
+         (fg-esc (sgr-fg fg))
+         (bg-esc (sgr-bg bg))
+         (reset (sgr-attr :reset))
+         (top (concatenate 'string
+                fg-esc bg-esc tl
+                (make-string (- width 2) :initial-element (char h 0))
+                tr reset (string #\Newline)))
+         (mid (concatenate 'string
+                fg-esc bg-esc v
+                (make-string (- width 2) :initial-element #\Space)
+                v reset (string #\Newline)))
+         (bot (concatenate 'string
+                fg-esc bg-esc bl
+                (make-string (- width 2) :initial-element (char h 0))
+                br reset)))
+    (backend-write b top)
+    (loop repeat (- height 2) do (backend-write b mid))
+    (backend-write b bot)))
+
+(defmethod draw-rect ((b modern-backend) x y width height &key bg)
+  (let ((bg-esc (sgr-bg bg))
+        (reset (sgr-attr :reset))
+        (line (concatenate 'string
+                bg-esc
+                (make-string width :initial-element #\Space)
+                reset (string #\Newline))))
+    (loop repeat height do
+      (backend-write b (cursor-move-escape x y))
+      (backend-write b line))))
+
+(defmethod draw-link ((b modern-backend) x y string url
+                      &key fg bg)
+  (let ((parts (list (cursor-move-escape x y)
+                     (sgr-fg fg) (sgr-bg bg)
+                     (osc8-link url string)
+                     (sgr-attr :reset))))
+    (backend-write b (apply #'concatenate 'string parts))))
+
+(defmethod draw-ellipsis ((b modern-backend) x y width
+                          &key fg bg)
+  (let ((dots "..."))
+    (draw-text b x y dots fg bg)))
+
+(defmethod cursor-move ((b modern-backend) x y)
+  (backend-write b (cursor-move-escape x y)))
+
+(defmethod cursor-hide ((b modern-backend))
+  (backend-write b (format nil "~C[?25l" #\Esc)))
+
+(defmethod cursor-show ((b modern-backend))
+  (backend-write b (format nil "~C[?25h" #\Esc)))
+
+(defmethod cursor-style ((b modern-backend) shape &key blink)
+  (backend-write b (cursor-style-escape shape blink)))
+
+(defmethod begin-sync ((b modern-backend))
+  (setf (in-sync-p b) t)
+  (backend-write b (decicm-begin)))
+
+(defmethod end-sync ((b modern-backend))
+  (setf (in-sync-p b) nil)
+  (backend-write b (decicm-end))
+  (finish-output (backend-output-stream b)))
+

backend/package.lisp

@@ -18,5 +18,12 @@
    ;; Queries
    #:capable-p
    ;; Constructors
-   #:make-simple-backend))
+   #:make-simple-backend
+   ;; Modern backend
+   #:modern-backend #:make-modern-backend
+   ;; Internal (for testing)
+   #:sgr-fg #:sgr-bg #:sgr-attr
+   #:cursor-move-escape #:cursor-style-escape
+   #:decicm-begin #:decicm-end #:osc8-link
+   #:hex-to-rgb #:border-char))
 (in-package :cl-tui.backend)

org/modern-backend.org

@@ -0,0 +1,438 @@
+#+TITLE: cl-tui Modern Backend — v0.0.2
+#+STARTUP: content
+#+FILETAGS: :cl-tui:backend:v0.0.2:
+#+OPTIONS: ^:nil
+
+* Modern Backend
+
+The =modern-backend= renders through raw ANSI/XTerm escape sequences.
+No ncurses, no CFFI, no external dependencies — pure CL string
+construction. Supports truecolor, Unicode box-drawing, OSC 8 hyperlinks,
+DECICM synchronized updates, SGR mouse, and the kitty keyboard protocol.
+
+** Contract
+
+*** Constructor
+
+- =(make-modern-backend &key color-palette)= → modern-backend
+  Create a modern backend. color-palette modifies theme color mappings.
+
+*** Escape Sequence Generation
+
+All escape sequences follow ECMA-48 / ANSI X3.64 conventions:
+
+| Escape | Meaning                  |
+|--------+--------------------------|
+| ~ESC[~ | Control Sequence Introducer (CSI) |
+| ~ESC]~ | Operating System Command (OSC)   |
+| ~ESC ~ | Single-character sequence        |
+
+*** Style Resolution
+
+Colors are resolved through a palette before emission:
+
+- =(resolve-color backend hex-or-name)= → color-index
+  Convert hex string or semantic name to an SGR color code.
+  Hex ("#FFD700") → 48;2;R;G;B or 38;2;R;G;B.
+  Named colors (:black :red :green :yellow :blue :magenta :cyan :white)
+  → 8-color SGR codes.
+
+** Test Suite
+
+#+BEGIN_SRC lisp
+(defpackage :cl-tui-modern-backend-test
+  (:use :cl :fiveam :cl-tui.backend)
+  (:export #:run-tests))
+(in-package :cl-tui-modern-backend-test)
+
+(def-suite modern-backend-suite :description "Modern backend tests")
+(in-suite modern-backend-suite)
+
+(defun run-tests ()
+  (let ((result (run 'modern-backend-suite)))
+    (fiveam:explain! result)
+    (uiop:quit 0)))
+
+;; ── Constructor ────────────────────────────────────────────────
+
+(test make-modern-backend-creates
+  "make-modern-backend returns a modern-backend instance"
+  (let ((b (make-modern-backend)))
+    (is (typep b 'cl-tui.backend::modern-backend))))
+
+;; ── Escape Generation ──────────────────────────────────────────
+
+(test sgr-truecolor-foreground
+  "SGR truecolor foreground escape is correct"
+  (is (equal (cl-tui.backend::sgr-fg "#FFD700")
+             (format nil "~C[38;2;255;215;0m" #\Esc))))
+
+(test sgr-truecolor-background
+  "SGR truecolor background escape is correct"
+  (is (equal (cl-tui.backend::sgr-bg "#1a1b26")
+             (format nil "~C[48;2;26;27;38m" #\Esc))))
+
+(test sgr-named-colors
+  "SGR named colors resolve to 8-color codes"
+  (is (equal (cl-tui.backend::sgr-fg :red)
+             (format nil "~C[31m" #\Esc)))
+  (is (equal (cl-tui.backend::sgr-bg :blue)
+             (format nil "~C[44m" #\Esc))))
+
+(test sgr-bold-italic
+  "SGR attribute escapes are correct"
+  (is (equal (cl-tui.backend::sgr-attr :bold) (format nil "~C[1m" #\Esc)))
+  (is (equal (cl-tui.backend::sgr-attr :italic) (format nil "~C[3m" #\Esc)))
+  (is (equal (cl-tui.backend::sgr-attr :underline) (format nil "~C[4m" #\Esc)))
+  (is (equal (cl-tui.backend::sgr-attr :reset) (format nil "~C[0m" #\Esc))))
+
+;; ── Cursor ─────────────────────────────────────────────────────
+
+(test cursor-move-escape
+  "cursor-move generates correct CSI escape"
+  (let ((b (make-modern-backend)))
+    (is (equal (cl-tui.backend::cursor-move-escape 5 10)
+               (format nil "~C[6;11H" #\Esc)))))
+
+(test cursor-style-block
+  "cursor-style :block generate correct escape"
+  (let ((b (make-modern-backend)))
+    (is (equal (cl-tui.backend::cursor-style-escape :block nil)
+               (format nil "~C[2 q" #\Esc)))))
+
+(test cursor-style-bar
+  "cursor-style :bar generate correct escape"
+  (let ((b (make-modern-backend)))
+    (is (equal (cl-tui.backend::cursor-style-escape :bar nil)
+               (format nil "~C[6 q" #\Esc)))))
+
+(test cursor-style-underline-blink
+  "cursor-style :underline with blink"
+  (let ((b (make-modern-backend)))
+    (is (equal (cl-tui.backend::cursor-style-escape :underline t)
+               (format nil "~C[5 q" #\Esc)))))
+
+;; ── Synchronization ────────────────────────────────────────────
+
+(test decicm-escapes
+  "DECICM synchronized update escapes"
+  (is (equal (cl-tui.backend::decicm-begin) (format nil "~C[?2026h" #\Esc)))
+  (is (equal (cl-tui.backend::decicm-end) (format nil "~C[?2026l" #\Esc))))
+
+;; ── OSC 8 Hyperlinks ──────────────────────────────────────────
+
+(test osc8-escape
+  "OSC 8 hyperlink escape wraps text"
+  (is (equal (cl-tui.backend::osc8-link "http://example.com" "click here")
+             (format nil "~C]8;;http://example.com~C\\click here~C]8;;~C\\"
+                     #\Esc #\Esc #\Esc #\Esc))))
+
+;; ── Hex Parsing ────────────────────────────────────────────────
+
+(test hex-color-parsing
+  "hex-to-rgb parses valid hex colors"
+  (multiple-value-bind (r g b) (cl-tui.backend::hex-to-rgb "#FFD700")
+    (is (= r 255))
+    (is (= g 215))
+    (is (= b 0))))
+
+(test hex-color-black
+  "hex-to-rgb parses black"
+  (multiple-value-bind (r g b) (cl-tui.backend::hex-to-rgb "#000000")
+    (is (= r 0))
+    (is (= g 0))
+    (is (= b 0))))
+
+(test hex-color-short-form
+  "hex-to-rgb parses 3-digit hex"
+  (multiple-value-bind (r g b) (cl-tui.backend::hex-to-rgb "#F00")
+    (is (= r 255))
+    (is (= g 0))
+    (is (= b 0))))
+
+;; ── Border Characters ──────────────────────────────────────────
+
+(test border-char-rounded
+  "modern-border-char returns Unicode box-drawing for rounded style"
+  (is (equal (cl-tui.backend::border-char :rounded :top-left) "╭"))
+  (is (equal (cl-tui.backend::border-char :rounded :horizontal) "─"))
+  (is (equal (cl-tui.backend::border-char :rounded :vertical) "│"))
+  (is (equal (cl-tui.backend::border-char :rounded :bottom-right) "╯")))
+
+(test border-char-double
+  "modern-border-char returns double-line chars"
+  (is (equal (cl-tui.backend::border-char :double :top-left) "╔"))
+  (is (equal (cl-tui.backend::border-char :double :horizontal) "═"))
+  (is (equal (cl-tui.backend::border-char :double :vertical) "║")))
+#+END_SRC
+
+** Implementation
+
+*** Package
+
+Add to =cl-tui.backend= package:
+
+#+BEGIN_SRC lisp
+;; In package.lisp, add to :export:
+;;   #:modern-backend #:make-modern-backend
+;; Internal symbols (not exported, used by tests):
+;;   sgr-fg sgr-bg sgr-attr cursor-move-escape cursor-style-escape
+;;   decicm-begin decicm-end osc8-link hex-to-rgb border-char
+
+(in-package :cl-tui.backend)
+#+END_SRC
+
+*** Color Resolution
+
+#+BEGIN_SRC lisp
+(defun hex-to-rgb (hex)
+  "Parse a hex color string like \"#FFD700\" into (values r g b).
+  Also handles 3-digit hex like \"#F00\"."
+  (let ((clean (string-trim '(#\# #\Space) hex)))
+    (if (= (length clean) 3)
+        (values (parse-integer (subseq clean 0 1) :radix 16 :junk-allowed t)
+                (parse-integer (subseq clean 1 2) :radix 16 :junk-allowed t)
+                (parse-integer (subseq clean 2 3) :radix 16 :junk-allowed t))
+        (values (parse-integer (subseq clean 0 2) :radix 16 :junk-allowed t)
+                (parse-integer (subseq clean 2 4) :radix 16 :junk-allowed t)
+                (parse-integer (subseq clean 4 6) :radix 16 :junk-allowed t)))))
+
+(defparameter *named-colors*
+  '((:black . 0) (:red . 1) (:green . 2) (:yellow . 3)
+    (:blue . 4) (:magenta . 5) (:cyan . 6) (:white . 7)))
+
+(defun sgr-fg (color)
+  "Return SGR foreground escape for COLOR.
+  Color can be a hex string, a keyword name, or nil."
+  (if (null color) ""
+      (cond ((and (stringp color) (char= (char color 0) #\#))
+             (multiple-value-bind (r g b) (hex-to-rgb color)
+               (format nil "~C[38;2;~d;~d;~dm" #\Esc r g b)))
+            ((keywordp color)
+             (let ((index (cdr (assoc color *named-colors*))))
+               (if index
+                   (format nil "~C[~dm" #\Esc (+ 30 index))
+                   "")))
+            (t ""))))
+
+(defun sgr-bg (color)
+  "Return SGR background escape for COLOR."
+  (if (null color) ""
+      (cond ((and (stringp color) (char= (char color 0) #\#))
+             (multiple-value-bind (r g b) (hex-to-rgb color)
+               (format nil "~C[48;2;~d;~d;~dm" #\Esc r g b)))
+            ((keywordp color)
+             (let ((index (cdr (assoc color *named-colors*))))
+               (if index
+                   (format nil "~C[~dm" #\Esc (+ 40 index))
+                   "")))
+            (t ""))))
+
+(defparameter *sgr-attr-codes*
+  '((:bold . 1) (:dim . 2) (:italic . 3) (:underline . 4)
+    (:blink . 5) (:reverse . 7) (:reset . 0)))
+
+(defun sgr-attr (attr)
+  "Return SGR attribute escape for ATTR keyword."
+  (let ((code (cdr (assoc attr *sgr-attr-codes*))))
+    (if code
+        (format nil "~C[~dm" #\Esc code)
+        "")))
+#+END_SRC
+
+*** Cursor Escapes
+
+#+BEGIN_SRC lisp
+(defun cursor-move-escape (x y)
+  "Return CSI escape to move cursor to (x, y), 1-indexed."
+  (format nil "~C[~d;~dH" #\Esc (1+ y) (1+ x)))
+
+(defun cursor-style-escape (shape blink)
+  "Return DECSTR escape for cursor shape.
+  :block = 2, :underline = 4, :bar = 6.
+  Add 1 for blink variants."
+  (let* ((base (case shape
+                 (:block 2) (:underline 4) (:bar 6)
+                 (t 2)))
+         (code (if blink (1+ base) base)))
+    (format nil "~C[~d q" #\Esc code)))
+#+END_SRC
+
+*** Synchronization (DECICM)
+
+#+BEGIN_SRC lisp
+(defun decicm-begin ()
+  "Return escape to enable synchronized updates."
+  (format nil "~C[?2026h" #\Esc))
+
+(defun decicm-end ()
+  "Return escape to disable synchronized updates."
+  (format nil "~C[?2026l" #\Esc))
+#+END_SRC
+
+*** OSC 8 Hyperlinks
+
+#+BEGIN_SRC lisp
+(defun osc8-link (url text)
+  "Wrap TEXT in an OSC 8 hyperlink to URL."
+  (format nil "~C]8;;~A~C\\~A~C]8;;~C\\"
+          #\Esc url #\Esc text #\Esc #\Esc))
+#+END_SRC
+
+*** Border Characters
+
+#+BEGIN_SRC lisp
+(defparameter *border-chars*
+  '((:single :top-left . "┌") (:single :top-right . "┐")
+    (:single :bottom-left . "└") (:single :bottom-right . "┘")
+    (:single :horizontal . "─") (:single :vertical . "│")
+    (:double :top-left . "╔") (:double :top-right . "╗")
+    (:double :bottom-left . "╚") (:double :bottom-right . "╝")
+    (:double :horizontal . "═") (:double :vertical . "║")
+    (:rounded :top-left . "╭") (:rounded :top-right . "╮")
+    (:rounded :bottom-left . "╰") (:rounded :bottom-right . "╯")
+    (:rounded :horizontal . "─") (:rounded :vertical . "│")))
+
+(defun border-char (style pos)
+  "Return the Unicode box-drawing character for STYLE at POS."
+  (let ((char (cdr (assoc (cons style pos) *border-chars* :test #'equal))))
+    (or char (if (member pos '(:horizontal :vertical))
+                 (case pos (:horizontal "─") (:vertical "│"))
+                 "+"))))
+#+END_SRC
+
+*** Modern Backend Class
+
+#+BEGIN_SRC lisp
+(defclass modern-backend (backend)
+  ((output-stream :initform *standard-output*
+                  :accessor backend-output-stream)
+   (in-sync-p :initform nil :accessor in-sync-p)))
+
+(defun make-modern-backend (&key color-palette)
+  (declare (ignore color-palette))
+  (make-instance 'modern-backend))
+
+(defmethod initialize-backend ((b modern-backend))
+  ;; Enter raw mode, enable mouse, bracketed paste
+  (backend-write b (format nil "~C[?1049h" #\Esc))  ; alt screen
+  (backend-write b (format nil "~C[?1000h" #\Esc))  ; mouse basic
+  (backend-write b (format nil "~C[?1002h" #\Esc))  ; mouse drag
+  (backend-write b (format nil "~C[?1006h" #\Esc))  ; SGR mouse
+  (backend-write b (format nil "~C[?2004h" #\Esc))  ; bracketed paste
+  (cursor-hide b)
+  (finish-output (backend-output-stream b))
+  b)
+
+(defmethod shutdown-backend ((b modern-backend))
+  (cursor-show b)
+  (backend-write b (format nil "~C[?2004l" #\Esc))  ; disable bracketed paste
+  (backend-write b (format nil "~C[?1006l" #\Esc))  ; disable SGR mouse
+  (backend-write b (format nil "~C[?1002l" #\Esc))
+  (backend-write b (format nil "~C[?1000l" #\Esc))
+  (backend-write b (format nil "~C[?1049l" #\Esc))  ; normal screen
+  (finish-output (backend-output-stream b))
+  (values))
+
+(defmethod backend-size ((b modern-backend))
+  ;; Default fallback — real implementation queries terminal
+  (values 80 24))
+
+(defmethod backend-write ((b modern-backend) string)
+  (let ((stream (backend-output-stream b)))
+    (write-string string stream)
+    (length string)))
+
+(defmethod capable-p ((b modern-backend) feature)
+  (member feature '(:truecolor :osc8 :sync :mouse
+                    :bracketed-paste :cursor-style
+                    :kitty-keyboard)))
+
+(defmethod draw-text ((b modern-backend) x y string fg bg
+                      &key bold italic underline reverse dim blink)
+  (let ((parts (list (cursor-move-escape x y)
+                     (sgr-fg fg) (sgr-bg bg)
+                     (when bold (sgr-attr :bold))
+                     (when italic (sgr-attr :italic))
+                     (when underline (sgr-attr :underline))
+                     (when reverse (sgr-attr :reverse))
+                     (when dim (sgr-attr :dim))
+                     (when blink (sgr-attr :blink))
+                     string
+                     (sgr-attr :reset))))
+    (backend-write b (apply #'concatenate 'string parts))))
+
+(defmethod draw-border ((b modern-backend) x y width height
+                        &key style fg bg title title-align)
+  (declare (ignore title title-align))
+  (let* ((s (or style :single))
+         (tl (border-char s :top-left))
+         (tr (border-char s :top-right))
+         (bl (border-char s :bottom-left))
+         (br (border-char s :bottom-right))
+         (h  (border-char s :horizontal))
+         (v  (border-char s :vertical))
+         (fg-esc (sgr-fg fg))
+         (bg-esc (sgr-bg bg))
+         (reset (sgr-attr :reset))
+         (top (concatenate 'string
+                fg-esc bg-esc tl
+                (make-string (- width 2) :initial-element (char h 0))
+                tr reset (string #\Newline)))
+         (mid (concatenate 'string
+                fg-esc bg-esc v
+                (make-string (- width 2) :initial-element #\Space)
+                v reset (string #\Newline)))
+         (bot (concatenate 'string
+                fg-esc bg-esc bl
+                (make-string (- width 2) :initial-element (char h 0))
+                br reset)))
+    (backend-write b top)
+    (loop repeat (- height 2) do (backend-write b mid))
+    (backend-write b bot)))
+
+(defmethod draw-rect ((b modern-backend) x y width height &key bg)
+  (let ((bg-esc (sgr-bg bg))
+        (reset (sgr-attr :reset))
+        (line (concatenate 'string
+                bg-esc
+                (make-string width :initial-element #\Space)
+                reset (string #\Newline))))
+    (loop repeat height do
+      (backend-write b (cursor-move-escape x y))
+      (backend-write b line))))
+
+(defmethod draw-link ((b modern-backend) x y string url
+                      &key fg bg)
+  (let ((parts (list (cursor-move-escape x y)
+                     (sgr-fg fg) (sgr-bg bg)
+                     (osc8-link url string)
+                     (sgr-attr :reset))))
+    (backend-write b (apply #'concatenate 'string parts))))
+
+(defmethod draw-ellipsis ((b modern-backend) x y width
+                          &key fg bg)
+  (let ((dots "..."))
+    (draw-text b x y dots fg bg)))
+
+(defmethod cursor-move ((b modern-backend) x y)
+  (backend-write b (cursor-move-escape x y)))
+
+(defmethod cursor-hide ((b modern-backend))
+  (backend-write b (format nil "~C[?25l" #\Esc)))
+
+(defmethod cursor-show ((b modern-backend))
+  (backend-write b (format nil "~C[?25h" #\Esc)))
+
+(defmethod cursor-style ((b modern-backend) shape &key blink)
+  (backend-write b (cursor-style-escape shape blink)))
+
+(defmethod begin-sync ((b modern-backend))
+  (setf (in-sync-p b) t)
+  (backend-write b (decicm-begin)))
+
+(defmethod end-sync ((b modern-backend))
+  (setf (in-sync-p b) nil)
+  (backend-write b (decicm-end))
+  (finish-output (backend-output-stream b)))
+#+END_SRC