Allow a sexp node in ivy-views

[gnu-emacs-elpa] / colir.el

diff --git a/colir.el b/colir.el
index 734f902f76ac59875e2f755b2a36415a8edde965..792033fca394b5fc38e93782cec6b906f1e1debe 100644 (file)
--- a/colir.el
+++ b/colir.el
@@ -24,28 +24,49 @@
 ;; This package solves the problem of adding a face with a background
 ;; to text which may already have a background.  In all conflicting
 ;; areas, instead of choosing either the original or the new
-;; background face, their alpha blended sum is used.
+;; background face, their blended sum is used.
+;;
+;; The blend mode functions are taken from http://en.wikipedia.org/wiki/Blend_modes.
 
 ;;; Code:
 
-(defun colir-join (r g b)
-  "Build a color from R G B.
-Inverse of `color-values'."
-  (format "#%02x%02x%02x"
-          (ash r -8)
-          (ash g -8)
-          (ash b -8)))
-
-(defun colir-blend (c1 c2 &optional alpha)
-  "Blend the two colors C1 and C2 with ALPHA.
-C1 and C2 are in the format of `color-values'.
-ALPHA is a number between 0.0 and 1.0 which corresponds to the
-influence of C1 on the result."
+(require 'color)
+
+(defcustom colir-compose-method 'colir-compose-alpha
+  "Select a method to compose two color channels."
+  :type '(choice
+          (const colir-compose-alpha)
+          (const colir-compose-overlay)
+          (const colir-compose-soft-light))
+  :group 'ivy)
+
+(defun colir-compose-soft-light (a b)
+  "Compose A and B channels."
+  (if (< b 0.5)
+      (+ (* 2 a b) (* a a (- 1 b b)))
+    (+ (* 2 a (- 1 b)) (* (sqrt a) (- (* 2 b) 1)))))
+
+(defun colir-compose-overlay (a b)
+  "Compose A and B channels."
+  (if (< a 0.5)
+      (* 2 a b)
+    (- 1 (* 2 (- 1 a) (- 1 b)))))
+
+(defun colir-compose-alpha (a b &optional alpha gamma)
+  "Compose A and B channels."
   (setq alpha (or alpha 0.5))
-  (apply #'colir-join
+  (setq gamma (or gamma 2.2))
+  (+ (* (expt a gamma) alpha) (* (expt b gamma) (- 1 alpha))))
+
+(defun colir-blend (c1 c2)
+  "Blend the two colors C1 and C2 using `colir-compose-method'.
+C1 and C2 are triples of floats in [0.0 1.0] range."
+  (apply #'color-rgb-to-hex
          (cl-mapcar
-          (lambda (x y)
-            (round (+ (* x alpha) (* y (- 1 alpha)))))
+          (if (eq (frame-parameter nil 'background-mode) 'dark)
+              ;; this method works nicely for dark themes
+              'colir-compose-soft-light
+            colir-compose-method)
           c1 c2)))
 
 (defun colir-blend-face-background (start end face &optional object)
@@ -56,9 +77,11 @@ Optional argument OBJECT is the string or buffer containing the text.
 See also `font-lock-append-text-property'."
   (let (next prev)
     (while (/= start end)
-      (setq next (next-single-property-change start 'face object end)
-            prev (get-text-property start 'face object))
-      (if prev
+      (setq next (next-single-property-change start 'face object end))
+      (setq prev (get-text-property start 'face object))
+      (when (listp prev)
+        (setq prev (cl-find-if #'atom prev)))
+      (if (facep prev)
           (let ((background-prev (face-background prev)))
             (progn
               (put-text-property
@@ -66,8 +89,8 @@ See also `font-lock-append-text-property'."
                (if background-prev
                    (cons `(background-color
                            . ,(colir-blend
-                               (color-values background-prev)
-                               (color-values (face-background face nil t))))
+                               (color-name-to-rgb background-prev)
+                               (color-name-to-rgb (face-background face nil t))))
                          prev)
                  (list face prev))
                object)))