[elpa] externals/engrave-faces 4e6026e 21/36: New backend: ANSI

[ELPA Syncer]

branch: externals/engrave-faces
commit 4e6026e1e8ef4e785ed57c72db4961248b4ad08f
Author: TEC <tec@tecosaur.com>
Commit: TEC <tec@tecosaur.com>

    New backend: ANSI
---
 README.org            |   2 +-
 engrave-faces-ansi.el | 167 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 168 insertions(+), 1 deletion(-)

diff --git a/README.org b/README.org
index d4c1428..7c8f771 100644
--- a/README.org
+++ b/README.org
@@ -20,4 +20,4 @@ I fully expect some important items to have been forgotten.
 *Included backends*
 - [X] LaTeX
 - [ ] HTML
-- [ ] ANSI
+- [X] ANSI
diff --git a/engrave-faces-ansi.el b/engrave-faces-ansi.el
new file mode 100644
index 0000000..4663256
--- /dev/null
+++ b/engrave-faces-ansi.el
@@ -0,0 +1,167 @@
+;;; engrave-faces-ansi.el --- Support for engraving buffers to LaTeX -*- 
lexical-binding: t; -*-
+
+;; This file is part of engrave-faces.
+;; SPDX-License-Identifier: GPL-3.0-or-later
+
+;;; Commentary:
+
+;; Support for engraving buffers to LaTeX.
+
+;;; Code:
+
+(require 'engrave-faces)
+
+(defcustom engrave-faces-ansi-color-mode '8-bit
+  "The ansi escape mode set to use.
+This accepts both n-bit and m-color forms.
+Possible values are:
+- `3-bit'  (`8-color')
+- `4-bit'  (`16-color')
+- `8-bit'  (`256-color')
+- `24-bit' (`16m-color')"
+  :type '(choice
+          (const 3-bit)
+          (const 4-bit)
+          (const 8-bit)
+          (const 24-bit))
+  :group 'engrave-faces)
+
+(defcustom engrave-faces-ansi-use-face-colours t
+  "Whether to apply face colours"
+  :group 'engrave-faces)
+
+(defvar engrave-faces-ansi-face-nesting nil)
+
+(defun engrave-faces-ansi-code (attrs)
+  "Genrerate ANSI commands which apply ATTRS to the succeeding text."
+  (concat
+   (when (member (plist-get attrs :weight) '(bold extra-bold)) "\uE000[1m")
+   (when (eq 'italic (plist-get attrs :slant)) "\uE000[3m")
+   (when (eq t (plist-get attrs :underline)) "\uE000[4m")
+   (when (and engrave-faces-ansi-use-face-colours
+              (plist-get attrs :foreground))
+     (engrave-faces-ansi-color-to-ansi
+      (plist-get attrs :foreground)))
+   (when (and engrave-faces-ansi-use-face-colours
+              (plist-get attrs :background))
+     (engrave-faces-ansi-color-to-ansi
+      (plist-get attrs :background) t))))
+
+;;;;; Color conversion
+
+(defun engrave-faces-ansi-color-to-ansi (color &optional background)
+  (if (eq color 'unspecified) nil
+    (apply (pcase engrave-faces-ansi-color-mode
+             ((or '3-bit '8-color) #'engrave-faces-ansi-color-3bit-code)
+             ((or '4-bit '16-color) #'engrave-faces-ansi-color-4bit-code)
+             ((or '8-bit '256-color) #'engrave-faces-ansi-color-8bit-code)
+             ((or '24-bit '16m-color) #'engrave-faces-ansi-color-24bit-code))
+           (append (mapcar (lambda (c) (/ c 257)) (color-values color)) (list 
background)))))
+
+(defun engrave-faces-ansi-color-dist-squared (reference rgb)
+  "Squared L2 distance between a REFERENCE and RBG values, each a list of 3 
values (r g b)."
+  (+ (* (nth 0 reference)
+        (nth 0 rgb))
+     (* (nth 1 reference)
+        (nth 1 rgb))
+     (* (nth 2 reference)
+        (nth 2 rgb))))
+
+;;;;;; 3-bit / 8-color
+
+(defun engrave-faces-ansi-color-3bit-code (r g b &optional background)
+  "Convert the (R G B) colour code to a correspanding 4bit ansi escape 
sequence."
+  (format "\uE000[%sm"
+          (% (pcase (nth (engrave-faces-ansi-color-rbg-to-256 r g b)
+                         engrave-faces-ansi-256-to-16-map)) 8)))
+
+;;;;;; 4-bit / 16-color
+
+(defvar engrave-faces-ansi-256-to-16-map
+  '(0   1  2  3  4  5  6  7  8  9 10 11 12 13 14 15
+        0   4  4  4 12 12  2  6  4  4 12 12  2  2  6  4
+        12 12  2  2  2  6 12 12 10 10 10 10 14 12 10 10
+        10 10 10 14  1  5  4  4 12 12  3  8  4  4 12 12
+        2   2  6  4 12 12  2  2  2  6 12 12 10 10 10 10
+        14 12 10 10 10 10 10 14  1  1  5  4 12 12  1  1
+        5   4 12 12  3  3  8  4 12 12  2  2  2  6 12 12
+        10 10 10 10 14 12 10 10 10 10 10 14  1  1  1  5
+        12 12  1  1  1  5 12 12  1  1  1  5 12 12  3  3
+        3   7 12 12 10 10 10 10 14 12 10 10 10 10 10 14
+        9   9  9  9 13 12  9  9  9  9 13 12  9  9  9  9
+        13 12  9  9  9  9 13 12 11 11 11 11  7 12 10 10
+        10 10 10 14  9  9  9  9  9 13  9  9  9  9  9 13
+        9   9  9  9  9 13  9  9  9  9  9 13  9  9  9  9
+        9  13 11 11 11 11 11 15  0  0  0  0  0  0  8  8
+        8   8  8  8  7  7  7  7  7  7 15 15 15 15 15 15))
+
+(defun engrave-faces-ansi-color-4bit-code (r g b &optional background)
+  "Convert the (R G B) colour code to a correspanding 4bit ansi escape 
sequence."
+  (format "\uE000[%sm"
+          (pcase (nth (engrave-faces-ansi-color-rbg-to-256 r g b)
+                      engrave-faces-ansi-256-to-16-map)
+            ((and (pred (> 8)) n)
+             (+ 30 (if background 10 0) n))
+            (n
+             (format "1;%d" (+ 22 (if background 10 0) n))))))
+
+;;;;;; 8-bit / 256-color
+
+(defvar engrave-faces-ansi-color-6cube-values '(0 95 135 175 215 255))
+(defun engrave-faces-ansi-color-to-6cube (value)
+  "Map VALUE to the associated 6x6 colour cube value."
+  (pcase value
+    ((pred (> 48)) 0)
+    ((pred (> 114)) 1)
+    (_ (/ (- value 35) 40))))
+
+(defun engrave-faces-ansi-color-8bit-code (r g b &optional background)
+  "Convert the (R G B) colour code to a correspanding 8bit ansi escape 
sequence."
+  (format (if background "\uE000[48;5;%dm" "\uE000[38;5;%dm")
+          (engrave-faces-ansi-color-rbg-to-256 r g b)))
+
+(defun engrave-faces-ansi-color-rbg-to-256 (r g b &optional background)
+  "Convert the (R G B) colour code to the nearest 256-colour."
+  (let ((6cube-r (engrave-faces-ansi-color-to-6cube r))
+        (6cube-g (engrave-faces-ansi-color-to-6cube g))
+        (6cube-b (engrave-faces-ansi-color-to-6cube b)))
+    (let ((nearest-r (nth 6cube-r engrave-faces-ansi-color-6cube-values))
+          (nearest-g (nth 6cube-g engrave-faces-ansi-color-6cube-values))
+          (nearest-b (nth 6cube-b engrave-faces-ansi-color-6cube-values)))
+      (if (and (= nearest-r r) (= nearest-g g) (= nearest-b b))
+          (+ 16 (* 36 6cube-r) (* 6 6cube-g) 6cube-b)
+        (let* ((grey-avg (/ (+ r g b) 3))
+               (grey-index (if (> grey-avg 238) 23
+                             (/ (- grey-avg 3) 10)))
+               (grey (+ 8 (* 10 grey-index))))
+          (if (> (engrave-faces-ansi-color-dist-squared (list grey grey grey)
+                                                        (list r g b))
+                 (engrave-faces-ansi-color-dist-squared (list nearest-r 
nearest-g nearest-b)
+                                                        (list r g b)))
+              (+ 232 grey-index)
+            (+ 16 (* 36 6cube-r) (* 6 6cube-g) 6cube-b)))))))
+
+
+;;;;;; 24-bit / 16m-color
+
+(defun engrave-faces-ansi-color-24bit-code (r g b &optional background)
+  (format (if background "\uE000[48;2;%d;%d;%dm" "\uE000[38;2;%d;%d;%dm") r g 
b))
+
+;;; Applying the transformation
+
+(defun engrave-faces-ansi-face-apply (faces content)
+  "TODO record faces, and use `engrave-faces-ansi-face-nesting' to diff 
properties
+with parent form more intelligent use of escape codes, and renewing properties 
which
+are collateral damage from \"[0m\"."
+  (let* ((face-str (engrave-faces-ansi-code (engrave-faces-merge-attributes 
faces))))
+    (concat face-str content (if (string= face-str "") "" "\uE000[0m"))))
+
+(defun engrave-faces-unescape-escape ()
+  (goto-char (point-min))
+  (while (re-search-forward "\uE000" nil t)
+    (replace-match "\e")))
+
+;;;###autoload
+(engrave-faces-define-backend "ansi" ".txt" #'engrave-faces-ansi-face-apply nil
+                              (lambda () (ansi-color-apply-on-region 
(point-min) (point-max) t)))
+(add-hook 'engrave-faces-ansi-after-hook #'engrave-faces-unescape-escape)