summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Kochmański <daniel@turtleware.eu>2023-12-23 19:02:46 +0100
committerDaniel Kochmański <daniel@turtleware.eu>2023-12-23 20:42:42 +0100
commit8834f8feb3d3e14d432b84fc915cff439188c019 (patch)
tree8c1bc9d7e65e696aab2d4fd0d0c84785637260c4
parent0dcb0cb46f4082e7aa28462f1c7578a66c10f02b (diff)
clx: premultiply the alpha channel in patterns
-rw-r--r--Backends/CLX/drawing.lisp21
-rw-r--r--Backends/CLX/medium-xrender.lisp4
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))