gansito05/lime
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial Lime window manager

Browse Source
This commit is contained in:
Adan
2026-10-02 14:14:47 -05:00
commit 785c2e8968
103 changed files with 27259 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

195
test/x11-text.lisp Normal file
View File

@@ -0,0 +1,195 @@
(in-package #:lime.x11.test)
(in-suite lime-x11-suite)
;; Pango/Cairo measurements are headless: these tests do not open DISPLAY.
(lime.config:defconfiguration font-config-fixture
(:font :family "sans-serif, monospace" :size 18 :weight :bold))
(test font-configuration-is-shared-and-validated
(let ((font (lime-configuration-font font-config-fixture)))
(is (string= "sans-serif, monospace" (ui-font-style-family font)))
(is (= 18 (ui-font-style-size font)))
(is (eq :bold (ui-font-style-weight font)))
(is (eq font-config-fixture (lime.x11::%validate-lime-configuration font-config-fixture))))
(dolist (style (list (make-ui-font-style :family " ")
(make-ui-font-style :family (format nil "bad~%family"))
(make-ui-font-style :size 0)
(make-ui-font-style :size 97)
(make-ui-font-style :size "14")
(make-ui-font-style :weight :unknown)))
(signals invalid-transition (lime.x11::%validate-ui-font-style style)))
(signals error
(macroexpand-1 '(lime.config:defconfiguration bad-font (:font) (:font))))
(signals error
(macroexpand-1 '(lime.config:defconfiguration bad-font (:font :typo 10)))))
(test shaped-text-fits-without-splitting-graphemes
(let ((font (lime.x11::%open-text-font (make-ui-font-style :family "sans-serif"))))
(unwind-protect
(progn
(is (> (lime.x11::%text-width font "WWW") (lime.x11::%text-width font "iii")))
(is (= 0 (lime.x11::%text-width font "")))
(dolist (text '("é" "👩‍💻" "🇲🇽"))
(is (equalp (vector 0 (length text))
(lime.x11::text-metrics-boundaries (lime.x11::%text-metrics font text)))))
(dolist (text '("ééé café" "👩‍💻 👩‍💻 long title" "🇲🇽🇲🇽 日本語" "مرحبا بالعالم"))
(let* ((metrics (lime.x11::%text-metrics font text))
(boundaries (lime.x11::text-metrics-boundaries metrics)))
;; Check every pixel budget, not one lucky truncation boundary.
(is (loop for width from 0 to (lime.x11::text-metrics-width metrics)
always
(multiple-value-bind (fitted prefix) (lime.x11::%fit-ui-text font text width)
(and (<= (lime.x11::%text-width font fitted) width)
(find prefix boundaries)
(string= text fitted :end1 prefix :end2 prefix)))))))
(dotimes (i 300) (lime.x11::%text-width font (format nil "cache ~D" i)))
(is (<= (hash-table-count (lime.x11::ui-text-font-metrics font)) 256)))
(lime.x11::%free-text-font font))
(is-false (lime.x11::ui-text-font-layout font))
(is-false (lime.x11::ui-canvas-surface (lime.x11::ui-text-font-canvas font)))
(lime.x11::%free-text-font font)))
(test absent-font-family-falls-back-and-font-resources-replace-safely
(let* ((style (make-ui-font-style :family "Lime Deliberately Nonexistent Font"))
(font (lime.x11::%open-text-font style))
(new nil))
(unwind-protect
(progn
(is (= 0 (lime.x11::text-metrics-unknown-glyphs (lime.x11::%text-metrics font "Hello"))))
(is (eq font (lime.x11::%ensure-text-font font style)))
(signals invalid-transition
(lime.x11::%ensure-text-font font (make-ui-font-style :size 0)))
(is-true (lime.x11::ui-text-font-layout font))
(setf new (lime.x11::%ensure-text-font font (make-ui-font-style :size 28)))
(is-false (lime.x11::ui-text-font-layout font))
(is (> (lime.x11::%font-line-height new) 28)))
(lime.x11::%free-text-font font)
(lime.x11::%free-text-font new))))
(test status-shaping-keeps-widget-boundaries-and-rtl-click-ranges
(let ((font (lime.x11::%open-text-font (make-ui-font-style))))
(unwind-protect
(progn
(multiple-value-bind (text prefix width runs)
(lime.x11::%fit-bar-status
font (list (make-head-bar-segment :text "مرحبا")
(make-head-bar-segment :text "🎮")) 300)
(declare (ignore text prefix))
(is (= 3 (length runs)))
(is (equal '("مرحبا" " | " "🎮") (mapcar (lambda (run) (getf run :text)) runs)))
(is (= width (reduce #'+ runs :key (lambda (run) (getf run :width))))))
(let* ((text "مرحبا...")
(ranges (lime.x11::%text-prefix-ranges font text 5)))
(is-true ranges)
;; For this RTL run the logical suffix dots are visually at left.
(is (plusp (caar ranges)))
(is (every (lambda (range) (<= 0 (car range) (cdr range)
(lime.x11::%text-width font text))) ranges))))
(lime.x11::%free-text-font font))))
(test prefix-color-rasterization-keeps-unicode-shaping-and-resets-between-fields
(let ((font (lime.x11::%open-text-font (make-ui-font-style)))
(canvas (lime.x11::%make-ui-canvas 300 28)))
(unwind-protect
(labels ((pixels ()
(lime.x11::%cairo-flush (lime.x11::ui-canvas-surface canvas))
(let ((data (lime.x11::%cairo-data (lime.x11::ui-canvas-surface canvas)))
(stride (lime.x11::%cairo-stride (lime.x11::ui-canvas-surface canvas))))
(loop for y below 28 append
(loop for x below 300 collect
(logand #xffffff (cffi:mem-ref data :uint32 (+ (* y stride) (* x 4))))))))
(red-p (pixel) (and (plusp pixel) (zerop (logand pixel #xffff))))
(gray-p (pixel) (= (ldb (byte 8 16) pixel) (ldb (byte 8 8) pixel) (ldb (byte 8 0) pixel))))
(dolist (text '("A title" "é 日本語" "é مرحبا"))
(let ((width (lime.x11::%text-width font text)) (normal nil))
(lime.x11::%canvas-rectangle canvas 0 0 300 28 "#000000")
(lime.x11::%canvas-text canvas font text 0 0 300 28 "#ffffff")
(setf normal (pixels))
(lime.x11::%canvas-rectangle canvas 0 0 300 28 "#000000")
(lime.x11::%canvas-text canvas font text 0 0 300 28 "#ffffff"
:prefix-length 1 :prefix-color "#ff0000")
(let ((colored (pixels)))
(is (some #'red-p colored))
(is (some (lambda (p) (and (plusp p) (gray-p p))) colored))
;; Foreground attributes must not move glyphs or change coverage.
(is (equal (mapcar (lambda (p) (ldb (byte 8 16) p)) normal)
(mapcar (lambda (p) (ldb (byte 8 16) p)) colored))))
(is (= width (lime.x11::%text-width font text)))
(lime.x11::%canvas-rectangle canvas 0 0 300 28 "#000000")
(lime.x11::%canvas-text canvas font text 0 0 300 28 "#ffffff")
(is (equal normal (pixels)))))
;; With no retained source characters, truncation dots stay neutral.
(multiple-value-bind (ignored prefix width runs)
(lime.x11::%fit-bar-status font (list (make-head-bar-segment :text "Long icon and label"
:prefix-length 4 :prefix-foreground "#ff0000"))
(lime.x11::%text-width font "..."))
(declare (ignore ignored prefix width))
(let ((run (first runs)))
(is (= 0 (getf run :prefix)))
(lime.x11::%canvas-rectangle canvas 0 0 300 28 "#000000")
(lime.x11::%canvas-text canvas font (getf run :text) 0 0 300 28 "#ffffff"
:prefix-length (getf run :prefix) :prefix-color "#ff0000")
(is (every #'gray-p (pixels))))))
(lime.x11::%free-ui-canvas canvas)
(lime.x11::%free-text-font font))))
(test opaque-rgb-upload-respects-truecolor-masks
(is (= #xf800 (lime.x11::%rgb-to-visual-pixel #xff0000 #xf800 #x7e0 #x1f 16)))
(is (= #xffff (lime.x11::%rgb-to-visual-pixel #xffffff #xf800 #x7e0 #x1f 16)))
(is (= #x563412 (lime.x11::%rgb-to-visual-pixel #x123456 #xff #xff00 #xff0000 24)))
(is (= #x3fffffff (lime.x11::%rgb-to-visual-pixel #xffffff #x3ff00000 #xffc00 #x3ff 30)))
(is (= #xff123456 (lime.x11::%rgb-to-visual-pixel #x123456 #xff0000 #xff00 #xff 32))))
(test measured-palette-rows-keep-selection-visible
(is (equal '(0 8) (multiple-value-list (lime.x11::%ui-visible-range 20 0 8))))
(is (equal '(5 13) (multiple-value-list (lime.x11::%ui-visible-range 20 12 8))))
(is (equal '(12 20) (multiple-value-list (lime.x11::%ui-visible-range 20 19 8))))
(is (equal '(0 2) (multiple-value-list (lime.x11::%ui-visible-range 2 1 8))))
(is (equal '(0 0) (multiple-value-list (lime.x11::%ui-visible-range 0 0 0)))))
(defun text-test-ink-bounds (canvas)
"Bounds of nonblack pixels, for checking real rasterization rather than math alone."
(lime.x11::%cairo-flush (lime.x11::ui-canvas-surface canvas))
(let ((data (lime.x11::%cairo-data (lime.x11::ui-canvas-surface canvas)))
(stride (lime.x11::%cairo-stride (lime.x11::ui-canvas-surface canvas)))
(left (lime.x11::ui-canvas-width canvas)) (right 0)
(top (lime.x11::ui-canvas-height canvas)) (bottom 0))
(dotimes (y (lime.x11::ui-canvas-height canvas))
(dotimes (x (lime.x11::ui-canvas-width canvas))
(when (plusp (logand #xffffff (cffi:mem-ref data :uint32 (+ (* y stride) (* x 4)))))
(setf left (min left x) right (max right (1+ x))
top (min top y) bottom (max bottom (1+ y))))))
(values left top right bottom)))
(test bar-baseline-centers-letter-bodies-not-empty-font-leading
(dolist (style (list (make-ui-font-style)
(make-ui-font-style :family "Dina, Fira Code Nerd Font" :size 12 :weight :bold)))
(let ((font (lime.x11::%open-text-font style))
(canvas (lime.x11::%make-ui-canvas 240 22)))
(unwind-protect
(let ((baseline (lime.x11::%font-centered-baseline font 22)))
(lime.x11::%canvas-rectangle canvas 0 0 240 22 "#000000")
(lime.x11::%canvas-text canvas font "ABCabc012" 10 0 220 22 "#ffffff" :baseline baseline)
(multiple-value-bind (left top right bottom) (text-test-ink-bounds canvas)
(is (<= 10 left right 230))
(is (<= (abs (- top (- 22 bottom))) 1))
(is (< 0 top bottom 22)))
;; A descender changes ink bounds, but must not move existing letters.
(let ((old-pixels nil)
(sample-width (lime.x11::%text-width font "ABCabc012")))
(labels ((sample-pixels ()
(lime.x11::%cairo-flush (lime.x11::ui-canvas-surface canvas))
(let ((data (lime.x11::%cairo-data (lime.x11::ui-canvas-surface canvas)))
(stride (lime.x11::%cairo-stride (lime.x11::ui-canvas-surface canvas))))
(loop for y below 22 append
(loop for x from 10 below (+ 10 sample-width) collect
(logand #xffffff (cffi:mem-ref data :uint32 (+ (* y stride) (* x 4)))))))))
(setf old-pixels (sample-pixels))
(lime.x11::%canvas-rectangle canvas 0 0 240 22 "#000000")
(lime.x11::%canvas-text canvas font "ABCabc012 gj" 10 0 220 22 "#ffffff" :baseline baseline)
(is (equal old-pixels (sample-pixels)))))
;; Fallback glyphs and other measurements don't alter the reference.
(lime.x11::%text-metrics font "日本語 🎮 Égj")
(is (= baseline (lime.x11::%font-centered-baseline font 22))))
(lime.x11::%free-ui-canvas canvas)
(lime.x11::%free-text-font font)))))