diff options
author | Daniel Kochmański <daniel@turtleware.eu> | 2023-12-23 19:02:46 +0100 |
---|---|---|
committer | Daniel Kochmański <daniel@turtleware.eu> | 2023-12-23 20:42:42 +0100 |
commit | 8834f8feb3d3e14d432b84fc915cff439188c019 (patch) | |
tree | 8c1bc9d7e65e696aab2d4fd0d0c84785637260c4 | |
parent | 0dcb0cb46f4082e7aa28462f1c7578a66c10f02b (diff) |
clx: premultiply the alpha channel in patterns
-rw-r--r-- | Backends/CLX/drawing.lisp | 21 | ||||
-rw-r--r-- | Backends/CLX/medium-xrender.lisp | 4 |
2 files changed, 23 insertions, 2 deletions
diff --git a/Backends/CLX/drawing.lisp b/Backends/CLX/drawing.lisp index 3b035d07..3022b696 100644 --- a/Backends/CLX/drawing.lisp +++ b/Backends/CLX/drawing.lisp @@ -20,6 +20,27 @@ (clamp (truncate (* #xffff a b)) 0 #xffff) (clamp (truncate (* #xffff a)) 0 #xffff))) +(defun make-clx-render-image/argb32 (pattern) + (flet ((premultiply-alpha (val) + (let ((a (ldb (byte 8 24) val)) + (r (ldb (byte 8 16) val)) + (g (ldb (byte 8 8) val)) + (b (ldb (byte 8 0) val))) + (logior (ash a 24) + (ash (truncate (* a r) #xff) 16) + (ash (truncate (* a g) #xff) 8) + (ash (truncate (* a b) #xff) 0))))) + (let* ((w (ceiling (pattern-width pattern))) + (h (ceiling (pattern-height pattern))) + (array (make-array (list w h) :element-type '(unsigned-byte 32)))) + (loop for i from 0 below w + for x from 0 do + (loop for j below h + for y from 0 + for value = (climi::%pattern-rgba-value pattern x y) do + (setf (aref array j i) (premultiply-alpha value)))) + array))) + (defparameter +transparent-black+ (make-clx-render-color 0 0 0 0)) diff --git a/Backends/CLX/medium-xrender.lisp b/Backends/CLX/medium-xrender.lisp index 0549593c..0ebf96ea 100644 --- a/Backends/CLX/medium-xrender.lisp +++ b/Backends/CLX/medium-xrender.lisp @@ -84,7 +84,7 @@ (let* ((drawable (clx-drawable medium)) (width (ceiling (pattern-width pattern))) (height (ceiling (pattern-height pattern))) - (idata (climi::%collapse-pattern pattern 0 0 width height)) + (idata (make-clx-render-image/argb32 pattern)) (pixmap (xlib:create-pixmap :drawable drawable :width width :height height @@ -94,7 +94,7 @@ :height height :depth 32 :bits-per-pixel 32 - :data (pattern-array idata)))) + :data idata))) (put-image-recursively pixmap gcontext ximage width height 0 0) (xlib:free-gcontext gcontext) pixmap)) |