Tune theme colors

… I should go back to Modus.

1 files changed, 57 insertions, 24 deletions

diff --git a/.emacs.d/eighters-theme.el b/.emacs.d/eighters-theme.el
index cb8b43e..453e546 100644
--- a/.emacs.d/eighters-theme.el
+++ b/.emacs.d/eighters-theme.el
@@ -38,33 +38,59 @@
                 'face `(:foreground ,hex)))))))
       (pop-to-buffer buf))))
 
-;; Let  H be the set of all lightness variations of full-saturation hue h,
-;;      CR(c) be the WCAG contrast-ratio function applied to (c, #fff),
-;;      CR[S, P] be the set { CR(c) ∀ c∈S | P(c) },
-;;
-;;  bg-h        is c such that CR(c) = min(CR[H, >15])
-;;  bg-h-dim    is c such that CR(c) = max(CR[H, <19])
-;;  bg-h-dimmer is c such that CR(c) = max(CR[H, <20])
-;;
-;;  fg-h-subtle is (h, 60%, 80%)
-;;  fg-h-dim    is (h, 50%, 60%)
+(defvar eighters-hues
+  '((red     . "brown2")
+    (green   . "chartreuse2")
+    (yellow  . "gold")
+    (blue    . "steelblue1")
+    (magenta . "violet")
+    (cyan    . "cadetblue2")))
 
 (defvar eighters-palette
   '((bg "#000") (bg-hl-dimmer "#0f0f0f") (bg-hl-dim "#181818") (bg-hl "#222")
-    (fg-red     "brown2")      (fg-red-dim     "#cc6565") (fg-red-subtle     "#eaadad")
-    (bg-red     "#560000")     (bg-red-dim     "#2d0000") (bg-red-dimmer     "#1e0000")
-    (fg-green   "chartreuse2") (fg-green-dim   "#98cc65") (fg-green-subtle   "#cbeaad")
-    (bg-green   "#142800")     (bg-green-dim   "#0a1400") (bg-green-dimmer   "#070f00")
-    (fg-yellow  "gold")        (fg-yellow-dim  "#ccbc65") (fg-yellow-subtle  "#eae1ad")
-    (bg-yellow  "#2d2600")     (bg-yellow-dim  "#141100") (bg-yellow-dimmer  "#0f0c00")
-    (fg-blue    "steelblue1")  (fg-blue-dim    "#659dcc") (fg-blue-subtle    "#adceea")
-    (bg-blue    "#002647")     (bg-blue-dim    "#001323") (bg-blue-dimmer    "#000b14")
-    (fg-magenta "violet")      (fg-magenta-dim "#cc65cc") (fg-magenta-subtle "#eaadea")
-    (bg-magenta "#470047")     (bg-magenta-dim "#280028") (bg-magenta-dimmer "#190019")
-    (fg-cyan    "cadetblue2")  (fg-cyan-dim    "#65c2cc") (fg-cyan-subtle    "#ade4ea")
-    (bg-cyan    "#00292d")     (bg-cyan-dim    "#001719") (bg-cyan-dimmer    "#000d0f")
+    (fg-red     "#ed5e5e") (fg-red-dim     "#c99b9b") (fg-red-subtle     "#efa8a8")
+    (bg-red     "#4c0000") (bg-red-dim     "#350000") (bg-red-dimmer     "#1e0000")
+    (fg-green   "#a5ed5e") (fg-green-dim   "#b2c99b") (fg-green-subtle   "#cbefa8")
+    (bg-green   "#122600") (bg-green-dim   "#0c1900") (bg-green-dimmer   "#060c00")
+    (fg-yellow  "#edd65e") (fg-yellow-dim  "#c9c29b") (fg-yellow-subtle  "#efe4a8")
+    (bg-yellow  "#262000") (bg-yellow-dim  "#191500") (bg-yellow-dimmer  "#0c0a00")
+    (fg-blue    "#5eaced") (fg-blue-dim    "#9bb4c9") (fg-blue-subtle    "#a8cfef")
+    (bg-blue    "#00223f") (bg-blue-dim    "#00172b") (bg-blue-dimmer    "#000b14")
+    (fg-magenta "#ed5eed") (fg-magenta-dim "#c99bc9") (fg-magenta-subtle "#efa8ef")
+    (bg-magenta "#420042") (bg-magenta-dim "#2d002d") (bg-magenta-dimmer "#190019")
+    (fg-cyan    "#5edfed") (fg-cyan-dim    "#9bc5c9") (fg-cyan-subtle    "#a8e9ef")
+    (bg-cyan    "#002428") (bg-cyan-dim    "#00191c") (bg-cyan-dimmer    "#000b0c")
     (fg "#fff") (fg-dim "#bbb") (fg-dimmer "#888")))
 
+(defun eighters--step-while (init step predicate)
+  (let ((result init)
+        (next init))
+    (while (funcall predicate (cl-incf next step))
+      (setq result next))
+    result))
+
+(defun eighters--brightest-bg (hue contrast-min)
+  (eighters-hsl-to-hex
+   hue 1
+   (eighters--step-while
+    0 .005
+    (lambda (luminance)
+      (let ((candidate (eighters-hsl-to-hex hue 1 luminance)))
+        (> (modus-themes-contrast "#fff" candidate) contrast-min))))))
+
+(defun eighters-set-palette ()
+  (interactive)
+  (pcase-dolist (`(,hue-sym . ,hue-name) eighters-hues)
+    (let ((hue (car (apply 'color-rgb-to-hsl (color-name-to-rgb hue-name)))))
+      (setf
+       (eighters-color 'fg hue-sym nil)     (eighters-hsl-to-hex hue .8 .65)
+       (eighters-color 'fg hue-sym 'dim)    (eighters-hsl-to-hex hue .3 .7)
+       (eighters-color 'fg hue-sym 'subtle) (eighters-hsl-to-hex hue .7 .8)
+       (eighters-color 'bg hue-sym nil)     (eighters--brightest-bg hue 16)
+       (eighters-color 'bg hue-sym 'dim)    (eighters--brightest-bg hue 18)
+       (eighters-color 'bg hue-sym 'dimmer) (eighters--brightest-bg hue 19.75))))
+  (load-theme 'eighters t))
+
 (defun eighters-show-palette ()
   (interactive)
   (let ((buf (get-buffer-create "*Eighters palette*")))
@@ -117,8 +143,15 @@
 (defun eighters-color (symbol)
   (car (alist-get symbol eighters-palette)))
 
-(defun eighters-color-set (symbol value)
-  (setf (car (alist-get symbol eighters-palette)) value))
+(defun eighters--sym (xground hue qualifier)
+  (intern
+   (apply 'concat `( ,(symbol-name xground) "-"
+                     ,(symbol-name hue)
+                     ,@(when qualifier `("-" ,(symbol-name qualifier)))))))
+
+(defun eighters-color-set (xground hue qualifier value)
+  (let ((sym (eighters--sym xground hue qualifier)))
+    (setf (car (alist-get sym eighters-palette)) value)))
 
 (gv-define-simple-setter eighters-color eighters-color-set)