diff options
Diffstat (limited to 'elpa/ivy-20200624.1140/colir.el')
| -rw-r--r-- | elpa/ivy-20200624.1140/colir.el | 124 |
1 files changed, 0 insertions, 124 deletions
diff --git a/elpa/ivy-20200624.1140/colir.el b/elpa/ivy-20200624.1140/colir.el deleted file mode 100644 index 9e61273..0000000 --- a/elpa/ivy-20200624.1140/colir.el +++ /dev/null @@ -1,124 +0,0 @@ -;;; colir.el --- Color blending library -*- lexical-binding: t -*- - -;; Copyright (C) 2015-2019 Free Software Foundation, Inc. - -;; Author: Oleh Krehel <ohwoeowho@gmail.com> - -;; This file is part of GNU Emacs. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; For a full copy of the GNU General Public License -;; see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; 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 blended sum is used. -;; -;; The blend mode functions are taken from URL -;; `https://en.wikipedia.org/wiki/Blend_modes'. - -;;; Code: - -(require 'cl-lib) -(require 'color) - -(defcustom colir-compose-method #'colir-compose-alpha - "Select a method to compose two color channels." - :group 'ivy - :type '(radio - (function-item colir-compose-alpha) - (function-item colir-compose-overlay) - (function-item colir-compose-soft-light))) - -(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. -Optional argument ALPHA is a number between 0.0 and 1.0 which corresponds -to the influence of A on the result. Default value is 0.5. -Optional argument GAMMA is used for gamma correction. Default value is 2.2." - (setq alpha (or alpha 0.5)) - (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 - (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-color-parse (color) - "Convert string COLOR to triple of floats in [0.0 1.0]." - (if (string-match "#\\([[:xdigit:]]\\{2\\}\\)\\([[:xdigit:]]\\{2\\}\\)\\([[:xdigit:]]\\{2\\}\\)" color) - (mapcar (lambda (v) (/ (string-to-number v 16) 255.0)) - (list (match-string 1 color) (match-string 2 color) (match-string 3 color))) - ;; does not work properly in terminal (maps color to nearest color - ;; from available color palette). - (color-name-to-rgb color))) - -(defun colir--blend-background (start next prevn face object) - (let ((background-prev (face-background prevn))) - (progn - (put-text-property - start next 'face - (if background-prev - (cons `(background-color - . ,(colir-blend - (colir-color-parse background-prev) - (colir-color-parse (face-background face nil t)))) - prevn) - (list face prevn)) - object)))) - -(defun colir-blend-face-background (start end face &optional object) - "Append to the face property of the text from START to END the face FACE. -When the text already has a face with a non-plain background, -blend it with the background of FACE. -Optional argument OBJECT is the string or buffer containing the text. -See also `font-lock-append-text-property'." - (let (next prev prevn) - (while (/= start end) - (setq next (next-single-property-change start 'face object end)) - (setq prev (get-text-property start 'face object)) - (setq prevn (if (listp prev) - (cl-find-if #'atom prev) - prev)) - (cond - ((or (keywordp (car-safe prev)) (consp (car-safe prev))) - (put-text-property start next 'face (cons face prev) object)) - ((facep prevn) - (colir--blend-background start next prevn face object)) - (t - (put-text-property start next 'face face object))) - (setq start next)))) - -(provide 'colir) - -;;; colir.el ends here |