sixel.el

   1 (defvar test-string
   2   (concat "q"
   3           "#0;2;0;0;0#1;2;100;100;0#2;2;0;100;0"
   4           "#1~~@@vv@@~~@@~~$"
   5           "#2??GG????-"
   6           "#1!14@"))
   7
   8
   9 (defun sixel-get-params (string)
  10   "Retrieve the sixel parameters."
  11   (car (split-string string "q")))
  12
  13 (defun sixel-get-data (string)
  14   "Retrieve data string."
  15   (substring string (1+ (string-match "q" string))))
  16
  17 (defvar sixel-colour-map nil
  18   "Map of two-character names to RGB colour triples.")
  19
  20 (defvar sixel-current-colour nil
  21   "Current colour.")
  22
  23 (defun sixel-compute-row-length (string)
  24   (apply 'max
  25          (mapcar
  26           (lambda (substr)
  27             (apply 'max (mapcar
  28                          (lambda (subsubstr)
  29                            (length (subsubstr)))
  30                          (split-string substr "$"))))
  31           (split-string string -))))
  32
  33 (defun sixel-tag-bits (sixel n tag)
  34   "Set bits of SIXEL corresponding to N with to the value TAG."
  35   (dotimes (i 6)
  36     (if (= (% n 2) 1)
  37         (aset sixel i tag))
  38     (setq n (/ n 2))))
  39
  40 (defun sixel-tag-sixel-in-row (row-variable index char tag)
  41   "Tag the bits of the sixel at INDEX in the list identified by
  42 the variable ROW-VARIABLE corresponding to input character CHAR
  43 with TAG."
  44   (while (not (< index (length (symbol-value row-variable))))
  45     (add-to-list row-variable (make-vector 6 nil)))
  46   (let ((sixel (elt (symbol-value row-variable) index)))
  47     (sixel-tag-bits sixel (- char 63) tag)))
  48
  49 (defun sixel-process-row (string)
  50   (let ((idx-in 0)
  51         (idx-out 0)
  52         result)
  53     (while (< idx-in (length string))
  54       (let (trunc-string (substring string index-in))
  55         (cond
  56          ((string-match "^#\\([0-9]+\\);\\([0-9]+\\);\\([0-9]+\\);\\([0-9]+\\);\\([0-9]+\\)"
  57                         trunc-string)
  58           (let ((tag (intern (string-to (match-string 1 trunc-string))))
  59                 (mode (match-string 2 trunc-string))
  60                 (r (string-to-number (match-string 3 trunc-string)))
  61                 (g (string-to-number (match-string 4 trunc-string)))
  62                 (b (string-to-number (match-string 5 trunc-string))))
  63             (add-to-list 'sixel-colour-map (list (tag r g b)))
  64             (setq idx-in (match-end 0))))
  65          ((string-match "^#\\([0-9]+\\)" trunc-string)
  66           (let ((tag (intern (match-string 1 trunc-string))))
  67             (setq sixel-current-colour tag)
  68             (setq idx-in (match-end 0))))
  69          ((string-match "^$" trunc-string)
  70           (setq idx-out 0)
  71           (setq idx-in (match-end 0 trunc-string)))
  72          ((string-match "^!\\([0-9]+\\)\\([?-~]\\)" trunc-string)
  73           (let ((repeat-count (string-to-number (match-string 1 trunc-string)))
  74                 (char (elt (match-string 2 trunc-string) 0)))
  75             (dotimes (i repeat-count)
  76               (sixel-tag-sixel-in-row 'result idx-out char sixel-current-colour)
  77               (setq idx-out (+1 idx-out)))))
  78          ((string-match "^\\([?-~]\\)" trunc-string)
  79           (let ((char (elt (match-string 1 trunc-string) 0)))
  80             (sixel-tag-sixel-in-row 'result idx-out char sixel-current-colour))
  81           (setq idx-out (+1 idx-out))))))))
  82
  83 (sixel-get-rows test-string)
  84
  85 (defun sixel-to-xpm (string)
  86   "Converts the given sixel string into an XPM image."
  87
  88   (let* ((sp (split-string string "q"))
  89          (control-string (car sp))
  90          ())))