C2AK6BRZ7C4GYAJBHJRSV67536KRP6QC2IJN5OENKFFKPXCNTARAC
75RX3KYW357L7ZWHEFLCRPQHEGKDVDTVV2CH2KF2MTJ7C2AWVAKAC
RXCY7LD6ZRIOIKZEYKLMCYPMQPXF4DOEEFBDLVR2B22BXLZJFFBQC
A3TVGLVHSVLMEHLHB3TPBSD3QGNVGX3DIK6BEBDTTHWBNW4ALMRAC
FBPIMKS4AZESEN23F6TEBISAMAIFAF2TC6Y2VPYR43N724TWKZSQC
5PUTZ65VCZROT54SY5B4SZM47G5C4M5MFTS6NVBLEOXBNU4UXU2QC
DMVROIKLOEHSWE4XDJ66XZH3RSHJ3KL3ORDIYI5D36N6BZ2QJK4QC
DBSX7XQAQNMMA3TRSOKXUEVK2JMASWMCJOZRLDPLY3RJR7JW44KAC
PRE42LRLBF7CR3L7ERIPSQJJTDAQQ4UJ2H5KOHSVX7TL4STJXYNAC
IFMEYLI2GEQAFSL3RRLJHY4M6QBTP2STE3PYA5RGDIC7FNGGEHJQC
LJFHLCOLK632EAP4SOFHWIWXW4N2QPNESQT7ZGO3BGU5MDUVYN6QC
EY6TDTQF76OHSGWR572JUJP2DENLLKJ7TWM5VVIBOXWTPJ6B6MMAC
#+(or)
(defun round-lab-coordinates (L a b)
(declare (optimize (speed 3)))
(flet ((round-3 (n)
(declare (type double-float n)
(optimize (speed 3)
(safety 0)))
(* (fround (* n 1000d0))
0.001d0)))
(declare (ftype (function (double-float) double-float) round-3)
(inline round-3))
(macrolet ((num-dispatch (exp)
(alexandria:once-only (exp)
`(typecase ,exp
(double-float ,exp)
(single-float (coerce ,exp 'double-float))
(number (coerce ,exp 'double-float))))))
(values (round-3 (num-dispatch L))
(round-3 (num-dispatch a))
(round-3 (num-dispatch b))))))
(defun xyz-to-oklab (x y z)
(declare (optimize (speed 3)))
(flet ((cube-root (n)
(* 1d0
(signum n)
(expt (abs n) #.(coerce 1/3 'double-float)))))
(declare (inline cube-root))
(let ((m1 #.(make-array '(3 3)
:element-type 'double-float
:initial-contents
'((0.8189330101d0 0.3618667424d0 -0.1288597137d0)
(0.0329845436d0 0.9293118715d0 0.0361456387d0)
(0.0482003018d0 0.2643662691d0 0.6338517070d0))))
(m2 #.(make-array '(3 3)
:element-type 'double-float
:initial-contents
'((+0.2104542553d0 +0.7936177850d0 -0.0040720468d0)
(+1.9779984951d0 -2.4285922050d0 +0.4505937099d0)
(+0.0259040371d0 +0.7827717662d0 -0.8086757660d0)))))
(multiple-value-call #'dufy/internal:multiply-mat-vec m2
(multiple-value-call
(lambda (l m s)
(values (cube-root l)
(cube-root m)
(cube-root s)))
(dufy/internal:multiply-mat-vec m1 x y z))))))
(defun oklab-to-xyz (L a b)
(declare (optimize (speed 3)))
(let ((m1 (load-time-value
(dufy/internal:invert-matrix
#.(make-array '(3 3)
:element-type 'double-float
:initial-contents
'((0.8189330101d0 0.3618667424d0 -0.1288597137d0)
(0.0329845436d0 0.9293118715d0 0.0361456387d0)
(0.0482003018d0 0.2643662691d0 0.6338517070d0))))))
(m2 (load-time-value
(dufy/internal:invert-matrix
#.(make-array '(3 3)
:element-type 'double-float
:initial-contents
'((+0.2104542553d0 +0.7936177850d0 -0.0040720468d0)
(+1.9779984951d0 -2.4285922050d0 +0.4505937099d0)
(+0.0259040371d0 +0.7827717662d0 -0.8086757660d0)))))))
(multiple-value-call #'dufy/internal:multiply-mat-vec
m1
(multiple-value-call
(lambda (l m s)
(values (expt l 3)
(expt m 3)
(expt s 3)))
(dufy/internal:multiply-mat-vec m2 L a b)))))
(unless (null s)
(format s "~%")))))))
(defun oklab-color (name &optional (s t))
(let ((values (theme-color name)))
(destructuring-bind (r g b) values
(multiple-value-bind (l a b) (multiple-value-call #'xyz-to-oklab
(dufy:qrgb-to-xyz r g b))
(prog1 (format s
"oklab(~,3f% ~,3f ~,3f)"
(* 100.0 l) a b)
(unless (null s)
(format s "~%")))))))
(defun cielab-color (name &optional (s t))
(let ((values (theme-color name)))
(destructuring-bind (r g b) values
(multiple-value-bind (l a b) (multiple-value-call #'dufy:xyz-to-lab
(dufy:qrgb-to-xyz r g b))
(prog1 (format s
"lab(~,3f% ~,3f ~,3f)"
l a b)
:description "Show COLOR as an CSS RGB literal")))
:description "Show COLOR as an CSS RGB literal")
(enum :long-name "oklab" :enum (mapcar 'car *color-alist*)
:description "Show COLOR as an CSS oklab literal")
(enum :long-name "cielab" :enum (mapcar 'car *color-alist*)
:description "Show COLOR as an CSS lab literal")))
;;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; Package: ASDF-USER -*-
(in-package :asdf-user)
(defsystem :tools/zenburn
:description "Tool for generating colored text"
:author "Ed L <el-l@elangley.org>"
:license "MIT"
:depends-on (#:alexandria
#:uiop
#:serapeum
#:net.didierverna.clon
#:alexandria
#:dufy)
:serial t
:components ((:file "zenburn")))
;;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; Package: ASDF-USER -*-
(in-package :asdf-user)
(defsystem :tools/zenburn
:description "Tool for generating colored text"
:author "Ed L <el-l@elangley.org>"
:license "MIT"
:depends-on (#:alexandria
#:uiop
#:serapeum
#:net.didierverna.clon
#:alexandria
#:dufy)
:serial t
:components ((:file "zenburn")))