sixel.el

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