[nongnu] elpa/autothemer b0df7578fc 17/29: Additional parameters for svg generator.

[ELPA Syncer]

branch: elpa/autothemer
commit b0df7578fcaf071b546746f13e5bb6419206a102
Author: Jason Milkins <jasonm23@gmail.com>
Commit: Jason Milkins <jasonm23@gmail.com>

    Additional parameters for svg generator.
    
    - sort palette.
    - change rotation of swatch.
---
 autothemer.el             | 118 +++++++++++++++++++++++++++++++++++++++++++---
 tests/autothemer-tests.el |  74 ++++++++++++++++++++++++-----
 2 files changed, 175 insertions(+), 17 deletions(-)

diff --git a/autothemer.el b/autothemer.el
index e7bdce5d9e..197a31b4f5 100644
--- a/autothemer.el
+++ b/autothemer.el
@@ -136,8 +136,8 @@ bindings within both the REDUCED-SPECS and the BODY."
   "Return the distance in rgb space between COLOR and AUTOTHEMER-COLOR.
 Here, COLOR is an Emacs color specification and AUTOTHEMER-COLOR is of
 type `autothemer--color'."
-  (let ((rgb-1 (color-values color))
-        (rgb-2 (color-values (autothemer--color-value autothemer-color))))
+  (let ((rgb-1 (autothemer-hex-to-rgb color))
+        (rgb-2 (autothemer-hex-to-rgb (autothemer--color-value 
autothemer-color))))
     (-sum (--zip-with (abs (- it other)) rgb-1 rgb-2))))
 
 (defun autothemer--find-closest-color (colors color)
@@ -426,6 +426,101 @@ Colors are from `autothemer--current-theme'."
          (0 (rainbow-colorize-by-assoc (autothemer-colorize-alist))))))
   (font-lock-add-keywords nil autothemer--colors-font-lock-keywords t))
 
+(defun autothemer--color-to-hsv (rgb)
+  "Convert RGB, a list of `(r g b)' to list `(h s v)'.
+The `r' `g' `b' values can range between `0..65535'.
+
+In `(h s v)' `h', `s' and `v' are `0.0..1.0'."
+  (cl-destructuring-bind
+      (r g b) rgb
+    (let*
+        ((bri (max r g b))
+         (delta (- bri (min r g b)))
+         (sat (if (cl-plusp bri)
+                  (/ delta bri)
+                0.0))
+         (normalize #'(lambda
+                        (constant right left)
+                        (let ((hue (+ constant (/ (* 60.0 (- right left)) 
delta))))
+                          (if (cl-minusp hue)
+                              (+ hue 360.0)
+                            hue)))))
+      (list (/ (cond
+                ((zerop sat) 0.0)
+                ((= r bri) (funcall normalize 0.0 g b)) ; dominant r
+                ((= g bri) (funcall normalize 120.0 b r)) ; dominant g
+                (t (funcall normalize 240.0 r g)))
+               360.0)
+            sat
+            bri))))
+
+(defun autothemer-hex-to-rgb (hex)
+  "Fast convert HEX to `(r g b)'.
+
+Fast as in no error checking and a early escape for
+
+`r', `g', `b' will be values `0.9..1.1'"
+  (let ((rgb (string-to-number (substring hex 1) 16)))
+    (list
+     (* #x101 (ash (logand #xFF0000 rgb) -16))
+     (* #x101 (ash (logand #xFF00 rgb) -8))
+     (* #x101 (logand #xFF rgb)))))
+
+(defun autothemer-color-hue (hex-color)
+  "Return the HSL hue of HEX-COLOR."
+  (car (autothemer--color-to-hsv (autothemer-hex-to-rgb hex-color))))
+
+(defun autothemer-color-sat (hex-color)
+  "Return the HSL sat of HEX-COLOR."
+  (cadr (autothemer--color-to-hsv (autothemer-hex-to-rgb hex-color))))
+
+(defun autothemer-color-brightness (hex-color)
+  "Return the HSL luminance of HEX-COLOR."
+  (caddr (autothemer--color-to-hsv (autothemer-hex-to-rgb hex-color))))
+
+(defun autothemer-darkest-order (a b)
+  "Return t if the darkness of A > B."
+  (let ((a (autothemer-color-brightness (autothemer--color-value a)))
+        (b (autothemer-color-brightness (autothemer--color-value b))))
+    (> b a)))
+
+(defun autothemer-lightest-order (a b)
+  "Return t if the lightness of A > B."
+  (let ((a (autothemer-color-brightness (autothemer--color-value a)))
+        (b (autothemer-color-brightness (autothemer--color-value b))))
+      (> a b)))
+
+(defun autothemer-saturated-order (a b)
+  "Return t if the saturation of A > B."
+  (let ((a (autothemer-color-sat (autothemer--color-value a)))
+        (b (autothemer-color-sat (autothemer--color-value b))))
+      (> a b)))
+
+(defun autothemer-hue-order (a b)
+  "Return t if the hue of A > B."
+  (let ((a (autothemer-color-hue (autothemer--color-value a)))
+        (b (autothemer-color-hue (autothemer--color-value b))))
+      (> a b)))
+
+(defun autothemer-hue-sat-order (a b)
+  "Return t if the hue and sat of a > b."
+  (let ((a (autothemer-color-hue (autothemer--color-value a)))
+        (b (autothemer-color-hue (autothemer--color-value b))))
+    (> a b)))
+
+(autothemer--color-to-hsv (autothemer-hex-to-rgb "#FF007F"))
+
+(defun autothemer-sort-palette (theme-colors &optional fn)
+  "Produce a list of sorted THEME-COLORS using FN.
+
+If FN is nil, sort by default FN `autothemer-darkest-order'.
+
+`autothemer-lightest-order' is available to balance the force.
+
+There are also `autothemer-hue-order' and `autothemer-saturated-order'"
+  (let ((fn (or fn 'autothemer-darkest-order)))
+     (-sort fn theme-colors)))
+
 ;;; SVG Palette generator...
 
 (defun autothemer-generate-palette-svg (&optional options)
@@ -439,6 +534,7 @@ Optionally supply OPTIONS, a plist (all keys are optional):
     :theme-url - override the url found in :theme-file
     :swatch-width - px spacing width of a color swatch (default: 100)
     :swatch-height - px spacing height of a color swatch (default: 150)
+    :swatch-rotate - degrees of rotation for swatch (default: 45)
     :columns - number of columns for each palette row (default: 6)
     :page-template - see page-template below
     :page-top-margin - (default ...)
@@ -453,6 +549,7 @@ Optionally supply OPTIONS, a plist (all keys are optional):
     :text-color
     :text-accent-color
     :swatch-border-color
+    :sort-palette
     :svg-out-file
 
 For advanced customization the :page-template and :swatch-template can be
@@ -488,8 +585,10 @@ Swatch Template parameters:
      theme-description
      theme-url
 
+     sort-palette
      swatch-width
      swatch-height
+     swatch-rotate
      columns
 
      page-top-margin
@@ -536,18 +635,20 @@ Swatch Template parameters:
                          |    </a>
                          |  </g>
                          |  <g transform=\"translate(70,-40)\">
-                         |  %10$s
+                         |    %10$s
                          |  </g>
                          |</svg>
                          |")))
 
             (swatch-template
              (or swatch-template
-              (autothemer--unindent "<g 
transform=\"translate(%1$s,%2$s),rotate(45)\">
+              (autothemer--unindent "<g 
transform=\"translate(%1$s,%2$s),rotate(%9$s)\">
                          | <ellipse cx=\"70\" cy=\"70\" rx=\"45\" ry=\"45\" 
id=\"background-color\" fill=\"%3$s\"/>
                          | <ellipse cx=\"70\" cy=\"70\" rx=\"42\" ry=\"42\" 
id=\"color\" fill=\"%4$s\"/>
                          | <text style=\"font-size:7pt\" font-weight=\"bold\" 
x=\"52\" y=\"125\" id=\"color-name\">%6$s</text>
                          | <text style=\"font-size:7pt; fill:%5$s;\" 
font-weight=\"bold\" x=\"52\" y=\"134\" id=\"color\">%4$s</text>
+                         | <!-- Rect below is for debug set stroke width to be 
visible -->
+                         |   <rect x=\"0\" y=\"0\" width=\"%7$spx\" 
height=\"%8$spx\" class=\"debug-rect\" fill-opacity=\"0.0\" 
stroke-width=\"0.0mm\" stroke=\"#FF8000\"/>
                          |</g>
                          |")))
 
@@ -560,6 +661,7 @@ Swatch Template parameters:
             (font-family        (or font-family        (read-string "Font 
family name: " "Helvetica Neue")))
             (swatch-width       (or swatch-width       (read-number "Swatch 
width: " 100)))
             (swatch-height      (or swatch-height      (read-number "Swatch 
height: " 150)))
+            (swatch-rotate      (or swatch-rotate      (read-number "Swatch 
rotate: " 45)))
             (columns            (or columns            (read-number "Number or 
columns: " 6)))
             (page-top-margin    (or page-top-margin    (read-number "Page Top 
margin: " 120)))
             (page-bottom-margin (or page-bottom-margin (read-number "Page 
Bottom margin: " 60)))
@@ -598,8 +700,12 @@ Swatch Template parameters:
                                              swatch-border-color
                                              color
                                              text-accent-color
-                                             name)))
-                             colors)
+                                             name swatch-width swatch-height 
swatch-rotate)))
+                             (if sort-palette
+                                 (if (eql t sort-palette)
+                                     (autothemer-sort-palette colors)
+                                   (autothemer-sort-palette colors (intern 
sort-palette)))
+                                 colors))
                             "\n")))
        (with-temp-file svg-out-file
          (insert
diff --git a/tests/autothemer-tests.el b/tests/autothemer-tests.el
index efe60431bb..03ab60faac 100644
--- a/tests/autothemer-tests.el
+++ b/tests/autothemer-tests.el
@@ -93,22 +93,74 @@
              "#781210"
              (autothemer-let-palette example-red))))
 
+  (ert-deftest unindent ()
+    "Test unindent."
+    (should
+      (string=
+        (autothemer--unindent "|Hello world
+                               |  Foo bar
+                               |  Indent
+                               |")
+        "Hello world\n  Foo bar\n  Indent\n")))
+
   (ert-deftest autothemer-plist-bind ()
-    "Test plist-bind"
+    "Test plist-bind."
     (autothemer--plist-bind (a b) '(:a 1 :b 2)
      (should (eql a 1))
      (should (eql b 2))))
 
-  (ert-deftest autothemer-colorize-alist ()
-    "Check autothemer-colorize-alist."
-    (should (equal '(("example-red" . "#781210")
-                     ("example-green" . "#22881F")
-                     ("example-blue" . "#212288")
-                     ("example-purple" . "#812FFF")
-                     ("example-yellow" . "#EFFE00")
-                     ("example-orange" . "#E06500")
-                     ("example-cyan" . "#22DDFF"))
-                   (autothemer-colorize-alist)))))
+ (ert-deftest autothemer-color-hue ()
+  "Test get hue of hex-color."
+   (= (autothemer-color-hue "#FF0000") 0)
+   (= (autothemer-color-hue "#FFFF00") 0.16666666666666666)
+   (= (autothemer-color-hue "#00FF00") 0.33333333333333333)
+   (= (autothemer-color-hue "#0000FF") 0.66666666666666666))
+
+ (ert-deftest autothemer-color-sat ()
+   "Test get sat of hex-color."
+   (= (autothemer-color-sat "#0000FF") 1.0)
+   (= (autothemer-color-sat "#FF00FF") 1.0)
+   (= (autothemer-color-sat "#778822") 0.75)
+   (= (autothemer-color-sat "#772288") 0.75)
+   (= (autothemer-color-sat "#112233") 0.6666666666666667))
+
+ (ert-deftest autothemer-color-brightness ()
+   "Test get brightness of hex-color."
+   (= (autothemer-color-brightness "#0000FF") 1.0)
+   (= (autothemer-color-brightness "#00FF00") 1.0)
+   (= (autothemer-color-brightness "#FF00FF") 1.0)
+   (= (autothemer-color-brightness "#333333") 0.2)
+   (= (autothemer-color-brightness "#555555") 0.3333333333333333))
+
+ (ert-deftest autothemer--color-distance ()
+   "Test color distance."
+   (let ((color-struct (make-autothemer--color :name "Test" :value "#100000")))
+    (should (eql (autothemer--color-distance "#100000" color-struct) 0))
+    (should (eql (autothemer--color-distance "#100001" color-struct) 257))
+    (should (eql (autothemer--color-distance "#000001" color-struct) 4369))
+    (should (eql (autothemer--color-distance "#FF0000" color-struct) 61423))))
+
+ (ert-deftest autothemer-hex-to-rgb ()
+   "Test hex to rgb."
+  (should (equal '(0 0 0) (autothemer-hex-to-rgb "#000000")))
+  (should (equal '(65535 65535 65535) (autothemer-hex-to-rgb "#FFFFFF")))
+  (should (equal '(65535 0 0) (autothemer-hex-to-rgb "#FF0000")))
+  (should (equal '(65535 65535 0) (autothemer-hex-to-rgb "#FFFF00")))
+  (should (equal '(0 65535 0) (autothemer-hex-to-rgb "#00FF00")))
+  (should (equal '(0 65535 65535) (autothemer-hex-to-rgb "#00FFFF")))
+  (should (equal '(0 0 65535) (autothemer-hex-to-rgb "#0000FF")))
+  (should (equal '(32896 32896 32896) (autothemer-hex-to-rgb "#808080"))))
+
+ (ert-deftest autothemer-colorize-alist ()
+   "Check autothemer-colorize-alist."
+   (should (equal '(("example-red" . "#781210")
+                    ("example-green" . "#22881F")
+                    ("example-blue" . "#212288")
+                    ("example-purple" . "#812FFF")
+                    ("example-yellow" . "#EFFE00")
+                    ("example-orange" . "#E06500")
+                    ("example-cyan" . "#22DDFF"))
+                  (autothemer-colorize-alist)))))
 
 ;;; Example theme in memory:
 '(#s(autothemer--theme