b0e5c18257
- render generic function dispatches per component type - render-screen entry point with sync wrapper - render-node walks tree, computes layout, calls render - component-layout-node generic (box/text methods) - component-children/component-parent generics - propagate-dirty marks component + ancestors dirty - box and text now inherit from dirty-mixin - 6 new tests: render dispatch, layout-node accessor, children, dirty propagation, available-width defaults - 42 component tests, 100% GREEN
107 lines
4.5 KiB
Common Lisp
107 lines
4.5 KiB
Common Lisp
(in-package :cl-tui.box)
|
|
|
|
;; ── Text Renderable ────────────────────────────────────────────
|
|
|
|
(defclass span ()
|
|
((text :initarg :text :accessor span-text)
|
|
(bold :initform nil :initarg :bold :accessor span-bold)
|
|
(italic :initform nil :initarg :italic :accessor span-italic)
|
|
(underline :initform nil :initarg :underline :accessor span-underline)
|
|
(reverse :initform nil :initarg :reverse :accessor span-reverse)
|
|
(dim :initform nil :initarg :dim :accessor span-dim)
|
|
(fg :initform nil :initarg :fg :accessor span-fg)
|
|
(bg :initform nil :initarg :bg :accessor span-bg)))
|
|
|
|
(defun span (text &key bold italic underline reverse dim fg bg)
|
|
(make-instance 'span
|
|
:text text :bold bold :italic italic
|
|
:underline underline :reverse reverse :dim dim
|
|
:fg fg :bg bg))
|
|
|
|
(defclass text (dirty-mixin)
|
|
((layout-node :initform (make-layout-node) :accessor text-layout-node
|
|
:initarg :layout-node)
|
|
(content :initform "" :initarg :content :accessor text-content)
|
|
(spans :initform nil :initarg :spans :accessor text-spans)
|
|
(fg :initform nil :initarg :fg :accessor text-fg)
|
|
(bg :initform nil :initarg :bg :accessor text-bg)
|
|
(wrap-mode :initform :word :initarg :wrap-mode :accessor text-wrap-mode)))
|
|
|
|
(defun make-text (content &key fg bg wrap-mode width height spans)
|
|
(make-instance 'text
|
|
:content content
|
|
:fg fg :bg bg
|
|
:wrap-mode (or wrap-mode :word)
|
|
:spans spans
|
|
:layout-node (make-layout-node :direction :column
|
|
:width width :height height)))
|
|
|
|
(defun render-text (text-object backend)
|
|
"Render TEXT-OBJECT at its computed layout position using BACKEND."
|
|
(let ((ln (text-layout-node text-object))
|
|
(content (text-content text-object))
|
|
(fg (text-fg text-object))
|
|
(bg (text-bg text-object))
|
|
(wrap (text-wrap-mode text-object))
|
|
(spans (text-spans text-object)))
|
|
(declare (ignore spans))
|
|
(let ((x (layout-node-x ln))
|
|
(y (layout-node-y ln))
|
|
(w (layout-node-width ln))
|
|
(h (layout-node-height ln)))
|
|
(when (or (zerop (length content)) (zerop w) (zerop h))
|
|
(return-from render-text (values)))
|
|
(if (eql wrap :none)
|
|
(let ((display (subseq content 0 (min (length content) w))))
|
|
(draw-text backend x y display fg bg))
|
|
(let ((lines (word-wrap content w))
|
|
(max-lines h))
|
|
(loop for line in lines
|
|
for row from 0 below max-lines
|
|
do (draw-text backend x (+ y row) line fg bg)))))))
|
|
|
|
(defun word-wrap (text max-width)
|
|
"Split TEXT into lines, each <= MAX-WIDTH chars.
|
|
Breaks at word boundaries. Words exceeding MAX-WIDTH are hard-broken."
|
|
(if (or (zerop max-width) (zerop (length text)))
|
|
(list "")
|
|
(let ((words (split-string text)) (lines nil) (current nil) (current-len 0))
|
|
(dolist (word words)
|
|
(let ((wl (length word)))
|
|
(cond ((<= wl max-width)
|
|
(if (and current (<= (+ current-len 1 wl) max-width))
|
|
(push word current)
|
|
(progn
|
|
(when current
|
|
(push (format nil "~{~A~^ ~}" (nreverse current)) lines))
|
|
(setf current (list word))
|
|
(setf current-len wl))))
|
|
(t
|
|
(when current
|
|
(push (format nil "~{~A~^ ~}" (nreverse current)) lines)
|
|
(setf current nil)
|
|
(setf current-len 0))
|
|
(loop for i from 0 below wl by max-width
|
|
do (push (subseq word i (min (+ i max-width) wl)) lines))))))
|
|
(when current
|
|
(push (format nil "~{~A~^ ~}" (nreverse current)) lines))
|
|
(or (nreverse lines) (list "")))))
|
|
|
|
(defun split-string (string)
|
|
"Split STRING into words separated by whitespace."
|
|
(loop with words = nil
|
|
with start = 0
|
|
with len = (length string)
|
|
while (< start len)
|
|
do (let ((ws-start (position-if (lambda (c) (find c '(#\Space #\Tab #\Newline)))
|
|
string :start start)))
|
|
(if ws-start
|
|
(progn
|
|
(when (> ws-start start)
|
|
(push (subseq string start ws-start) words))
|
|
(setf start (1+ ws-start)))
|
|
(progn
|
|
(push (subseq string start) words)
|
|
(setf start len))))
|
|
finally (return (nreverse words))))
|