amr/cl-tty
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

v0.0.1: Backend Protocol — abstraction layer + simple backend #2

Merged
amr merged 6 commits from feature/v0.0.1-backend-protocol into main 2026-05-11 10:30:54 -04:00
Conversation 0 Commits 6 Files Changed 15 +71 -52
1 changed files with 71 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files
Showing only changes of commit 2231fb6647 - Show all commits

123
layout/layout.lisp
View File

@@ -18,6 +18,15 @@
(in-package :cl-tui.layout) (in-package :cl-tui.layout)
(defun normalize-box (spec)
(cond ((null spec) '(:top 0 :right 0 :bottom 0 :left 0))
((numberp spec) `(:top ,spec :right ,spec :bottom ,spec :left ,spec))
((getf spec :top) spec)
(t '(:top 0 :right 0 :bottom 0 :left 0))))
(defun box-edge (box edge)
(or (getf box edge) 0))
(defclass layout-node () (defclass layout-node ()
((parent :initform nil :accessor layout-node-parent) ((parent :initform nil :accessor layout-node-parent)
(children :initform nil :accessor layout-node-children) (children :initform nil :accessor layout-node-children)
@@ -42,23 +51,15 @@
:direction (or direction :column) :direction (or direction :column)
:grow (or grow 0) :shrink (or shrink 1) :grow (or grow 0) :shrink (or shrink 1)
:padding (normalize-box padding) :margin (normalize-box margin) :padding (normalize-box padding) :margin (normalize-box margin)
:gap gap :gap (or gap 0)
:position-type (or position-type :relative) :position-type (or position-type :relative)
:position-offset position-offset :position-offset position-offset
:width width :height height)) :width width :height height))
(defun normalize-box (spec)
(cond ((null spec) '(:top 0 :right 0 :bottom 0 :left 0))
((numberp spec) `(:top ,spec :right ,spec :bottom ,spec :left ,spec))
((getf spec :top) spec)
(t '(:top 0 :right 0 :bottom 0 :left 0))))
(defun box-edge (box edge)
(or (getf box edge) 0))
(defun layout-node-add-child (parent child) (defun layout-node-add-child (parent child)
(setf (layout-node-parent child) parent) (setf (layout-node-parent child) parent)
(push child (layout-node-children parent)) (setf (layout-node-children parent)
(nconc (layout-node-children parent) (list child)))
child) child)
(defun layout-node-remove-child (parent child) (defun layout-node-remove-child (parent child)
@@ -69,35 +70,37 @@
;; ── Solver ───────────────────────────────────────────────────── ;; ── Solver ─────────────────────────────────────────────────────
(defun distribute-sizes (children avail gap) (defun distribute-sizes (children avail gap horizontal)
"Compute child sizes given available space and gap." "Compute child sizes given available space and gap.
HORIZONTAL is non-nil when distributing width (row layout).
Each child starts from its fixed size (if any). Remaining space
is distributed by grow ratio; overflow is reduced by shrink ratio."
(let* ((n (length children)) (let* ((n (length children))
(default-size (if (zerop n) 0 (round avail n)))
(gap-total (* gap (max 0 (1- n)))) (gap-total (* gap (max 0 (1- n))))
(sizes (mapcar (lambda (c) (base (mapcar (lambda (c)
(or (if (eql (layout-node-direction c) :row) (or (if horizontal
(layout-node-fixed-width c) (layout-node-fixed-width c)
(layout-node-fixed-height c)) (layout-node-fixed-height c))
default-size)) 0))
children)) children))
(total (reduce #'+ sizes)) (base-total (reduce #'+ base))
(remaining (- total (- avail gap-total))) (remaining (- avail base-total gap-total))
(grow-total (reduce #'+ (mapcar #'layout-node-grow children))) (grow-total (reduce #'+ (mapcar #'layout-node-grow children)))
(shrink-total (reduce #'+ (mapcar #'layout-node-shrink children)))) (shrink-total (reduce #'+ (mapcar #'layout-node-shrink children))))
(mapcar (lambda (c sz) (mapcar (lambda (c b)
(let ((g (layout-node-grow c)) (let ((sz b))
(s (layout-node-shrink c))
(size sz))
(when (and (plusp remaining) (plusp grow-total)) (when (and (plusp remaining) (plusp grow-total))
(incf size (round (* remaining (/ g grow-total))))) (incf sz (round (* remaining (/ (layout-node-grow c) grow-total)))))
(when (and (minusp remaining) (plusp shrink-total)) (when (and (minusp remaining) (plusp shrink-total))
(decf size (round (* (abs remaining) (/ s shrink-total))))) (decf sz (round (* (abs remaining) (/ (layout-node-shrink c) shrink-total)))))
(max 1 size))) (max 1 sz)))
children sizes))) children base)))
(defun compute-layout (root available-width available-height) (defun compute-layout (root available-width available-height)
"Layout all children of ROOT within the given dimensions.
Recursively computes position and size for every node."
(labels ((place-children (node x y max-w max-h) (labels ((place-children (node x y max-w max-h)
(let* ((children (reverse (layout-node-children node))) (let* ((children (layout-node-children node))
(is-row (eql (layout-node-direction node) :row)) (is-row (eql (layout-node-direction node) :row))
(pl (box-edge (layout-node-padding node) :left)) (pl (box-edge (layout-node-padding node) :left))
(pt (box-edge (layout-node-padding node) :top)) (pt (box-edge (layout-node-padding node) :top))
@@ -106,34 +109,50 @@
(cw (max 0 (- max-w pl pr))) (cw (max 0 (- max-w pl pr)))
(ch (max 0 (- max-h pt pb))) (ch (max 0 (- max-h pt pb)))
(gap (layout-node-gap node)) (gap (layout-node-gap node))
(sizes (distribute-sizes children (if is-row cw ch) gap))) (sizes (distribute-sizes children (if is-row cw ch) gap is-row)))
;; Position the node (content area starts at padding inset)
(setf (layout-node-x node) (+ x pl) (setf (layout-node-x node) (+ x pl)
(layout-node-y node) (+ y pt)) (layout-node-y node) (+ y pt))
(loop with pos = 0 ;; Place each child sequentially
for child in children (loop :with pos = 0
for size in sizes :for child :in children
do (if is-row :for size :in sizes
(setf (layout-node-width child) size :do (if is-row
(layout-node-x child) (+ x pl pos) (setf (layout-node-width child) size
(layout-node-height child) ch (layout-node-x child) (+ x pl pos)
(layout-node-y child) (+ y pt)) (layout-node-height child) ch
(setf (layout-node-height child) size (layout-node-y child) (+ y pt))
(layout-node-y child) (+ y pt pos) (setf (layout-node-height child) size
(layout-node-width child) cw (layout-node-y child) (+ y pt pos)
(layout-node-x child) (+ x pl))) (layout-node-width child) cw
(place-children child (layout-node-x child) (layout-node-y child) (layout-node-x child) (+ x pl)))
(if is-row size cw) (if is-row ch size)) (place-children child
(incf pos (+ size gap)))) (layout-node-x child)
(let ((last (car (last children)))) (layout-node-y child)
(if is-row size cw)
(if is-row ch size))
(incf pos (+ size gap)))
;; Compute own size from children
(let ((last-child (car (last children))))
(if is-row (if is-row
(setf (layout-node-width node) (setf (layout-node-width node)
(or (layout-node-fixed-width node) (or (layout-node-fixed-width node)
(if last (+ (layout-node-x node) (layout-node-width last) (box-edge (layout-node-padding node) :right)) max-w)) (if last-child
(layout-node-height node) max-h) (+ (layout-node-x node)
(layout-node-width last-child)
pr)
max-w))
(layout-node-height node)
max-h)
(setf (layout-node-height node) (setf (layout-node-height node)
(or (layout-node-fixed-height node) (or (layout-node-fixed-height node)
(if last (+ (layout-node-y node) (layout-node-height last) (box-edge (layout-node-padding node) :bottom)) max-h)) (if last-child
(layout-node-width node) max-w))))) (let ((last-y (layout-node-y last-child))
(last-h (layout-node-height last-child)))
(+ last-y last-h pb))
max-h))
(layout-node-width node)
max-w))))))
(place-children root 0 0 available-width available-height) (place-children root 0 0 available-width available-height)
root)) root))