emacs-framebuffer

Show images in console using Linux framebuffer.
Log | Files | Refs

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)