;; -*- lexical-binding: t -*-

(require 'color)
(require-theme 'modus-themes)

(deftheme eighters
  "Eighters gonna eight.")

(defun eighters-hsl-to-hex (h s l)
  (apply
   'color-rgb-to-hex
   `(,@(color-hsl-to-rgb h s l) 2)))

(defun eighters-decline-hue-bg (name light-step)
  (interactive
   (list (read-color "Color to decline? ")
         (read-number "Light step? (1–100) ")))
  (pcase-let* ((`(,r ,g ,b) (color-name-to-rgb name))
               (`(,h _ _)  (color-rgb-to-hsl r g b)))
    (let ((variants (seq-map
                     (lambda (l)
                       (cons l (eighters-hsl-to-hex h 1.0 (/ l 100.0))))
                     (number-sequence 0 100 light-step)))
          (buf (format "*%s variants*" name)))
      (with-current-buffer (get-buffer-create buf)
        (pcase-dolist (`(,l . ,hex) variants)
          (let ((cr (modus-themes-contrast "#fff" hex)))
            (when (> cr 7.0)
              (insert
               (propertize (format "%s %3s\t%6.3f\n" hex l cr)
                'face `(:background ,hex :extend t))))))
        (pcase-dolist (`(,l . ,hex) variants)
          (let ((cr (modus-themes-contrast "#000" hex)))
            (when (> cr 7.0)
              (insert
               (propertize (format "%s %3s\t%6.3f\n" hex l cr)
                '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, 100%, 85%)

(defvar eighters-palette
  `((bg "#000") (bg-hl-dimmer "#0f0f0f") (bg-hl-dim "#181818") (bg-hl "#222")
    (fg-red "brown2")           (fg-red-dim "brown")        (fg-red-subtle "#ffb2b2")
    (bg-red "#560000")          (bg-red-dim "#2d0000")      (bg-red-dimmer "#1e0000")
    (fg-green "chartreuse2")    (fg-green-dim "#60ae13")    (fg-green-subtle "#d8ffb2")
    (bg-green "#142800")        (bg-green-dim "#0a1400")    (bg-green-dimmer "#070f00")
    (fg-yellow "gold")          (fg-yellow-dim "gold3")     (fg-yellow-subtle "#fff3b2")
    (bg-yellow "#2d2600")       (bg-yellow-dim "#141100")   (bg-yellow-dimmer "#0f0c00")
    (fg-blue "steelblue1")      (fg-blue-dim "steelblue3")  (fg-blue-subtle "#b2dcff")
    (bg-blue "#002647")         (bg-blue-dim "#001323")     (bg-blue-dimmer "#000b14")
    (fg-magenta "violet")       (fg-magenta-dim "#e64be6")  (fg-magenta-subtle "#ffb2ff")
    (bg-magenta "#470047")      (bg-magenta-dim "#280028")  (bg-magenta-dimmer "#190019")
    (fg-cyan "cadetblue2")      (fg-cyan-dim "cadetblue3")  (fg-cyan-subtle "#b2f7ff")
    (bg-cyan "#00292d")         (bg-cyan-dim "#001719")     (bg-cyan-dimmer "#000d0f")
    (fg "#fff") (fg-dim "#bbb") (fg-dimmer "#888")))

(defun eighters-show-palette ()
  (interactive)
  (list-colors-display
   (mapcar 'cadr eighters-palette)
   "*Eighters palette*"))

(defun eighters-color (symbol)
  (car (alist-get symbol eighters-palette)))

(defface eighters-button nil
  "Face for elements that can be \"pushed\" with RET.")
(defface eighters-date nil
  "Face for text that describes dates.")
(defface eighters-identity nil
  "Face for names of persons")
(defface eighters-markup nil
  "Face for text that describes \"structure\" rather than content.")
(defface eighters-title-1 nil
  "Face for level 1 headings.")
(defface eighters-title-2 nil
  "Face for level 2 headings.")
(defface eighters-title-3 nil
  "Face for level 3 headings.")
(defface eighters-title-4 nil
  "Face for level 4 headings.")
(defface eighters-title-5 nil
  "Face for level 5 headings.")
(defface eighters-title-6 nil
  "Face for level 6 headings.")
(defface eighters-ui nil
  "Face for inalterable UI elements.")

(defmacro eighters-with-palette (&rest body)
  `(let ,eighters-palette ,@body))

(eighters-with-palette
 (custom-theme-set-faces
  'eighters
;;; Theme faces.
  `(eighters-button ((t (:background ,bg-hl-dimmer :box (:color ,bg-hl :style released-button) :inherit eighters-ui))))
  `(eighters-date ((t (:foreground ,fg-magenta))))
  `(eighters-identity ((t (:foreground ,fg-red))))
  `(eighters-markup ((t (:foreground ,fg-dim))))
  `(eighters-title-1 ((t (:foreground ,fg-cyan-subtle :weight bold :height 1.28 :inherit variable-pitch))))
  `(eighters-title-2 ((t (:foreground ,fg-green-subtle :weight bold :height 1.20 :inherit variable-pitch))))
  `(eighters-title-3 ((t (:foreground ,fg-yellow-subtle :weight bold :height 1.16 :inherit variable-pitch))))
  `(eighters-title-4 ((t (:foreground ,fg-red-subtle :weight bold :height 1.08 :inherit variable-pitch))))
  `(eighters-title-5 ((t (:foreground ,fg-magenta-subtle :weight bold :inherit variable-pitch))))
  `(eighters-title-6 ((t (:foreground ,fg-blue-subtle :slant italic :inherit variable-pitch))))
  `(eighters-ui ((t (:inherit variable-pitch))))
;;; Standard faces.
  `(ansi-color-black ((t (:foreground ,bg :background ,bg))))
  `(ansi-color-red ((t (:foreground ,fg-red :background ,bg-red-dim))))
  `(ansi-color-green ((t (:foreground ,fg-green :background ,bg-green-dim))))
  `(ansi-color-yellow ((t (:foreground ,fg-yellow :background ,bg-yellow-dim))))
  `(ansi-color-blue ((t (:foreground ,fg-blue :background ,bg-blue-dim))))
  `(ansi-color-magenta ((t (:foreground ,fg-magenta :background ,bg-magenta-dim))))
  `(ansi-color-cyan ((t (:foreground ,fg-cyan :background ,bg-cyan-dim))))
  `(ansi-color-white ((t (:foreground ,fg-dim :background ,fg-dim))))
  `(ansi-color-bright-black ((t (:foreground ,bg-hl :background ,bg-hl))))
  `(ansi-color-bright-red ((t (:foreground ,fg-red-subtle :background ,bg-red))))
  `(ansi-color-bright-green ((t (:foreground ,fg-green-subtle :background ,bg-green))))
  `(ansi-color-bright-yellow ((t (:foreground ,fg-yellow-subtle :background ,bg-yellow))))
  `(ansi-color-bright-blue ((t (:foreground ,fg-blue-subtle :background ,bg-blue))))
  `(ansi-color-bright-magenta ((t (:foreground ,fg-magenta-subtle :background ,bg-magenta))))
  `(ansi-color-bright-cyan ((t (:foreground ,fg-cyan-subtle :background ,bg-cyan))))
  `(ansi-color-bright-white ((t (:foreground ,fg :background ,fg))))
  `(button ((t (:inherit eighters-button))))
  `(compilation-column-number ((t (:inherit font-lock-constant-face))))
  `(compilation-line-number ((t (:inherit font-lock-constant-face))))
  `(compilation-mode-line-exit ((t (:inherit compilation-info))))
  `(compilation-mode-line-fail ((t (:inherit compilation-error))))
  `(compilation-mode-line-run ((t (:inherit compilation-warning))))
  `(completions-common-part ((t (:foreground ,fg-dimmer))))
  `(completions-first-difference ((t (:foreground ,fg-magenta :weight bold))))
  `(custom-button ((t (:inherit eighters-button))))
  `(custom-comment ((t (:background ,bg-hl-dim :foreground ,fg-dim))))
  `(custom-variable-tag ((t (:inherit eighters-title-3))))
  `(default ((t (:background ,bg :foreground ,fg))))
  `(dired-broken-symlink ((t (:background ,bg-red :foreground ,fg-yellow :weight bold))))
  `(dired-header ((t (:inherit eighters-title-1))))
  `(dired-special ((t (:foreground ,fg-yellow-dim))))
  `(eldoc-highlight-function-argument ((t (:background ,bg-yellow :foreground ,fg-yellow :weight bold))))
  `(error ((t :foreground ,fg-red :weight bold)))
  `(escape-glyph ((t (:foreground ,fg-red-dim))))
  `(font-lock-builtin-face ((t (:foreground ,fg-blue))))
  `(font-lock-comment-face ((t (:foreground ,fg-dim :slant italic))))
  `(font-lock-constant-face ((t (:foreground ,fg-magenta))))
  `(font-lock-doc-face ((t (:foreground ,fg-green-dim :slant italic))))
  `(font-lock-function-name-face ((t (:foreground ,fg-blue :weight bold))))
  `(font-lock-keyword-face ((t (:foreground ,fg-cyan :weight bold))))
  `(font-lock-preprocessor-face ((t (:foreground ,fg-blue))))
  `(font-lock-regexp-grouping-backslash ((t (:foreground ,fg-yellow-dim))))
  `(font-lock-regexp-grouping-construct ((t (:foreground ,fg-yellow :weight bold))))
  `(font-lock-string-face ((t (:foreground ,fg-green-dim))))
  `(font-lock-type-face ((t (:foreground ,fg-green))))
  `(font-lock-variable-name-face ((t (:foreground ,fg-yellow))))
  `(font-lock-warning-face ((t (:inherit warning))))
  `(fringe ((t (:background ,bg-hl-dimmer))))
  `(gnus-group-mail-1 ((t (:foreground ,fg-yellow :weight bold))))
  `(gnus-group-mail-1-empty ((t (:foreground ,fg-yellow-dim))))
  `(gnus-group-mail-3 ((t (:foreground ,fg-green :weight bold))))
  `(gnus-group-mail-3-empty ((t (:foreground ,fg-green-dim))))
  `(gnus-group-mail-low ((t (:foreground ,fg-dim :weight bold))))
  `(gnus-group-mail-low-empty ((t (:foreground ,fg-dimmer))))
  `(gnus-group-news-3 ((t (:foreground ,fg-magenta :weight bold))))
  `(gnus-group-news-3-empty ((t (:foreground ,fg-magenta-dim))))
  `(gnus-button ((t (:inherit link))))
  `(gnus-cite-1 ((t (:foreground ,fg-cyan-dim))))
  `(gnus-cite-2 ((t (:foreground ,fg-green-dim))))
  `(gnus-cite-3 ((t (:foreground ,fg-yellow-dim))))
  `(gnus-cite-4 ((t (:foreground ,fg-red-dim))))
  `(gnus-cite-5 ((t (:foreground ,fg-magenta-dim))))
  `(gnus-cite-6 ((t (:foreground ,fg-blue-dim))))
  `(gnus-cite-7 ((t (:foreground ,fg-cyan-dim))))
  `(gnus-cite-8 ((t (:foreground ,fg-green-dim))))
  `(gnus-cite-9 ((t (:foreground ,fg-yellow-dim))))
  `(gnus-cite-10 ((t (:foreground ,fg-red-dim))))
  `(gnus-cite-11 ((t (:foreground ,fg-magenta-dim))))
  `(gnus-header-content ((t (:inherit gnus-header))))
  `(gnus-header-from ((t (:inherit (eighters-identity gnus-header)))))
  `(gnus-header-name ((t (:foreground ,fg-green-dim :inherit gnus-header))))
  `(gnus-header-newsgroups ((t (:inherit (warning gnus-header)))))
  `(gnus-header-subject ((t (:inherit (eighters-title-1 gnus-header)))))
  `(gnus-server-closed ((t (:inherit shadow))))
  `(gnus-server-cloud ((t (:foreground ,fg-dimmer))))
  `(gnus-server-cloud-host ((t (:foreground ,fg-dim :underline t))))
  `(gnus-server-denied ((t (:inherit error))))
  `(gnus-server-offline ((t (:inherit error))))
  `(gnus-server-opened ((t (:inherit success))))
  `(gnus-signature ((t (:inherit font-lock-comment-face))))
  `(gnus-summary-cancelled ((t (:strike-through t :inherit shadow))))
  `(gnus-summary-normal-ancient ((t (:foreground ,fg-dim))))
  `(gnus-summary-normal-read ((t (:foreground ,fg-dim :slant italic))))
  `(gnus-summary-normal-ticked ((t (:foreground ,fg-yellow-dim))))
  `(gnus-summary-selected ((t (:inherit highlight))))
  `(header-line ((t (:background ,bg-hl :inherit eighters-ui))))
  `(help-key-binding ((t (:background ,bg-hl-dimmer :foreground ,fg-magenta :inherit fixed-pitch-serif))))
  `(highlight ((t (:background ,bg-hl-dim))))
  `(info-title-1 ((t (:inherit eighters-title-1))))
  `(info-title-2 ((t (:inherit eighters-title-2))))
  `(info-title-3 ((t (:inherit eighters-title-3))))
  `(info-title-4 ((t (:inherit eighters-title-4))))
  `(isearch ((t (:background ,bg-red :foreground ,fg-magenta :inverse-video t))))
  `(isearch-fail ((t (:background ,bg-red :weight bold))))
  `(isearch-group-1 ((t (:background ,bg-red :foreground ,fg-blue :inverse-video t))))
  `(isearch-group-2 ((t (:background ,bg-red :foreground ,fg-cyan :inverse-video t))))
  `(lazy-highlight ((t (:background ,bg-cyan))))
  `(link ((t (:foreground ,fg-blue :underline t))))
  `(link-visited ((t (:foreground ,fg-magenta-dim :underline t))))
  `(Man-overstrike ((t (:foreground ,fg-cyan :inherit bold))))
  `(match ((t (:background ,bg-blue))))
  `(minibuffer-prompt ((t (:background ,bg-blue :foreground ,fg-blue-subtle :weight bold))))
  `(mode-line ((t (:background ,bg-hl :box (:color ,fg) :inherit eighters-ui))))
  `(mode-line-inactive ((t (:background ,bg-hl-dimmer :foreground ,fg-dimmer :box (:color ,bg-hl-dimmer) :inherit eighters-ui))))
  `(outline-1 ((t (:inherit eighters-title-1))))
  `(outline-2 ((t (:inherit eighters-title-2))))
  `(outline-3 ((t (:inherit eighters-title-3))))
  `(outline-4 ((t (:inherit eighters-title-4))))
  `(outline-5 ((t (:inherit eighters-title-5))))
  `(outline-6 ((t (:inherit eighters-title-6))))
  `(region ((t (:background ,bg-blue-dim))))
  `(separator-line ((t (:background ,bg-hl :height 0.1))))
  `(shadow ((t (:foreground ,fg-dimmer))))
  `(show-paren-match ((t (:foreground ,fg-cyan :inverse-video t))))
  `(success ((t (:foreground ,fg-blue :weight bold))))
  `(tab-bar ((t (:background ,bg-hl-dimmer :inherit eighters-ui))))
  `(tab-bar-tab ((t (:weight bold :box (:style released-button) :inherit tab-bar))))
  `(tab-bar-tab-inactive ((t (:foreground ,fg-dimmer :weight normal :box (:style pressed-button) :inherit tab-bar-tab))))
  `(tab-line ((t (:inherit tab-bar :height 0.9))))
  `(tab-line-tab-current ((t (:inherit (tab-line-tab tab-bar-tab)))))
  `(tab-line-tab-inactive ((t (:inherit (tab-line-tab tab-bar-tab-inactive)))))
  `(transient-argument ((t :weight bold :inherit font-lock-string-face)))
  `(transient-key ((t :inherit help-key-binding)))
  `(transient-unreachable-key ((t :inherit (shadow help-key-binding))))
  `(vertical-border ((t (:foreground ,bg-hl))))
  `(warning ((t (:foreground ,fg-yellow :weight bold))))
  `(widget-field ((t (:background ,bg-hl-dim))))
;;;; Diff faces.
  `(diff-header ((t (:background ,bg-hl-dimmer :foreground ,fg-dim))))
  `(diff-file-header ((t (:background ,bg-hl-dimmer :foreground ,fg :weight bold))))
  `(diff-hunk-header ((t (:background ,bg-hl-dim :foreground ,fg-dim))))
  `(diff-function ((t (:background ,bg-hl-dim :weight bold))))
  `(diff-context ((t :foreground ,fg-dim)))
  `(diff-removed ((t (:background ,bg-red-dimmer))))
  `(diff-refine-removed ((t (:background ,bg-red))))
  `(diff-indicator-removed ((t (:foreground ,fg-red :inherit diff-removed))))
  `(diff-added ((t :background ,bg-blue-dimmer)))
  `(diff-refine-added ((t (:background ,bg-blue))))
  `(diff-indicator-added ((t (:foreground ,fg-blue :inherit diff-added))))
  `(diff-changed ((t :background ,bg-yellow-dimmer)))
  `(diff-refine-changed ((t (:background ,bg-yellow))))
  `(diff-indicator-changed ((t (:foreground ,fg-yellow :inherit diff-changed))))
  `(ediff-even-diff-A ((t (:background ,bg-hl-dimmer))))
  `(ediff-even-diff-B ((t (:background ,bg-hl-dimmer))))
  `(ediff-even-diff-C ((t (:background ,bg-hl-dimmer))))
  `(ediff-even-diff-Ancestor ((t (:background ,bg-hl-dimmer))))
  `(ediff-odd-diff-A ((t (:background ,bg-hl-dimmer))))
  `(ediff-odd-diff-B ((t (:background ,bg-hl-dimmer))))
  `(ediff-odd-diff-C ((t (:background ,bg-hl-dimmer))))
  `(ediff-odd-diff-Ancestor ((t (:background ,bg-hl-dimmer))))
  `(ediff-current-diff-A ((t (:inherit diff-removed))))
  `(ediff-current-diff-B ((t (:inherit diff-added))))
  `(ediff-current-diff-C ((t (:inherit diff-changed))))
  `(ediff-current-diff-Ancestor ((t (:background ,bg-magenta-dimmer))))
  `(ediff-fine-diff-A ((t (:inherit diff-refine-removed))))
  `(ediff-fine-diff-B ((t (:inherit diff-refine-added))))
  `(ediff-fine-diff-C ((t (:inherit diff-refine-changed))))
  `(ediff-fine-diff-Ancestor ((t (:background ,bg-magenta))))
  `(smerge-markers ((t (:background ,bg-hl-dim :foreground ,fg-dim))))
  `(smerge-base ((t (:background ,bg-yellow-dim))))
  `(smerge-refined-changed ((t (:inherit diff-refine-changed))))
  `(smerge-upper ((t (:background ,bg-red-dim))))
  `(smerge-refined-removed ((t (:inherit diff-refine-removed))))
  `(smerge-lower ((t (:background ,bg-blue-dim))))
  `(smerge-refined-added ((t (:inherit diff-refine-added))))
;;; Third-party faces.
  `(diff-hl-delete ((t (:foreground ,fg-red :background ,bg-red))))
  `(diff-hl-insert ((t (:foreground ,fg-blue :background ,bg-blue))))
  `(diff-hl-change ((t (:foreground ,fg-yellow :background ,bg-yellow))))
  `(which-key-group-description-face ((t (:foreground ,fg-green-dim))))
  `(which-key-key-face ((t :weight bold :inherit help-key-binding)))
;;;; Magit.
  `(magit-blame-highlight ((t (:foreground ,fg-dim :background ,bg-yellow-dimmer))))
  `(magit-branch-current ((t (:inverse-video t :inherit magit-branch-local))))
  `(magit-branch-local ((t (:foreground ,fg-blue))))
  `(magit-branch-remote ((t (:foreground ,fg-green-dim))))
  `(magit-branch-remote-head ((t (:inverse-video t :inherit magit-branch-remote))))
  `(magit-log-date ((t (:inherit eighters-date))))
  `(magit-hash ((t (:inherit shadow))))
  `(magit-log-author ((t (:inherit eighters-identity))))
  `(magit-log-graph ((t (:inherit eighters-markup))))
  ;; FIXME: Teach magit-section overlays to de-prioritize their
  ;; :background so that tags can have one.
  `(magit-tag ((t (:foreground ,fg-yellow))))
;;;;; Section backgrounds.
  `(magit-section-highlight ((t :background ,bg-hl-dimmer)))
  `(magit-diff-revision-summary ((t (:inherit (magit-diff-hunk-heading eighters-title-1)))))
  `(magit-section-heading ((t (:inherit eighters-title-2))))
  `(magit-diff-file-heading ((t (:inherit eighters-title-3))))
  `(magit-diff-context ((t (:foreground ,fg-dim))))
  `(magit-diff-context-highlight ((t (:background ,bg-hl-dimmer :inherit magit-diff-context))))
  `(magit-diff-hunk-heading ((t (:background ,bg-hl-dim))))
  `(magit-diff-hunk-heading-highlight ((t (:background ,bg-hl))))
;;;;; Diffs.
  `(magit-diff-removed ((t (:foreground ,fg-dim :inherit diff-removed))))
  `(magit-diff-removed-highlight ((t (:background ,bg-red-dim))))
  `(magit-diffstat-removed ((t (:foreground ,fg-red))))
  `(magit-diff-added ((t (:foreground ,fg-dim :inherit diff-added))))
  `(magit-diff-added-highlight ((t (:background ,bg-blue-dim))))
  `(magit-diffstat-added ((t (:foreground ,fg-blue))))))

(provide-theme 'eighters)