X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=blobdiff_plain;f=sixel.el;h=053739d300c36026541775c1539844050c9544a0;hb=e3bfe837fe1c04c4319ebb57d70bd641f7906829;hp=ae7a2aa737a523b083d1e64ac462288d875793e5;hpb=58fcef84be59f6447994e93325d0c8fca5d4d332;p=sixel.git diff --git a/sixel.el b/sixel.el index ae7a2aa..053739d 100644 --- a/sixel.el +++ b/sixel.el @@ -1,29 +1,33 @@ +;;; sixel.el --- minor mode for processing sixel graphics + +;; Copyright (C) 2019 Tim Vaughan + +;; Author: Tim Vaughan +;; Created: 19 May 2019 +;; Version: 1.0.0 +;; Keywords: +;; Homepage: https://github.com/tgvaughan/sixel +;; Package-Requires: ((emacs "25")) + +;;; Commentary: + +;;; Code: + (defvar test-string - (concat "q" + (concat "Pq" "#0;2;0;0;0#1;2;100;100;0#2;2;0;100;0" "#1~~@@vv@@~~@@~~$" - "#2??GG????-" - "#1!14@")) - + "#2??}}GG}}??}}??-" + "#1!14@\\")) (defun sixel-get-params (string) "Retrieve the sixel parameters." - (car (split-string string "q"))) + (car (split-string (substring string 2) "q"))) (defun sixel-get-data (string) "Retrieve data string." (substring string (1+ (string-match "q" string)))) -(defun sixel-compute-row-length (string) - (apply 'max - (mapcar - (lambda (substr) - (apply 'max (mapcar - (lambda (subsubstr) - (length (subsubstr))) - (split-string substr "$")))) - (split-string string -)))) - (defun sixel-tag-bits (sixel n tag) "Set bits of SIXEL corresponding to N with to the value TAG." (dotimes (i 6) @@ -31,17 +35,19 @@ (aset sixel i tag)) (setq n (/ n 2)))) -(defun sixel-tag-sixel-in-row (row-variable index char tag) +(defun sixel-tag-sixel-in-row (row index char tag) "Tag the bits of the sixel at INDEX in the list identified by the variable ROW-VARIABLE corresponding to input character CHAR with TAG." - (while (not (< index (length (symbol-value row-variable)))) - (add-to-list row-variable (make-vector 6 nil))) - (let ((sixel (elt (symbol-value row-variable) index))) - (sixel-tag-bits sixel (- char 63) tag))) + (while (not (< index (length row))) + (push (make-vector 6 nil) row)) + (let ((sixel (elt row (- (length row) 1 index)))) + (sixel-tag-bits sixel (- char 63) tag)) + row) (defun sixel-process-data (string) - "Convert sixel string into a list of lists representing individual sixels." + "Convert STRING into a list of lists representing individual sixels. +Returns a sixel image object." (with-temp-buffer (insert string) (goto-char (point-min)) @@ -51,40 +57,144 @@ with TAG." finished) (while (not finished) (cond + ;; Define colour: ((looking-at "#\\([0-9]+\\);\\([0-9]+\\);\\([0-9]+\\);\\([0-9]+\\);\\([0-9]+\\)") - (let ((tag (intern (match-string 1))) + (let ((tag (format "%02x" (string-to-number (match-string 1)))) (mode (match-string 2)) (r (string-to-number (match-string 3))) (g (string-to-number (match-string 4))) (b (string-to-number (match-string 5)))) (push (list tag r g b) colour-map))) - + ;; Set current colour: ((looking-at "#\\([0-9]+\\)") - (let ((tag (intern (match-string 1 trunc-string)))) + (let ((tag (format "%02x" (string-to-number (match-string 1))))) (setq current-colour tag))) - - ((looking-at "$") + ;; Carriage return: + ((looking-at "\\$") (setq idx-out 0)) - - ((looking-at "^-") - (push this-row 'rows) + ;; New line: + ((looking-at "-") + (push (reverse this-row) rows) (setq this-row nil) (setq idx-out 0)) - - ((looking-at "^!\\([0-9]+\\)\\([?-~]\\)") + ;; RLE sixel char sequence: + ((looking-at "!\\([0-9]+\\)\\([?-~]\\)") (let ((repeat-count (string-to-number (match-string 1))) - (char (elt (match-string 2 trunc-string) 0))) + (char (elt (match-string 2) 0))) (dotimes (i repeat-count) - (sixel-tag-sixel-in-row 'result idx-out char current-colour)))) + (setq this-row + (sixel-tag-sixel-in-row this-row idx-out char current-colour)) + (setq idx-out (1+ idx-out))))) + ;; Sixel char: + ((looking-at "\\([?-~]\\)") ; Sixel char + (let ((char (elt (match-string 1) 0))) + (setq this-row + (sixel-tag-sixel-in-row this-row idx-out char current-colour)) + (setq idx-out (1+ idx-out)))) + ;; Termination sequence: + ((looking-at "\\\\") + (setq finished t)) + ;; Skip other char: + ((looking-at "[[:ascii:]]"))) + (goto-char (match-end 0))) + (push (reverse this-row) rows) + (cons colour-map + (reverse rows))))) - ((looking-at "^\\([?-~]\\)") - (let ((char (elt (match-string 1 trunc-string) 0))) - (sixel-tag-sixel-in-row 'result idx-out char current-colour))) +(defun sixel-pad-rows (sixel-image) + "Pad out contents of rows in SIXEL-IMAGE so that all rows are the same length." + (let ((width (car (sixel-image-dims sixel-image))) + (rows (cdr sixel-image))) + (dotimes (row-idx (length rows)) + (let* ((row-cdr (nthcdr row-idx rows)) + (row-width (length (car row-cdr)))) + (if (< row-width width) + (setcar row-cdr (append (car row-cdr) + (make-list (- width row-width) + [nil nil nil nil nil nil]))))))) + sixel-image) - ((= (point) (point-max)) - (setq finished t)) +(defun sixel-image-colour-map (sixel-image) + "Extract colour map from SIXEL-DATA." + (car sixel-image)) - (t (error "Invalid characters found in input string."))) +(defun sixel-image-sixels (sixel-image) + "Extract sixels from SIXEL-DATA." + (cdr sixel-image)) - (goto-char (match-end 0))) - (push this-row 'rows)))) +(defun sixel-image-dims (sixel-image) + "Computes image width from SIXEL-DATA. Returns pair (width . height)." + (let ((sixels (sixel-image-sixels sixel-image))) + (cons + (apply #'max (mapcar (lambda (row) (length row)) sixels)) + (* 6 (length sixels))))) + +(defun sixel-image-to-xpm-values (sixel-image) + "Produce string representing parameter values component of XPM +representation of SIXEL-IMAGE." + (let* ((dims (sixel-image-dims sixel-image)) + (colour-map (sixel-image-colour-map sixel-image)) + (n-colours (1+ (length colour-map)))) + (concat "\"" + (number-to-string (car dims)) " " + (number-to-string (cdr dims)) " " + (number-to-string n-colours) " 2\""))) + +(defun sixel-image-to-xpm-colours (sixel-image) + "Produce string representing colour definitions component of XPM +representation of SIXEL-IMAGE." + (let ((colour-map (sixel-image-colour-map sixel-image))) + (concat + (string-join + (mapcar (lambda (colour) + (concat + "\"" + (elt colour 0) " " + "c #" + (format "%02x%02x%02x" + (/ (* 255 (elt colour 1)) 100) + (/ (* 255 (elt colour 2)) 100) + (/ (* 255 (elt colour 3)) 100)) + "\"")) + colour-map) + ",\n") + ",\n" + "\"-- c #000000\""))) + +(defun sixel-image-to-xpm-pixels (sixel-image) + "Produce string representating pixels component of XPM representation +of SIXEL-IMAGE." + (concat + "\"" + (string-join + (mapcar (lambda (sixel-row) + (string-join + (mapcar (lambda (i) + (string-join + (mapcar (lambda (sixel) + (let ((pixel (elt sixel i))) + (if pixel + pixel + "--"))) + sixel-row))) + (number-sequence 0 5)) + "\",\n\"")) + (sixel-image-sixels sixel-image)) + "\",\n\"") + "\"")) + +(defun sixel-to-xpm (string) + "Returns an XPM image representation of the SIXEL graphic encoded in STRING." + (let* ((param-string (sixel-get-params string)) + (data-string (sixel-get-data string)) + (sixel-image (sixel-pad-rows (sixel-process-data data-string)))) + (if (string-prefix-p "P" string) + (concat + "/* XPM */" + "static char * pixmap[] = {" + (sixel-image-to-xpm-values sixel-image) ",\n" + (sixel-image-to-xpm-colours sixel-image) ",\n" + (sixel-image-to-xpm-pixels sixel-image) "};") + (error "Incorrecly formatted sixel string.")))) + +;; sixel.el ends here