emacs-framebuffer.el (11450B)
1 ;;; emacs-framebuffer.el 2 ;;; 3 ;;; Show images in console using Linux framebuffer. 4 ;;; 5 ;;; Copyright (C) 2020 Tomas Hlavaty <tom at logand dot com> 6 ;;; 7 ;;; License: GPLv3 or later 8 ;;; 9 ;;; Download: git clone https://logand.com/git/emacs-framebuffer.git 10 ;;; 11 ;;; Dependencies: 12 ;;; 13 ;;; - w3mimgdisplay from w3m terminal web browser 14 ;;; 15 ;;; Example configuration: 16 ;;; 17 ;;; (unless (display-graphic-p) 18 ;;; (require 'framebuffer) 19 ;;; (framebuffer-install)) 20 21 (defcustom framebuffer-width nil 22 "Specify the framebuffer width." 23 :type 'number 24 :group 'framebuffer) 25 26 (defcustom framebuffer-height nil 27 "Specify the framebuffer height." 28 :type 'number 29 :group 'framebuffer) 30 31 (defcustom framebuffer-default-width 1024 32 "Specify the framebuffer default width." 33 :type 'number 34 :group 'framebuffer) 35 36 (defcustom framebuffer-default-height 768 37 "Specify the framebuffer height." 38 :type 'number 39 :group 'framebuffer) 40 41 (defcustom framebuffer-draw-delay "0.1 sec" 42 "Specify the delay after which to draw on the framebuffer." 43 :type 'string 44 :group 'framebuffer) 45 46 (defcustom framebuffer-image-mode-refresh-delay "2 sec" 47 "Specify the delay after which to refresh the image on the framebuffer." 48 :type 'string 49 :group 'framebuffer) 50 51 (defvar framebuffer-size nil) 52 53 (defun framebuffer-size () 54 (if (and framebuffer-width framebuffer-height) 55 (cons framebuffer-width framebuffer-height) 56 (or framebuffer-size 57 (setq framebuffer-size 58 (or 59 (with-temp-buffer 60 ;; TODO which framebuffer if more than one? 61 (insert-file-contents "/sys/class/graphics/fb0/modes") 62 (search-forward-regexp "\\([0-9]+\\)x\\([0-9]+\\)") 63 (cons (read (match-string 1)) (read (match-string 2)))) 64 (cons framebuffer-default-width framebuffer-default-height)))))) 65 66 (defun framebuffer-draw-now (x y w h file) 67 (with-temp-buffer 68 (insert (format "0;1;%d;%d;%d;%d;;;;;%s\n" x y w h (expand-file-name file))) 69 (call-process-region (point-min) (point-max) "w3mimgdisplay"))) 70 71 (defun framebuffer-draw (x y w h file) 72 (run-at-time framebuffer-draw-delay nil 'framebuffer-draw-now x y w h file)) 73 74 (defun framebuffer-buffer-brook () 75 (lambda () 76 (let ((z (char-after))) 77 (when z 78 (goto-char (1+ (point))) 79 z)))) 80 81 (defun framebuffer-next-u8 (brook) 82 (let ((z (funcall brook))) 83 (when z 84 (if (<= 0 z 255) 85 z 86 (error "expected octet, got %s" z))))) 87 88 (defun framebuffer-next-u16 (brook) 89 (+ (* 256 (framebuffer-next-u8 brook)) 90 (framebuffer-next-u8 brook))) 91 92 (defun framebuffer-next-u16le (brook) 93 (+ (framebuffer-next-u8 brook) 94 (* 256 (framebuffer-next-u8 brook)))) 95 96 (defun framebuffer-next-u32 (brook) 97 (+ (* 65536 (framebuffer-next-u16 brook)) 98 (framebuffer-next-u16 brook))) 99 100 (defun framebuffer-next-u32le (brook) 101 (+ (framebuffer-next-u16le brook) 102 (* 65536 (framebuffer-next-u16le brook)))) 103 104 (defun framebuffer-image-size (file) 105 (with-temp-buffer 106 (set-buffer-multibyte nil) 107 (insert-file-contents-literally file) 108 (let* ((brook (framebuffer-buffer-brook)) 109 (a (framebuffer-next-u8 brook))) 110 (case a 111 (137 ;; png 112 (when (and (= ?P (framebuffer-next-u8 brook)) 113 (= ?N (framebuffer-next-u8 brook)) 114 (= ?G (framebuffer-next-u8 brook)) 115 (= 13 (framebuffer-next-u8 brook)) 116 (= 10 (framebuffer-next-u8 brook)) 117 (= 26 (framebuffer-next-u8 brook)) 118 (= 10 (framebuffer-next-u8 brook)) 119 (<= 12 (framebuffer-next-u32 brook)) 120 (= ?I (framebuffer-next-u8 brook)) 121 (= ?H (framebuffer-next-u8 brook)) 122 (= ?D (framebuffer-next-u8 brook)) 123 (= ?R (framebuffer-next-u8 brook))) 124 (cons (framebuffer-next-u32 brook) 125 (framebuffer-next-u32 brook)))) 126 (#xff ;; jpeg 127 (when (= #xd8 (framebuffer-next-u8 brook)) 128 (let ((n 0) 129 (m 0)) 130 (while (not (member m '(#xc0 #xc1 #xc2 #xc3 #xc5 #xc6 #xc7 #xc8 131 #xc9 #xca #xcb #xcd #xc0e #xcf))) 132 (goto-char (+ (point) n)) 133 (while (= #xff (setq m (framebuffer-next-u8 brook)))) 134 (setq n (- (framebuffer-next-u16 brook) 2)))) 135 (framebuffer-next-u8 brook) 136 (let ((h (framebuffer-next-u16 brook))) 137 (cons (framebuffer-next-u16 brook) 138 h)))) 139 (?B ;; bmp 140 (when (= ?M (framebuffer-next-u8 brook)) 141 (dotimes (i 16) 142 (framebuffer-next-u8 brook)) 143 (cons (framebuffer-next-u32le brook) 144 (framebuffer-next-u32le brook)))) 145 (?G ;; gif 146 (when (and (= ?I (framebuffer-next-u8 brook)) 147 (= ?F (framebuffer-next-u8 brook)) 148 (= ?8 (framebuffer-next-u8 brook)) 149 (member (framebuffer-next-u8 brook) '(?7 ?9)) 150 (= ?a (framebuffer-next-u8 brook))) 151 (cons (framebuffer-next-u16le brook) 152 (framebuffer-next-u16le brook)))) 153 ((?I ?M) ;; tiff 154 (let ((b (framebuffer-next-u8 brook))) 155 (when (= a b) 156 (multiple-value-bind (u16 u32) 157 (ecase a 158 (?I (values 'framebuffer-next-u16le 'framebuffer-next-u32le)) 159 (?M (values 'framebuffer-next-u16 'framebuffer-next-u32))) 160 (when (= #x2a (funcall u16 brook)) 161 (let (w h) 162 (goto-char (1+ (funcall u32 brook))) 163 (dotimes (i (funcall u16 brook)) 164 (let ((tag (funcall u16 brook)) 165 (type (funcall u16 brook)) 166 (n (funcall u32 brook)) 167 (v (funcall u32 brook))) 168 (case tag 169 (#x0100 170 (ecase type 171 (3 (setq w v)))) 172 (#x0101 173 (ecase type 174 (3 (setq h v))))))) 175 (when (and w h) 176 (cons w h)))))))) 177 (?P ;; ppm pnm 178 (case (framebuffer-next-u8 brook) 179 ((?3 ?6) 180 (search-forward-regexp "^\\([0-9]+\\) \\([0-9]+\\)$") 181 (cons (read (match-string 1)) (read (match-string 2)))))) 182 (t ;; xpm 183 (when (search-forward-regexp "\"[ ]*\\([0-9]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+\\)[ ]+\\([0-9]+\\)[ ]*") 184 (cons (read (match-string 1)) (read (match-string 2))))) 185 )))) 186 187 (defun framebuffer-image-file (file) 188 (interactive "fFile: ") 189 (destructuring-bind (w &rest h) (framebuffer-image-size file) 190 (destructuring-bind (fw &rest fh) (framebuffer-size) 191 (let* ((scale (min (/ fw 1.0 w) (/ fh 1.0 h))) 192 (ww (floor (* scale w))) 193 (hh (floor (* scale h))) 194 (xx (floor (- fw ww) 2)) 195 (yy (floor (- fh hh) 2))) 196 (framebuffer-draw xx yy ww hh file))))) 197 198 (defun framebuffer-image-buffer () 199 (interactive) 200 (framebuffer-image-file (buffer-file-name))) 201 202 (defun framebuffer-image-file-dired () 203 (interactive) 204 (framebuffer-image-file (dired-file-name-at-point))) 205 206 (defun framebuffer-dired-image-p () 207 (let ((f (dired-file-name-at-point))) 208 (and (not (file-directory-p f)) 209 (string-match 210 "jpe?g\\|JPE?G\\|png\\|PNG\\|bmp\\|BMP\\|gif\\|GIF\\|tiff?\\|TIFF?\\|ppm\\|PPM\\|pnm\\|PNM\\|xpm\\|XPM" 211 (or (file-name-extension f) ""))))) 212 213 (defun framebuffer-image-file-dired-next (arg) 214 (interactive "^p") 215 (while (not (progn 216 (dired-next-line (or arg 1)) 217 (framebuffer-dired-image-p)))) 218 (when (framebuffer-dired-image-p) 219 (framebuffer-image-file-dired))) 220 221 (defun framebuffer-image-file-dired-previous (arg) 222 (interactive "^p") 223 (framebuffer-image-file-dired-next (if arg (- arg) -1))) 224 225 (defvar framebuffer-image-mode-image-size) 226 227 (defun framebuffer-image-mode-draw-image (buffer) 228 (interactive) 229 (let ((file (buffer-file-name))) 230 (destructuring-bind (w &rest h) framebuffer-image-mode-image-size 231 (destructuring-bind (fbw &rest fbh) (framebuffer-size) 232 (let ((window (get-buffer-window buffer 'visible))) ;; TODO for all visible windows 233 (when window 234 (destructuring-bind (x1 y1 x2 y2) (window-edges window t) 235 (let* ((fw (frame-width)) 236 (fh (frame-height)) 237 (cw (floor fbw fw)) 238 (ch (floor fbh fh)) 239 (wx (* x1 cw)) 240 (wy (* y1 ch)) 241 (ww (* (- x2 x1) cw)) 242 (wh (* (- y2 y1) ch)) 243 (scale (min (/ ww 1.0 w) (/ wh 1.0 h))) 244 (zw (floor (* scale w))) 245 (zh (floor (* scale h))) 246 (zx (+ wx (floor (- ww zw) 2))) 247 (zy (+ wy (floor (- wh zh) 2)))) 248 (framebuffer-draw zx zy zw zh file))))))))) 249 250 (defun framebuffer-image-mode-draw-image-repeatedly (buffer) 251 (when (buffer-live-p buffer) 252 (with-current-buffer buffer 253 (framebuffer-image-mode-draw-image buffer) 254 (run-at-time framebuffer-image-mode-refresh-delay 255 nil 256 'framebuffer-image-mode-draw-image-repeatedly 257 buffer)))) 258 259 (defun framebuffer-image-mode-kill-buffer () 260 (interactive) 261 (kill-buffer)) 262 263 (defvar framebuffer-image-mode-hook nil) 264 265 (define-derived-mode framebuffer-image-mode fundamental-mode "fbi" 266 "Major mode for viewing images in framebuffer." 267 (set (make-local-variable 'framebuffer-image-mode-image-size) 268 (framebuffer-image-size (buffer-file-name))) 269 (with-silent-modifications 270 (erase-buffer) 271 (insert "file: ") 272 (insert (buffer-file-name)) 273 (insert "\n\n") 274 (insert "width: ") 275 (insert (format "%s" (car framebuffer-image-mode-image-size))) 276 (insert "\nheight: ") 277 (insert (format "%s" (cdr framebuffer-image-mode-image-size))) 278 (insert "\n\npress:\n") 279 (insert "- i: to draw the image\n") 280 (insert "- q: to kill the buffer\n")) 281 (setq buffer-read-only t) 282 (goto-char (point-min)) 283 (framebuffer-image-mode-draw-image-repeatedly (current-buffer)) 284 (run-hooks 'framebuffer-image-mode-hook)) 285 286 (add-hook 287 'framebuffer-image-mode-hook 288 (lambda () 289 (define-key framebuffer-image-mode-map "q" 'framebuffer-image-mode-kill-buffer))) 290 291 (defun framebuffer-install () 292 (add-to-list 'auto-mode-alist '("\\.png\\'" . framebuffer-image-mode)) 293 (add-to-list 'auto-mode-alist '("\\.jpe?g\\'" . framebuffer-image-mode)) 294 (add-to-list 'auto-mode-alist '("\\.bmp\\'" . framebuffer-image-mode)) 295 (add-to-list 'auto-mode-alist '("\\.gif\\'" . framebuffer-image-mode)) 296 (add-to-list 'auto-mode-alist '("\\.tiff\\'" . framebuffer-image-mode)) 297 (add-to-list 'auto-mode-alist '("\\.ppm\\'" . framebuffer-image-mode)) 298 (add-to-list 'auto-mode-alist '("\\.pnm\\'" . framebuffer-image-mode)) 299 (add-to-list 'auto-mode-alist '("\\.xpm\\'" . framebuffer-image-mode)) 300 (with-eval-after-load 'dired 301 (define-key dired-mode-map "I" 'framebuffer-image-file-dired) 302 (define-key dired-mode-map "N" 'framebuffer-image-file-dired-next) 303 (define-key dired-mode-map "P" 'framebuffer-image-file-dired-previous))) 304 305 (provide 'framebuffer)