;;; melanosis-theme.el --- Ouroboros daylight theme with opalescent, pastel colors -*- lexical-binding:t

;;; Commentary:
;; This is a high contrast theme.

;;; Code:

(require 'subr-x)

;;; Helper functions for modifying colors
(defun darken (hexcode %-lighter)
  "Darken a hex code by a given %"
  (let* ((code (string-remove-prefix "#" hexcode))
	 (r-val (string-to-number (substring code 0 2) 16))
	 (g-val (string-to-number (substring code 2 4) 16))
	 (b-val (string-to-number (substring code 4 6) 16))
	 (new-r (max 0 (round (- r-val (* r-val %-lighter)))))
	 (new-g (max 0 (round (- g-val (* g-val %-lighter)))))
	 (new-b (max 0 (round (- b-val (* b-val %-lighter))))))
    (format "#%x%x%x" new-r new-g new-b)))

(defun lighten (hexcode %-lighter)
  "Lighten a hex code by a given %"
  (let* ((code (string-remove-prefix "#" hexcode))
	 (r-val (string-to-number (substring code 0 2) 16))
	 (g-val (string-to-number (substring code 2 4) 16))
	 (b-val (string-to-number (substring code 4 6) 16))
	 (new-r (min 255 (round (+ r-val (* r-val %-lighter)))))
	 (new-g (min 255 (round (+ g-val (* g-val %-lighter)))))
	 (new-b (min 255 (round (+ b-val (* b-val %-lighter))))))
    (format "#%x%x%x" new-r new-g new-b)))

;;; Custom faces
(defface fixed-pitch-scrawled '() "Fixed pitch face for scrawled text." :group 'basic-faces)

(defface variable-pitch-serif '() "Variable pitch serif face." :group 'basic-faces)
(defface variable-pitch-serif-text '() "Slightly larger variable pitch serif face." :group 'basic-faces)

;;; Theme definition
(deftheme melanosis
  "Daylight theme from Ouroboros - opalescent, pastel colours on an off-white background."
  :background-mode 'dark
  :contrast 'high)

;; Color palette and settings
(let (
      ;; Fonts
      (fixed-pitch-font "Monaspace Argon Frozen")
      (fixed-pitch-alternative "Monaspace Radon Frozen ")
      (fixed-pitch-serif "Monaspace Xenon Frozen")
      (sans-serif-font "Ysabeau")
      (serif-font "Crimson Pro")
      
      ;; Default, standard colors
      (bg-main "#0b1012")
      (fg-main "#f3f5ff")
      
      ;; Accent colors
      (accent-one "#788bff")
      (accent-two "#bba0ca")
      (accent-three "#ea85ed")
      (accent-four "#eaf293")
      (accent-five "#f29395")

      ;; Extra saturated accents
      (accent-one-saturated "#7a8cff")
      (accent-two-saturated "#c483e8")
      (accent-three-saturated "#f37df7")
      (accent-four-saturated "#f1fb89")
      (accent-five-saturated "#f98a8c")

      ;; Desaturated accents
      (accent-one-desaturated "#9ea6dc")
      (accent-two-desaturated "#b8abbf")
      (accent-three-desaturated "#d0a2d2")
      (accent-four-desaturated "#dfe59f")
      (accent-five-desaturated "#d9abac")
      )
  
  (custom-theme-set-faces
   'melanosis
;;; Standard Text Faces
   ;; Default
   `(default ((t (:foreground ,fg-main :background ,bg-main :family ,fixed-pitch-font :weight semibold :height 98 :width semiexpanded))))
   ;; Fixed pitch - the default fixed pitch setting here is Monaspace Radon, which can be used for comments
   ;; Fixed pitch serif - Monaspace Xenon
   `(fixed-pitch ((t (:foreground ,fg-main :background ,bg-main :family ,fixed-pitch-font :weight semibold :height 98 :width semiexpanded))))
   `(fixed-pitch-scrawled ((t (:inheirt default :family ,fixed-pitch-alternative))))
   `(fixed-pitch-serif ((t (:inherit default :family ,fixed-pitch-serif))))
   ;; Variable pitch fonts - the default is sans serif Ysabeau, but we provide another face for serif fonts
   `(variable-pitch ((t (:inherit default :family ,sans-serif-font :height 118))))
   `(variable-pitch-text ((t (:inherit variable-pitch :height 138))))
   `(variable-pitch-serif ((t (:inherit default :family ,serif-font :height 118))))
   `(variable-pitch-serif-text ((t (:inherit variable-pitch-serif :height 138))))
   ;; Shadow is just a darkened foreground
   `(shadow ((t (:inherit default :foreground ,(darken fg-main 0.3)))))

;;; Highlighting
   `(highlight ((t (:background ,(darken accent-two-desaturated 0.3) :foreground ,(lighten bg-main 0.4)))))
   `(region ((t (:extend t :background ,(darken accent-one-desaturated 0.3) :foreground ,fg-main))))
   `(secondary-selection ((t (:inherit region :background ,(darken accent-five-desaturated 0.3) :foreground ,fg-main))))
   ;; trailing-whitespace
   ;; escape-glyph
   ;; homoglyph
   ;; nobreak-space
   ;; nobreak-hyphen
   ;; isearch highlights
   `(isearch ((t (:background ,accent-three :foreground ,bg-main))))
   `(query-replace ((t (:inherit isearch :slant italic))))
   `(lazy-highlight ((t (:inherit isearch :background ,accent-five-desaturated))))

;;; Frame Appearance
   `(cursor ((t (:background ,fg-main))))
   `(fringe ((t (:background ,bg-main))))
   ;; mouse
   ;; tooltip
   `(minibuffer-prompt ((t (:inherit default :foreground ,accent-two-saturated))))
   `(vertical-border ((t (:foreground ,accent-one-saturated))))
   ;;; Mode line and telephone
   `(mode-line ((t (:background ,(lighten bg-main 1.5) :foreground ,accent-one :box (:line-width (1 . -1) :color ,accent-one-saturated)))))
   `(telephone-line-accent-active ((t (:inherit mode-line :background ,(lighten bg-main 2.5) :foreground ,accent-three))))
   `(mode-line-inactive ((t (:weight light :foreground ,accent-one-desaturated :background ,(lighten bg-main 1.2)))))
   `(telephone-line-accent-inactive ((t (:inherit mode-line :background ,(lighten bg-main 1.8) :foreground ,accent-three-desaturated :box nil))))
   '(mode-line-buffer-id ((t (:weight bold))))
   '(mode-line-emphasis ((t (:weight bold))))
   `(mode-line-highlight ((t (:background ,accent-one-desaturated :box (:line-width (2 . 2) :color ,bg-main :style released-button)))))
   `(mode-line-buffer-id ((t (:foreground ,accent-four-saturated))))
   `(header-line ((t (:inherit mode-line))))
   `(tab-line ((t (:inherit mode-line))))
   ;; scroll-bar
   ;; tool-bar
   ;; tab-bar
   `(tab-bar ((t (:inherit mode-line :background ,(lighten bg-main 0.8) :box nil))))
   `(tab-bar-tab ((t (:inherit mode-line))))
   `(tab-bar-tab-inactive ((t (:inherit mode-line-inactive :box nil))))
   ;; menu
   ;; tty-menu-enabled, disabled, selected-face

;;; Font lock faces
   '(font-lock-bracket-face ((t (:inherit font-lock-punctuation-face))))
   `(font-lock-builtin-face ((t (:foreground ,accent-two :weight bold))))
   '(font-lock-comment-delimiter-face ((t (:inherit font-lock-comment-face))))
   `(font-lock-comment-face ((t (:foreground ,(darken accent-one-desaturated 0.3) :family ,fixed-pitch-alternative :slant italic))))
   `(font-lock-constant-face ((t (:foreground ,accent-three :weight bold))))
   '(font-lock-delimiter-face ((t (:inherit font-lock-punctuation-face))))
   '(font-lock-doc-face ((t (:inherit font-lock-string-face))))
   '(font-lock-doc-markup-face ((t (:inherit font-lock-constant-face))))
   '(font-lock-escape-face ((t (:inherit font-lock-regexp-grouping-backslash))))
   '(font-lock-function-call-face ((t (:inherit font-lock-function-name-face))))
   `(font-lock-function-name-face ((t (:foreground ,accent-one :slant italic))))
   `(font-lock-keyword-face ((t (:foreground ,accent-two-saturated))))
   '(font-lock-negation-char-face ((t nil)))
   '(font-lock-number-face ((t nil)))
   '(font-lock-misc-punctuation-face ((t (:inherit font-lock-punctuation-face))))
   '(font-lock-operator-face ((t nil)))
   '(font-lock-preprocessor-face ((t (:inherit font-lock-builtin-face))))
   '(font-lock-property-name-face ((t (:inherit font-lock-variable-name-face))))
   '(font-lock-property-use-face ((t (:inherit font-lock-property-name-face))))
   '(font-lock-punctuation-face ((t nil)))
   '(font-lock-regexp-grouping-backslash ((t (:inherit bold))))
   '(font-lock-regexp-grouping-construct ((t (:inherit bold))))
   `(font-lock-string-face ((t (:foreground ,(lighten accent-five 0.3)))))
   `(font-lock-type-face ((t (:foreground ,accent-two))))
   `(font-lock-variable-name-face ((t (:foreground ,(lighten accent-one 0.3)))))
   '(font-lock-variable-use-face ((t (:inherit font-lock-variable-name-face))))
   '(font-lock-warning-face ((t (:inherit error))))
   `(error ((t (:foreground ,accent-five-saturated :weight black))))

   ;;; Rainbow delimiters
   `(rainbow-delimiters-depth-1-face ((t (:foreground ,accent-two-saturated :inherit rainbow-delimiters-base-face))))
   `(rainbow-delimiters-depth-2-face ((t (:foreground ,accent-four-saturated  :inherit rainbow-delimiters-base-face))))
   `(rainbow-delimiters-depth-3-face ((t (:foreground ,accent-one-saturated  :inherit rainbow-delimiters-base-face))))
   `(rainbow-delimiters-depth-4-face ((t (:foreground ,accent-three-saturated  :inherit rainbow-delimiters-base-face))))
   `(rainbow-delimiters-depth-5-face ((t (:foreground ,accent-five  :inherit rainbow-delimiters-base-face))))
   `(rainbow-delimiters-depth-6-face ((t (:foreground ,accent-two :inherit rainbow-delimiters-base-face))))
   `(rainbow-delimiters-depth-7-face ((t (:foreground ,accent-four :inherit rainbow-delimiters-base-face))))
   `(rainbow-delimiters-depth-8-face ((t (:foreground ,accent-one :inherit rainbow-delimiters-base-face))))
   `(rainbow-delimiters-depth-9-face ((t (:foreground ,accent-three :inherit rainbow-delimiters-base-face))))
   `(rainbow-delimiters-base-error-face ((t (:foreground ,accent-five-saturated :inherit rainbow-delimiters-base-face :weight black))))

   ;;; Treemacs
   `(treemacs-directory-face ((t (:inherit font-lock-function-name-face :foreground ,(lighten accent-one 0.2)))))
   `(treemacs-root-face ((t (:underline t :weight bold :height 1.4 :family ,fixed-pitch-serif :foreground ,(lighten accent-three 0.4)))))

   ;;; Magit
   `(magit-diff-added ((t (:background ,(darken accent-three 0.25) :foreground ,(lighten accent-three-saturated 0.5)))))
   `(magit-diff-removed ((t (:background ,(darken accent-five 0.25) :foreground ,(lighten accent-five-saturated 0.5)))))
   `(magit-diff-context-highlight ((t (:inherit default :extend t :background ,(darken bg-main 0.05) :foreground ,(darken fg-main 0.2)))))
   `(magit-section-highlight ((t (:extend t :background ,(lighten bg-main 1.3)))))
   `(magit-section-heading ((t (:extend t :background ,(lighten bg-main 0.05) :foreground ,(lighten accent-four-saturated 0.1) :weight bold))))

;;; Org mode and org modern
   `(org-document-title ((t (:inherit variable-pitch-serif-text :height 1.6))))
   `(org-document-info ((t (:inherit variable-pitch-serif-text :height 0.9 :foreground ,(lighten accent-one 0.3)))))
   `(org-document-info-keyword ((t (:inherit variable-pitch-text :foreground ,accent-two-desaturated))))
   ;; Outline faces
   `(outline-1 ((t (:inherit variable-pitch-serif :height 1.3 :foreground ,(lighten accent-one-desaturated 0.3)))))
   `(outline-2 ((t (:inherit variable-pitch-serif :height 1.2 :foreground ,(lighten accent-two-desaturated 0.3)))))
   `(outline-3 ((t (:inherit variable-pitch-serif :height 1.1 :foreground ,(lighten accent-three-desaturated 0.3)))))
   `(outline-4 ((t (:inherit variable-pitch-serif :height 1.0 :foreground ,(lighten accent-four-desaturated 0.3)))))
   `(outline-5 ((t (:inherit variable-pitch-serif :height 0.9 :foreground ,(lighten accent-five-desaturated 0.3)))))
   `(outline-6 ((t (:inherit variable-pitch-serif :height 0.8 :foreground ,(lighten accent-one-desaturated 0.6)))))
   `(outline-7 ((t (:inherit variable-pitch-serif :height 0.7 :foreground ,(lighten accent-two-desaturated 0.6)))))
   `(outline-8 ((t (:inherit variable-pitch-serif :height 0.6 :foreground ,(lighten accent-three-desaturated 0.6)))))
   ;; Todos and Labels
   `(org-todo ((t (:inherit variable-pitch :weight bold :foreground ,(lighten accent-five-saturated 0.1)))))
   `(org-done ((t (:inherit variable-pitch :weight bold :background ,(lighten accent-three-saturated 0.1) :foreground ,bg-main))))
   `(org-modern-done ((t (:inherit org-done))))
   `(org-modern-tag ((t (:extend t :foreground ,bg-main :background ,accent-two))))
   ;; Drawers and blocks
   `(org-drawer ((t (:inherit fixed-pitch-serif :height 0.6 :foreground ,(lighten accent-two-desaturated 0.2)))))
   `(org-special-keyword ((t (:inherit fixed-pitch-serif :height 0.6 :foreground ,(lighten accent-two 0.2)))))
   `(org-property-value ((t (:inherit default :height 0.6 :foreground ,(lighten accent-two-desaturated 0.2)))))
   `(org-block-begin-line ((t (:family ,fixed-pitch-serif :height 0.8 :foreground ,(lighten accent-one-desaturated 0.2)))))
   `(org-meta-line ((t (:inheirt org-block-begin-line))))
   `(org-block ((t (:inherit fixed-pitch))))
   ;; Code and literal
   `(org-code ((t (:family ,fixed-pitch-font :weight semibold :height 0.8 :foreground ,(darken fg-main 0.5)))))
   `(org-verbatim ((t (:family ,fixed-pitch-font :weight semibold :foreground ,(lighten accent-two-saturated 0.2)))))
   ;; Indentation
   `(org-indent ((t (:inherit (org-hide fixed-pitch)))))
   ;; Tables
   `(org-table ((t (:inherit fixed-pitch :foreground ,(darken fg-main 0.1)))))

   ;;; Company Mode
   `(company-tooltip ((t (:inherit fixed-pitch :background ,(darken accent-one 0.5) :foreground ,fg-main))))
   `(company-tooltip-common ((t (:foreground ,(lighten accent-three 0.2)))))

   ;;; Corfu
   `(corfu-default ((t (:inherit company-tooltip))))
   `(corfu-current ((t (:inherit company-tooltip-common))))
   `(corfu-border ((t (:background ,fg-main))))
   `(corfu-bar ((t (:background ,(lighten bg-main 1.5)))))
   
;;; HL-todo
   `(hl-todo ((t (:inherit default :background ,(lighten accent-four-desaturated 0.2) :foreground ,(darken fg-main 0.3)))))
   )

  (custom-theme-set-variables
   'melanosis
   '(icon-preference '(symbol image emoji text))
   `(beacon-color ,accent-two)
   '(org-hidden-keywords t)
   '(company-format-margin-function #'company-text-icons-margin))

  (provide-theme 'melanosis))

;;; melanosis-theme.el ends here
