From ce7e9fbab077b3562212d6fbfe77455d2ee32a27 Mon Sep 17 00:00:00 2001 From: Hermes Agent Date: Tue, 12 May 2026 17:05:47 +0000 Subject: [PATCH] literate: create org/render.org, org/theme.org, org/package.org MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Follows the literate programming workflow: Overview → Contract → Tests → Implement → Tangle → Test (GREEN) render.org covers render.lisp + render-tests.lisp (component protocol, render dispatch, dirty propagation) theme.org covers theme.lisp + theme-tests.lisp (theme class, presets, color resolution) package.org covers package.lisp (cl-tty.box defpackage) --- org/package.org | 77 ++++++++++++++ org/render.org | 272 ++++++++++++++++++++++++++++++++++++++++++++++++ org/theme.org | 267 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 616 insertions(+) create mode 100644 org/package.org create mode 100644 org/render.org create mode 100644 org/theme.org diff --git a/org/package.org b/org/package.org new file mode 100644 index 0000000..0e83810 --- /dev/null +++ b/org/package.org @@ -0,0 +1,77 @@ +#+TITLE: Base Component Package +#+STARTUP: content +#+FILETAGS: :cl-tty:components: + +* Overview + +The ~cl-tty.box~ package is the central namespace for the component +system. It aggregates all component-related symbols — box, text, +dirty tracking, render dispatch, theme engine — under one package. + +Why ~box~ as the package name? Historically the package was created +for the ~box~ and ~text~ renderables, and the name stuck as the +package grew to encompass the entire component layer. The package +~:use~s ~cl-tty.backend~ (for drawing primitives) and ~cl-tty.layout~ +(for layout nodes). All component code lives in this package. + +This org file is documentation-only: it explains the package design +but the code itself is just a ~defpackage~ form. + +* Contract + +The ~cl-tty.box~ package exports these symbol groups: + +- Box: ~box~, ~make-box~, ~render-box~, border style/title accessors +- Span: ~span~, span attribute readers +- Text: ~text~, ~make-text~, ~render-text~, text accessors +- Dirty: ~dirty-mixin~, ~dirty-p~, ~mark-clean~, ~mark-dirty~ +- Render: ~render~, ~render-screen~, ~render-node~, tree navigation +- Theme: ~theme~, ~make-theme~, ~theme-color~, ~load-preset~, + ~define-preset~ + +* Implementation + +~cl-tty.box~ uses ~cl-tty.backend~ for ~draw-text~, ~draw-border~, +etc., and ~cl-tty.layout~ for ~layout-node~, ~compute-layout~, and the +~vbox~/~hbox~ macros. + +The only direct dependencies are these two packages — no other +application code is needed to define components. + +#+BEGIN_SRC lisp :tangle ../src/components/package.lisp +(defpackage :cl-tty.box + (:use :cl :cl-tty.backend :cl-tty.layout) + (:export + ;; Box + #:box #:make-box + #:box-layout-node + #:box-border-style #:box-title #:box-title-align + #:box-fg #:box-bg + #:render-box + ;; Span + #:span + #:span-text #:span-bold #:span-italic #:span-underline + #:span-reverse #:span-dim #:span-fg #:span-bg + ;; Text + #:text #:make-text + #:text-layout-node #:text-content #:text-spans + #:text-fg #:text-bg #:text-wrap-mode + #:render-text + ;; Utilities (for tests) + #:word-wrap #:split-string + ;; Dirty tracking + #:dirty-mixin #:dirty-p #:mark-clean #:mark-dirty + ;; Rendering pipeline + #:render #:render-screen #:render-node + #:component-layout-node #:component-children #:component-parent + #:available-width #:available-height + #:propagate-dirty + ;; Theme engine + #:theme #:make-theme #:theme-mode + #:theme-color #:load-preset #:define-preset)) +(in-package :cl-tty.box) +#+END_SRC + +The ~#:word-wrap~ and ~#:split-string~ exports are for tests only — +they're utility functions used internally by ~text~ rendering but +exposed so the test suite can unit-test them directly. diff --git a/org/render.org b/org/render.org new file mode 100644 index 0000000..78df16a --- /dev/null +++ b/org/render.org @@ -0,0 +1,272 @@ +#+TITLE: Render Dispatch and Pipeline +#+STARTUP: content +#+FILETAGS: :cl-tty:components: + +* Overview + +The render module provides the generic function dispatch that connects +the component tree to the backend. Every component type defines its own +~render~ method; this module defines the common protocol and the +top-level orchestration functions. + +Three responsibilities live here: + +1. **Component protocol** — generic functions for navigating the + component tree (~component-children~, ~component-parent~, + ~component-layout-node~) + +2. **Render pipeline** — ~render-screen~ ties layout computation to + rendering, using the backend's actual terminal dimensions rather + than hardcoded values. ~render-node~ walks the tree. + +3. **Dirty propagation** — ~propagate-dirty~ marks a component and all + its ancestors for re-render. This is what makes the incremental + pipeline efficient: only changed branches get re-processed. + +* Contract + +** ~component-layout-node component~ → layout-node or nil + +Return the layout node associated with ~component~. Specialized per +component type (~box~, ~text~). + +** ~component-children component~ → list or nil + +Return child components. Default method returns ~nil~ (leaf components). + +** ~component-parent component~ → component or nil + +Return the parent component. Default method returns ~nil~. + +** ~render component backend~ + +Render ~component~ at its computed position using ~backend~. Default +method is a no-op. Specialized per component type. + +** ~render-screen root backend~ + +Full render pipeline: query backend size, compute layout, render tree, +wrapped in DECICM sync (~begin-sync~/~end-sync~). + +** ~render-node node backend~ + +Render ~node~ and all descendants recursively. ~render-screen~ calls +this once layout is computed. + +** ~available-width / available-height component~ → integer + +Return the computed width/height from the component's layout node, or +80/24 as fallback. + +** ~propagate-dirty component~ + +Mark ~component~ and every ancestor dirty. Walks up via +~component-parent~. + +* Tests + +#+BEGIN_SRC lisp :tangle ../src/components/render-tests.lisp +(in-package :cl-tty-box-test) +(in-suite box-suite) + +(defun make-capturing-backend () + (let* ((s (make-string-output-stream)) + (b (make-modern-backend :output-stream s))) + (values b s))) + +(test render-generic-dispatches-box + "render dispatches to render-box for box instances" + (multiple-value-bind (b s) (make-capturing-backend) + (let ((bx (make-box :border-style :single :width 10 :height 5))) + (compute-layout (box-layout-node bx) 10 5) + (render bx b) + (is (search "┌" (get-output-stream-string s)) "box renders border")))) + +(test render-generic-dispatches-text + "render dispatches to render-text for text instances" + (multiple-value-bind (b s) (make-capturing-backend) + (let ((tx (make-text "Hello" :width 10 :height 1))) + (compute-layout (text-layout-node tx) 10 1) + (render tx b) + (is (search "Hello" (get-output-stream-string s)) "text renders content")))) + +(test component-layout-node-works + "component-layout-node returns the right slot for each type" + (let ((bx (make-box)) (tx (make-text ""))) + (is (typep (component-layout-node bx) 'layout-node)) + (is (typep (component-layout-node tx) 'layout-node)))) + +(test component-children-returns-nil + "Leaf components have no children" + (let ((bx (make-box)) (tx (make-text ""))) + (is (null (component-children bx))) + (is (null (component-children tx))))) + +(test propagate-dirty-marks-component + "propagate-dirty marks the component dirty" + (let ((c (make-box))) + (mark-clean c) + (is-false (dirty-p c) "should be clean after mark-clean") + (propagate-dirty c) + (is-true (dirty-p c) "should be dirty after propagate-dirty"))) + +(test available-width-defaults + "available-width returns 0 for components without explicit width" + (let ((c (make-box))) + (is (= (available-width c) 0)))) +#+END_SRC + +* Implementation + +** Component protocol + +These three generic functions form the tree navigation API. They're +separated from ~render~ because layout and dirty propagation also +need to traverse the tree. + +#+BEGIN_SRC lisp :tangle ../src/components/render.lisp +(in-package :cl-tty.box) + +;; ── Component Protocol ──────────────────────────────────────── + +(defgeneric component-layout-node (component) + (:documentation "Return the layout-node for COMPONENT.") + (:method ((bx box)) (box-layout-node bx)) + (:method ((tx text)) (text-layout-node tx))) +#+END_SRC + +Each component type defines its own ~component-layout-node~ method +that returns its internal layout node. The default method (on ~t~) +would return ~nil~, but since every component in cl-tty has a layout +node, we don't provide one — new component types must add their own +method. + +#+BEGIN_SRC lisp :tangle ../src/components/render.lisp +(defgeneric component-children (component) + (:documentation "Return the children of COMPONENT, or nil.") + (:method ((c t)) nil)) +#+END_SRC + +Leaf components (~box~, ~text~) have no children. Container components +(~scrollbox~, ~tabbar~) override this to return their child list. + +#+BEGIN_SRC lisp :tangle ../src/components/render.lisp +(defgeneric component-parent (component) + (:documentation "Return the parent of COMPONENT, or nil.") + (:method ((c t)) nil)) +#+END_SRC + +Parent links are set by the container when adding children. They're +used by ~propagate-dirty~ to walk up the tree. + +** Render dispatch + +#+BEGIN_SRC lisp :tangle ../src/components/render.lisp +;; ── Rendering Pipeline ──────────────────────────────────────── + +(defgeneric render (component backend) + (:documentation "Render COMPONENT at its computed position using BACKEND.") + (:method ((c t) backend) + (declare (ignore backend)) + (values))) +#+END_SRC + +The ~render~ generic is the central dispatch point. Every component +type that can be drawn defines a method on ~render~. The default +method is a no-op so that non-renderable objects (or components still +under development) don't cause errors. + +#+BEGIN_SRC lisp :tangle ../src/components/render.lisp +(defmethod render ((bx box) backend) + (render-box bx backend)) + +(defmethod render ((tx text) backend) + (render-text tx backend)) +#+END_SRC + +Box and text are the two built-in renderable types. Their ~render~ +methods delegate to the specific rendering functions defined in +~box.lisp~ and ~text.lisp~. + +** Screen-level orchestration + +#+BEGIN_SRC lisp :tangle ../src/components/render.lisp +(defun render-screen (root backend) + "Render the component tree ROOT using BACKEND. + Computes layout at the root level, then traverses children + rendering each at their pre-computed positions. Uses the actual + terminal dimensions from BACKEND rather than hardcoded defaults." + (multiple-value-bind (w h) (backend-size backend) + (begin-sync backend) + (compute-layout (component-layout-node root) w h) + (render-node root backend) + (end-sync backend))) +#+END_SRC + +~render-screen~ is the entry point for rendering a full frame. It +queries the terminal size at render time (not at startup), so the +layout adapts to window resizes automatically. + +The DECICM sync pair (~begin-sync~/~end-sync~) wraps the entire +frame in a synchronized update: the terminal buffers all escape +sequences and flushes them atomically. This prevents partial-frame +flicker. + +#+BEGIN_SRC lisp :tangle ../src/components/render.lisp +(defun render-node (node backend) + "Render a component NODE and its children. + Layout is computed once at the root by render-screen, so children + just render at their pre-computed positions." + (render node backend) + (dolist (child (component-children node)) + (render-node child backend))) +#+END_SRC + +Tree walk: render this node, then recurse into children. The layout +was already computed by ~render-screen~, so each node's position and +size are available from its ~layout-node~. + +** Utility accessors + +#+BEGIN_SRC lisp :tangle ../src/components/render.lisp +(defun available-width (component) + "Return the available width for COMPONENT (or 80 as default)." + (let ((ln (component-layout-node component))) + (if ln (layout-node-width ln) 80))) + +(defun available-height (component) + "Return the available height for COMPONENT (or 24 as default)." + (let ((ln (component-layout-node component))) + (if ln (layout-node-height ln) 24))) +#+END_SRC + +These accessors provide a clean API for components that need to know +their allocated space. They return the computed dimensions from the +layout node, which was set by ~compute-layout~ during ~render-screen~. + +The fallback values (80x24) match the terminal default when no layout +node exists — typically during initialization or testing without a +backenπd. + +** Dirty propagation + +#+BEGIN_SRC lisp :tangle ../src/components/render.lisp +;; ── Dirty Propagation ───────────────────────────────────────── + +(defun propagate-dirty (component) + "Mark COMPONENT and all ancestors dirty." + (mark-dirty component) + (let ((parent (component-parent component))) + (when parent + (propagate-dirty parent)))) +#+END_SRC + +Recursive walk up the parent chain. When a text input receives a +keystroke, it marks itself dirty, then its parent scrollbox, then the +containing box, then the root — triggering recomputation and +re-rendering of everything that might have changed. + +This is the key to incremental rendering: only dirty branches are +re-processed. The ~render~ methods check ~dirty-p~ early and return +immediately for clean components (handled in each component's render, +not here). diff --git a/org/theme.org b/org/theme.org new file mode 100644 index 0000000..d56be7a --- /dev/null +++ b/org/theme.org @@ -0,0 +1,267 @@ +#+TITLE: Theme Engine +#+STARTUP: content +#+FILETAGS: :cl-tty:components: + +* Overview + +The theme engine provides semantic color tokens that decouple visual +design from implementation code. Instead of writing ~:bright-yellow~ or +~\"#FFD700\"~ everywhere, components use ~:accent~, ~:error~, +~:background~ — semantic roles that resolve to concrete hex values +through the current theme. + +This means: +- Themes are swappable at runtime (default dark/light, nord, etc.) +- Components never reference hex values directly +- A single ~load-preset~ call changes the entire application's look + +The engine is intentionally simple: a ~theme~ class holding a hash +table of role→hex mappings, a set of built-in presets defined via +~define-preset~, and ~load-preset~ which populates both the theme +and the backend's ~*theme-colors*~ for SGR resolution. + +* Contract + +** Theme class + +- ~(make-theme &key mode)~ — create a theme in ~:dark~ or ~:light~ mode +- ~(theme-mode theme)~ — get current mode +- ~(theme-color theme role)~ → hex string or nil +- ~(setf (theme-color theme role) hex)~ — set a role + +** Presets + +- ~(define-preset name &key dark light)~ — register a preset with + dark and light plists of role→hex pairs +- ~(load-preset theme preset-name)~ — apply a preset to ~theme~. + Also populates ~cl-tty.backend:*theme-colors*~ so the backend can + resolve semantic colors to hex at render time. +- Unknown presets signal a ~warning~ (not an error). + +** Built-in presets + +- ~:default~ — gold/accent on dark blue-gray +- ~:nord~ — cool blue nord palette + +* Tests + +#+BEGIN_SRC lisp :tangle ../src/components/theme-tests.lisp +(in-package :cl-tty-box-test) +(in-suite box-suite) + +(test theme-create-default + "A theme can be created with default mode" + (let ((th (make-theme))) + (is (typep th 'theme)) + (is (eql (theme-mode th) :dark)))) + +(test theme-create-light + "A theme can be created in light mode" + (let ((th (make-theme :mode :light))) + (is (eql (theme-mode th) :light)))) + +(test theme-color-set-and-get + "theme-color setf/get works" + (let ((th (make-theme))) + (setf (theme-color th :primary) "#FFD700") + (is (string= (theme-color th :primary) "#FFD700")))) + +(test theme-color-unknown-returns-nil + "Unknown roles return nil" + (let ((th (make-theme))) + (is (null (theme-color th :nonexistent))))) + +(test load-default-dark-preset + "Loading the default dark preset populates roles" + (let ((th (make-theme :mode :dark))) + (load-preset th :default) + (is (string= (theme-color th :primary) "#FFD700")) + (is (string= (theme-color th :background) "#1A1A2E")) + (is (string= (theme-color th :error) "#FF4444")))) + +(test load-default-light-preset + "Light variant has different colors" + (let ((th (make-theme :mode :light))) + (load-preset th :default) + (is (string= (theme-color th :primary) "#B8860B")) + (is (string= (theme-color th :background) "#F8F9FA")))) + +(test load-nord-preset + "Nord preset has different colors than default" + (let ((th (make-theme :mode :dark))) + (load-preset th :nord) + (is (string= (theme-color th :primary) "#88C0D0")) + (is (string= (theme-color th :background) "#2E3440")))) + +(test load-preset-unknown-warns + "Unknown preset warns but doesn't error" + (let ((th (make-theme))) + (signals warning (load-preset th :nonexistent)) + (is (null (theme-color th :primary))))) + +(test preset-switch-mode + "Switching mode and reloading changes colors" + (let ((th (make-theme :mode :dark))) + (load-preset th :default) + (is (string= (theme-color th :background) "#1A1A2E")) + (setf (theme-mode th) :light) + (load-preset th :default) + (is (string= (theme-color th :background) "#F8F9FA")))) +#+END_SRC + +* Implementation + +** Theme class + +The ~theme~ class holds a mode flag (~:dark~/~:light~) and a hash +table of role→hex mappings. The hash table gives O(1) lookups for +~theme-color~ and clean iteration for ~load-preset~. + +#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp +(in-package :cl-tty.box) + +;; ── Theme Engine ────────────────────────────────────────────── + +(defclass theme () + ((mode :initform :dark :initarg :mode :accessor theme-mode) + (roles :initform (make-hash-table) :accessor theme-roles))) + +(defun make-theme (&key (mode :dark)) + (make-instance 'theme :mode mode)) +#+END_SRC + +The mode defaults to ~:dark~. Applications can initialize with +~:light~ for terminals with light backgrounds. The mode controls +which variant ~load-preset~ selects. + +** Color resolution + +#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp +(defun theme-color (theme role) + "Resolve a semantic ROLE to a hex color string in THEME." + (gethash role (theme-roles theme))) + +(defun (setf theme-color) (hex theme role) + "Set the hex color for a semantic ROLE in THEME." + (setf (gethash role (theme-roles theme)) hex)) +#+END_SRC + +Uses ~gethash~ for both getter and setter. Unknown roles return ~nil~, +which the backend treats as "use default" — so missing roles degrade +gracefully rather than crashing. + +** Preset system + +Presets are stored in a global hash table keyed by keyword name. The +~define-preset~ macro registers a preset at macro-expansion time. + +#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp +(defparameter *presets* (make-hash-table :test #'eq)) + +(defmacro define-preset (name &key dark light) + "Define a theme preset with DARK and LIGHT variants. +NAME should be a keyword (e.g., :default, :nord)." + (check-type name keyword) + `(setf (gethash ,name *presets*) '(:dark ,dark :light ,light))) +#+END_SRC + +Using ~#\'~ (quoted list) instead of an alist or hash table keeps the +preset data inline and easy to read. The ~eq~ hash table test matches +keyword identity. + +#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp +(defun load-preset (theme preset-name) + "Load PRESET-NAME colors into THEME. +Side-effect: populates cl-tty.backend:*theme-colors* so that semantic +color roles resolve to hex at SGR generation time." + (let ((preset (gethash preset-name *presets*))) + (if preset + (let* ((colors (if (eql (theme-mode theme) :dark) + (getf preset :dark) + (getf preset :light))) + ;; Populate backend theme color map + (theme-map cl-tty.backend:*theme-colors*)) + ;; Set theme colors + (loop for (role hex) on colors by #'cddr + do (setf (theme-color theme role) hex) + (setf (gethash role theme-map) hex))) + (warn "Unknown preset: ~S" preset-name)))) +#+END_SRC + +~load-preset~ does double duty: it populates the theme's role map and +the backend's ~*theme-colors*~. This second step is what makes +semantic colors work at the SGR level — when the backend renders +~:accent~, it looks up ~*theme-colors*~ to get the hex, then +generates the escape sequence. + +The ~loop for (role hex) on colors by #'cddr~ iterates the plist in +pairs, setting both the theme entry and the backend entry. + +If the preset doesn't exist, ~warn~ is called instead of ~error~ — a +missing preset shouldn't crash the application. + +** Built-in presets + +Two presets are built in: + +*** Default preset + +Gold/accent palette on dark navy background. The light variant +inverts to warm tones on near-white. + +#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp +(define-preset :default + :dark (:primary "#FFD700" :secondary "#B8860B" :accent "#FFA500" + :error "#FF4444" :warning "#FF8800" :success "#44BB44" :info "#4488FF" + :text "#FFFFFF" :text-muted "#888888" + :background "#1A1A2E" :background-panel "#16213E" :background-element "#0F3460" + :border "#334155" :border-active "#FFD700" + :diff-added "#164B16" :diff-removed "#4B1616" :diff-context "#1A1A2E" + :markdown-heading "#FFD700" :markdown-code "#334155" + :markdown-link "#4488FF" :markdown-quote "#888888" + :syntax-keyword "#FF79C6" :syntax-function "#50FA7B" + :syntax-string "#F1FA8C" :syntax-number "#BD93F9" + :syntax-comment "#6272A4" :syntax-type "#8BE9FD") + :light (:primary "#B8860B" :secondary "#8B6914" :accent "#FF8C00" + :error "#CC0000" :warning "#CC6600" :success "#228B22" :info "#0055CC" + :text "#1A1A2E" :text-muted "#888888" + :background "#F8F9FA" :background-panel "#FFFFFF" :background-element "#E9ECEF" + :border "#DEE2E6" :border-active "#B8860B" + :diff-added "#DFD" :diff-removed "#FDD" :diff-context "#F8F9FA" + :markdown-heading "#B8860B" :markdown-code "#E9ECEF" + :markdown-link "#0055CC" :markdown-quote "#888888" + :syntax-keyword "#D63384" :syntax-function "#198754" + :syntax-string "#FFC107" :syntax-number "#6F42C1" + :syntax-comment "#6C757D" :syntax-type "#0DCAF0")) +#+END_SRC + +*** Nord preset + +Cool blue palette inspired by Arctic Studio's Nord theme. Softer +contrast than default, designed for reduced eye strain. + +#+BEGIN_SRC lisp :tangle ../src/components/theme.lisp +(define-preset :nord + :dark (:primary "#88C0D0" :secondary "#81A1C1" :accent "#5E81AC" + :error "#BF616A" :warning "#D08770" :success "#A3BE8C" :info "#B48EAD" + :text "#ECEFF4" :text-muted "#616E88" + :background "#2E3440" :background-panel "#3B4252" :background-element "#434C5E" + :border "#4C566A" :border-active "#88C0D0" + :diff-added "#164B16" :diff-removed "#4B1616" :diff-context "#2E3440" + :markdown-heading "#88C0D0" :markdown-code "#3B4252" + :markdown-link "#81A1C1" :markdown-quote "#616E88" + :syntax-keyword "#81A1C1" :syntax-function "#A3BE8C" + :syntax-string "#EBCB8B" :syntax-number "#B48EAD" + :syntax-comment "#616E88" :syntax-type "#88C0D0") + :light (:primary "#5E81AC" :secondary "#81A1C1" :accent "#88C0D0" + :error "#BF616A" :warning "#D08770" :success "#A3BE8C" :info "#B48EAD" + :text "#2E3440" :text-muted "#8F9BB3" + :background "#ECEFF4" :background-panel "#FFFFFF" :background-element "#E5E9F0" + :border "#D8DEE9" :border-active "#5E81AC" + :diff-added "#DFD" :diff-removed "#FDD" :diff-context "#ECEFF4" + :markdown-heading "#5E81AC" :markdown-code "#E5E9F0" + :markdown-link "#81A1C1" :markdown-quote "#8F9BB3" + :syntax-keyword "#81A1C1" :syntax-function "#A3BE8C" + :syntax-string "#D08770" :syntax-number "#B48EAD" + :syntax-comment "#8F9BB3" :syntax-type "#88C0D0")) +#+END_SRC