Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

image viewer: add +, -, 0 keys and help #865

Merged
merged 4 commits into from
Jul 22, 2023
Merged

image viewer: add +, -, 0 keys and help #865

Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
f2ade4c
image-buffer: add help on ? and C-h
vindarel Jul 21, 2023
78f998d
image-buffer: add +, - and 0 keys
vindarel Jul 21, 2023
0978bef
image: show scaling indicator next to dimensions
vindarel Jul 21, 2023
e7f7cc5
image viewer: set the image directory
vindarel Jul 22, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
21 changes: 18 additions & 3 deletions frontends/sdl2/image-buffer.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,13 +26,19 @@

(defun image-information (window)
(let ((image (buffer-image (window-buffer window))))
(format nil " ~Dx~D"
(format nil " ~Dx~D (x~,2F)"
(lem-sdl2::image-width image)
(lem-sdl2::image-height image))))
(lem-sdl2::image-height image)
(buffer-scaling (window-buffer window)))))

(define-key *image-viewer-keymap* "C-+" 'image-zoom-in)
(define-key *image-viewer-keymap* "+" 'image-zoom-in)
(define-key *image-viewer-keymap* "C--" 'image-zoom-out)
(define-key *image-viewer-keymap* "-" 'image-zoom-out)
(define-key *image-viewer-keymap* "C-0" 'image-zoom-reset)
(define-key *image-viewer-keymap* "0" 'image-zoom-reset)
(define-key *image-viewer-keymap* "?" 'image-zoom-help)
(define-key *image-viewer-keymap* "C-h" 'image-zoom-help)

(defmethod render :before (texture window (buffer image-buffer))
(sdl2:set-render-target (current-renderer) texture)
Expand Down Expand Up @@ -76,6 +82,13 @@
(define-command image-zoom-reset () ()
(reset-buffer-scale (current-buffer)))

(define-command image-zoom-help () ()
(with-pop-up-typeout-window (s (make-buffer "*image-zoom-help*") :erase t)
(format s "Open an image file in Lem and use these keys to zoom in and out:~&")
(format s "Zoom in: + or C - + (M-x image-zoom-in)~&")
(format s "Zoom out: - or C - - (M-x image-zoom-out)~&")
(format s "Zoom reset: 0 or C - 0 (M-x image-zoom-reset)~&")))

(defclass sdl2-find-file-executor (lem:find-file-executor) ())

(defmethod lem:execute-find-file ((executor sdl2-find-file-executor) mode pathname)
Expand All @@ -88,7 +101,9 @@

(defun open-image-buffer (pathname)
(let ((image (load-image pathname))
(buffer (lem:make-buffer (file-namestring pathname))))
(buffer (lem:make-buffer (file-namestring pathname)
:directory (expand-file-name
(namestring (uiop:pathname-directory-pathname pathname))))))
(change-class buffer 'image-buffer)
(setf (buffer-image buffer) image)
(setf (buffer-scaling buffer) 1)
Expand Down