sixel.el

   1 ;;; sixel.el --- minor mode for processing sixel graphics
   2
   3 ;; Copyright (C) 2019 Tim Vaughan
   4
   5 ;; Author: Tim Vaughan <plugd@thelambdalab.xyz>
   6 ;; Created: 19 May 2019
   7 ;; Version: 1.0.0
   8 ;; Keywords:
   9 ;; Homepage: gopher://thelambdalab.xyz/1/projects/sixel
  10 ;; Package-Requires: ((emacs "26"))
  11
  12 ;;; Commentary:
  13
  14 ;; This file is not part of GNU Emacs.
  15
  16 ;; This program is free software: you can redistribute it and/or modify
  17 ;; it under the terms of the GNU General Public License as published by
  18 ;; the Free Software Foundation, either version 3 of the License, or
  19 ;; (at your option) any later version.
  20
  21 ;; This program is distributed in the hope that it will be useful,
  22 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  23 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24 ;; GNU General Public License for more details.
  25
  26 ;; You should have received a copy of the GNU General Public License
  27 ;; along with this file.  If not, see <http://www.gnu.org/licenses/>.
  28
  29 ;;; Code:
  30
  31 (defvar test-string
  32   (concat "\ePq"
  33           "#0;2;0;0;0#1;2;100;100;0#2;2;0;100;0"
  34           "#1~~@@vv@@~~@@~~$"
  35           "#2??}}GG}}??}}??-"
  36           "#1!14@\e\\"))
  37
  38 (defun sixel-get-params (string)
  39   "Retrieve the sixel parameters."
  40   (car (split-string (substring string 2) "q")))
  41
  42 (defun sixel-get-data (string)
  43   "Retrieve data string."
  44   (substring string (1+ (string-match "q" string))))
  45
  46 (defun sixel-tag-bits (sixel n tag)
  47   "Set bits of SIXEL corresponding to N with to the value TAG."
  48   (dotimes (i 6)
  49     (if (= (% n 2) 1)
  50         (aset sixel i tag))
  51     (setq n (/ n 2))))
  52
  53 (defun sixel-tag-sixel-in-row (row index char tag)
  54   "Tag the bits of the sixel at INDEX in the list identified by
  55 the variable ROW-VARIABLE corresponding to input character CHAR
  56 with TAG."
  57   (while (not (< index (length row)))
  58     (push (make-vector 6 nil) row))
  59   (let ((sixel (elt row (- (length row) 1 index))))
  60     (sixel-tag-bits sixel (- char 63) tag))
  61   row)
  62
  63 (defun sixel-process-data (string)
  64   "Convert STRING into a list of lists representing individual sixels.
  65 Returns a sixel image object."
  66   (with-temp-buffer
  67     (insert string)
  68     (goto-char (point-min))
  69     (let ((idx-out 0)
  70           this-row rows
  71           current-colour colour-map
  72           finished)
  73       (while  (not finished)
  74         (cond
  75          ;; Define colour:
  76          ((looking-at "#\\([0-9]+\\);\\([0-9]+\\);\\([0-9]+\\);\\([0-9]+\\);\\([0-9]+\\)")
  77           (let ((tag (format "%02x" (string-to-number (match-string 1))))
  78                 (mode (match-string 2))
  79                 (r (string-to-number (match-string 3)))
  80                 (g (string-to-number (match-string 4)))
  81                 (b (string-to-number (match-string 5))))
  82             (push (list tag r g b) colour-map)))
  83          ;; Set current colour:
  84          ((looking-at "#\\([0-9]+\\)")
  85           (let ((tag (format "%02x" (string-to-number (match-string 1)))))
  86             (setq current-colour tag)))
  87          ;; Carriage return:
  88          ((looking-at "\\$")
  89           (setq idx-out 0))
  90          ;; New line:
  91          ((looking-at "-")
  92           (push (reverse this-row) rows)
  93           (setq this-row nil)
  94           (setq idx-out 0))
  95          ;; RLE sixel char sequence:
  96          ((looking-at "!\\([0-9]+\\)\\([?-~]\\)")
  97           (let ((repeat-count (string-to-number (match-string 1)))
  98                 (char (elt (match-string 2) 0)))
  99             (dotimes (i repeat-count)
 100               (setq this-row
 101                     (sixel-tag-sixel-in-row this-row idx-out char current-colour))
 102               (setq idx-out (1+ idx-out)))))
 103          ;; Sixel char:
 104          ((looking-at "\\([?-~]\\)") ; Sixel char
 105           (let ((char (elt (match-string 1) 0)))
 106             (setq this-row
 107                   (sixel-tag-sixel-in-row this-row idx-out char current-colour))
 108             (setq idx-out (1+ idx-out))))
 109          ;; Termination sequence:
 110          ((looking-at "\e\\\\")
 111           (setq finished t))
 112          ;; Skip other char:
 113          ((looking-at "[[:ascii:]]")))
 114         (goto-char (match-end 0)))
 115       (push (reverse this-row) rows)
 116       (cons colour-map
 117             (reverse rows)))))
 118
 119 (defun sixel-pad-rows (sixel-image)
 120   "Pad out contents of rows in SIXEL-IMAGE so that all rows are the same length."
 121   (let ((width (car (sixel-image-dims sixel-image)))
 122         (rows (cdr sixel-image)))
 123     (dotimes (row-idx (length rows))
 124       (let* ((row-cdr (nthcdr row-idx rows))
 125              (row-width (length (car row-cdr))))
 126         (if (< row-width width)
 127             (setcar row-cdr (append (car row-cdr)
 128                                     (make-list (- width row-width)
 129                                                [nil nil nil nil nil nil])))))))
 130   sixel-image)
 131
 132 (defun sixel-image-colour-map (sixel-image)
 133   "Extract colour map from SIXEL-IMAGE."
 134   (car sixel-image))
 135
 136 (defun sixel-image-sixels (sixel-image)
 137   "Extract sixels from SIXEL-IMAGE."
 138   (cdr sixel-image))
 139
 140 (defun sixel-image-dims (sixel-image)
 141   "Compute image width from SIXEL-IMAGE.  Return pair (width . height)."
 142   (let ((sixels (sixel-image-sixels sixel-image)))
 143     (cons
 144      (apply #'max (mapcar (lambda (row) (length row)) sixels))
 145      (* 6 (length sixels)))))
 146
 147 (defun sixel-image-to-xpm-values (sixel-image)
 148   "Produce parameter values component of XPM representation of SIXEL-IMAGE."
 149   (let* ((dims (sixel-image-dims sixel-image))
 150          (colour-map (sixel-image-colour-map sixel-image))
 151          (n-colours (1+ (length colour-map))))
 152     (concat "\""
 153             (number-to-string (car dims)) " "
 154             (number-to-string (cdr dims)) " "
 155             (number-to-string n-colours) " 2\"")))
 156
 157 (defun sixel-image-to-xpm-colours (sixel-image)
 158   "Produce colour definitions component of XPM representation of SIXEL-IMAGE."
 159   (let ((colour-map (sixel-image-colour-map sixel-image)))
 160     (concat
 161      (string-join
 162       (mapcar (lambda (colour)
 163                 (concat
 164                  "\""
 165                  (elt colour 0) " "
 166                  "c #"
 167                  (format "%02x%02x%02x"
 168                          (/ (* 255 (elt colour 1)) 100)
 169                          (/ (* 255 (elt colour 2)) 100)
 170                          (/ (* 255 (elt colour 3)) 100))
 171                  "\""))
 172               colour-map)
 173       ",\n")
 174      ",\n"
 175      "\"-- c #000000\"")))
 176
 177 (defun sixel-image-to-xpm-pixels (sixel-image)
 178   "Produce pixels component of XPM representation of SIXEL-IMAGE."
 179   (concat
 180    "\""
 181    (string-join
 182     (mapcar (lambda (sixel-row)
 183               (string-join
 184                (mapcar (lambda (i)
 185                          (string-join
 186                           (mapcar (lambda (sixel)
 187                                     (let ((pixel (elt sixel i)))
 188                                       (if pixel
 189                                           pixel
 190                                         "--")))
 191                                   sixel-row)))
 192                        (number-sequence 0 5))
 193                "\",\n\""))
 194             (sixel-image-sixels sixel-image))
 195     "\",\n\"")
 196    "\""))
 197
 198 (defun sixel-to-xpm (string)
 199   "Return an XPM image representation of the SIXEL graphic encoded in STRING."
 200   (let* ((param-string (sixel-get-params string))
 201          (data-string (sixel-get-data string))
 202          (sixel-image (sixel-pad-rows (sixel-process-data data-string))))
 203     (if (string-prefix-p "\eP" string)
 204         (concat
 205          "/* XPM */"
 206          "static char * pixmap[] = {"
 207          (sixel-image-to-xpm-values sixel-image) ",\n"
 208          (sixel-image-to-xpm-colours sixel-image) ",\n"
 209          (sixel-image-to-xpm-pixels sixel-image) "};")
 210       (error "Incorrecly formatted sixel string"))))
 211
 212 (defun sixel-render-images-in-buffer ()
 213   "Find and render any sixel images in the current buffer."
 214   (interactive)
 215   (save-excursion
 216     (goto-char (point-min))
 217     (while (re-search-forward "\eP[[:ascii:]]*\e\\\\" nil t)
 218       (let ((sixel-string (match-string 0))
 219             (inhibit-read-only t))
 220         (delete-region (match-beginning 0)
 221                        (match-end 0))
 222         (insert-image
 223          (create-image (sixel-to-xpm sixel-string) 'xpm t))
 224         (insert "\n")))))
 225
 226 (defgroup sixel nil
 227   "Render sixel images."
 228   :group 'multimedia)
 229
 230 (define-minor-mode sixel-mode
 231   "A minor mode which renders sixel graphics." nil "sixel" nil
 232   (add-hook 'after-change-functions
 233             (lambda (start end size)
 234               (sixel-render-images-in-buffer)
 235               (message "Render complete."))
 236             nil t))
 237
 238 ;;; sixel.el ends here