v0.14.0: sync org files with mouse selection and framebuffer inspection
This commit is contained in:
@@ -306,6 +306,32 @@ Returns the number of changed cells."
|
|||||||
count))
|
count))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
|
** Frame inspection (for mouse selection / link clicking)
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||||
|
;;; --- Frame inspection ---------------------------------------------------
|
||||||
|
|
||||||
|
(defun fb-cell-link-url (fb x y)
|
||||||
|
"Return the link URL at (X Y) in framebuffer FB, or nil."
|
||||||
|
(when (and (arrayp fb) (>= y 0) (< y (array-dimension fb 0))
|
||||||
|
(>= x 0) (< x (array-dimension fb 1)))
|
||||||
|
(let ((c (aref fb y x)))
|
||||||
|
(cell-link-url c))))
|
||||||
|
|
||||||
|
(defun extract-text (fb x1 y1 x2 y2)
|
||||||
|
"Extract visible text from the rectangle between (X1,Y1) and (X2,Y2)."
|
||||||
|
(let ((x-min (min x1 x2)) (x-max (max x1 x2))
|
||||||
|
(y-min (min y1 y2)) (y-max (max y1 y2))
|
||||||
|
(h (if (arrayp fb) (array-dimension fb 0) 0))
|
||||||
|
(w (if (arrayp fb) (array-dimension fb 1) 0)))
|
||||||
|
(with-output-to-string (s)
|
||||||
|
(loop for y from y-min to (min y-max (1- h))
|
||||||
|
do (loop for x from x-min to (min x-max (1- w))
|
||||||
|
do (let ((c (aref fb y x)))
|
||||||
|
(princ (cell-char c) s)))
|
||||||
|
(when (< y y-max) (princ #\Newline s))))))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
** Scissor clipping
|
** Scissor clipping
|
||||||
|
|
||||||
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
#+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp
|
||||||
|
|||||||
@@ -27,14 +27,17 @@ module adds:
|
|||||||
|
|
||||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse-package.lisp :noweb no
|
#+BEGIN_SRC lisp :tangle ../src/components/mouse-package.lisp :noweb no
|
||||||
(defpackage :cl-tty.mouse
|
(defpackage :cl-tty.mouse
|
||||||
(:use :cl :cl-tty.input :cl-tty.box)
|
(:use :cl :cl-tty.input :cl-tty.box :cl-tty.rendering)
|
||||||
(:export
|
(:export
|
||||||
#:mouse-mixin
|
#:mouse-mixin
|
||||||
#:on-mouse-down #:on-mouse-up #:on-mouse-move #:on-mouse-scroll
|
#:on-mouse-down #:on-mouse-up #:on-mouse-move #:on-mouse-scroll
|
||||||
#:handle-mouse-event
|
#:handle-mouse-event
|
||||||
#:hit-test
|
#:hit-test
|
||||||
#:selection #:get-selection #:copy-to-clipboard
|
#:selection #:get-selection #:copy-to-clipboard
|
||||||
#:make-selection #:selection-p))
|
#:make-selection #:selection-p
|
||||||
|
#:start-selection #:update-selection #:finalize-selection
|
||||||
|
#:selection-active-p
|
||||||
|
#:cell-link-at #:open-link-at))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
#+BEGIN_SRC lisp :tangle ../src/components/mouse.lisp :noweb no
|
||||||
@@ -81,6 +84,60 @@ module adds:
|
|||||||
#+linux (sb-ext:run-program "xclip" (list "-selection" "clipboard")
|
#+linux (sb-ext:run-program "xclip" (list "-selection" "clipboard")
|
||||||
:input text :wait nil)
|
:input text :wait nil)
|
||||||
#+darwin (sb-ext:run-program "pbcopy" nil :input text :wait nil))
|
#+darwin (sb-ext:run-program "pbcopy" nil :input text :wait nil))
|
||||||
|
|
||||||
|
;;; --- Selection tracking (mouse drag) ---------------------------------------
|
||||||
|
|
||||||
|
(defvar *selection-active* nil
|
||||||
|
"T when a drag selection is in progress.")
|
||||||
|
|
||||||
|
(defvar *selection-start* nil
|
||||||
|
"Cons (X . Y) of mouse-down position during drag.")
|
||||||
|
|
||||||
|
(defvar *selection-end* nil
|
||||||
|
"Cons (X . Y) of current mouse position during drag.")
|
||||||
|
|
||||||
|
(defun start-selection (x y)
|
||||||
|
"Begin a drag selection at (X Y)."
|
||||||
|
(setf *selection-start* (cons x y)
|
||||||
|
*selection-end* (cons x y)
|
||||||
|
*selection-active* t))
|
||||||
|
|
||||||
|
(defun update-selection (x y)
|
||||||
|
"Update the drag selection end position to (X Y)."
|
||||||
|
(setf *selection-end* (cons x y)))
|
||||||
|
|
||||||
|
(defun selection-active-p ()
|
||||||
|
"Return T if a drag selection is in progress."
|
||||||
|
*selection-active*)
|
||||||
|
|
||||||
|
(defun finalize-selection (fb)
|
||||||
|
"End the drag selection and extract text from the framebuffer."
|
||||||
|
(setf *selection-active* nil)
|
||||||
|
(when (and *selection-start* *selection-end* fb)
|
||||||
|
(let* ((x1 (car *selection-start*))
|
||||||
|
(y1 (cdr *selection-start*))
|
||||||
|
(x2 (car *selection-end*))
|
||||||
|
(y2 (cdr *selection-end*))
|
||||||
|
(text (cl-tty.rendering:extract-text fb x1 y1 x2 y2)))
|
||||||
|
(setf *selection* (make-selection :start-x x1 :start-y y1
|
||||||
|
:end-x x2 :end-y y2
|
||||||
|
:text text))
|
||||||
|
(setf *selection-start* nil *selection-end* nil)
|
||||||
|
text)))
|
||||||
|
|
||||||
|
;;; --- Link clicking ---------------------------------------------------------
|
||||||
|
|
||||||
|
(defun cell-link-at (fb x y)
|
||||||
|
"Return the link URL at (X Y) in framebuffer FB, or nil."
|
||||||
|
(cl-tty.rendering:fb-cell-link-url fb x y))
|
||||||
|
|
||||||
|
(defun open-link-at (fb x y)
|
||||||
|
"If there is a link URL at (X Y) in FB, open it via xdg-open."
|
||||||
|
(let ((url (cell-link-at fb x y)))
|
||||||
|
(when url
|
||||||
|
#+linux (sb-ext:run-program "xdg-open" (list url) :wait nil)
|
||||||
|
#+darwin (sb-ext:run-program "open" (list url) :wait nil))
|
||||||
|
url))
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
|
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no
|
||||||
@@ -101,11 +158,9 @@ module adds:
|
|||||||
(def-test selection-set-and-get ()
|
(def-test selection-set-and-get ()
|
||||||
(setf cl-tty.mouse::*selection* (make-selection :text "hello"))
|
(setf cl-tty.mouse::*selection* (make-selection :text "hello"))
|
||||||
(is (equal "hello" (get-selection))))
|
(is (equal "hello" (get-selection))))
|
||||||
#+END_SRC
|
|
||||||
|
|
||||||
** Selection tracking
|
;; ── Selection tracking ──────────────────────────────────────
|
||||||
|
|
||||||
#+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp
|
|
||||||
(def-test start-selection-initializes-state ()
|
(def-test start-selection-initializes-state ()
|
||||||
(start-selection 5 10)
|
(start-selection 5 10)
|
||||||
(is-true (selection-active-p))
|
(is-true (selection-active-p))
|
||||||
@@ -133,4 +188,5 @@ module adds:
|
|||||||
(let ((text (finalize-selection fb)))
|
(let ((text (finalize-selection fb)))
|
||||||
(is (equal "hello
|
(is (equal "hello
|
||||||
world" text)))))
|
world" text)))))
|
||||||
|
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
@@ -1,9 +1,12 @@
|
|||||||
(defpackage :cl-tty.mouse
|
(defpackage :cl-tty.mouse
|
||||||
(:use :cl :cl-tty.input :cl-tty.box)
|
(:use :cl :cl-tty.input :cl-tty.box :cl-tty.rendering)
|
||||||
(:export
|
(:export
|
||||||
#:mouse-mixin
|
#:mouse-mixin
|
||||||
#:on-mouse-down #:on-mouse-up #:on-mouse-move #:on-mouse-scroll
|
#:on-mouse-down #:on-mouse-up #:on-mouse-move #:on-mouse-scroll
|
||||||
#:handle-mouse-event
|
#:handle-mouse-event
|
||||||
#:hit-test
|
#:hit-test
|
||||||
#:selection #:get-selection #:copy-to-clipboard
|
#:selection #:get-selection #:copy-to-clipboard
|
||||||
#:make-selection #:selection-p))
|
#:make-selection #:selection-p
|
||||||
|
#:start-selection #:update-selection #:finalize-selection
|
||||||
|
#:selection-active-p
|
||||||
|
#:cell-link-at #:open-link-at))
|
||||||
|
|||||||
@@ -41,3 +41,57 @@
|
|||||||
#+linux (sb-ext:run-program "xclip" (list "-selection" "clipboard")
|
#+linux (sb-ext:run-program "xclip" (list "-selection" "clipboard")
|
||||||
:input text :wait nil)
|
:input text :wait nil)
|
||||||
#+darwin (sb-ext:run-program "pbcopy" nil :input text :wait nil))
|
#+darwin (sb-ext:run-program "pbcopy" nil :input text :wait nil))
|
||||||
|
|
||||||
|
;;; --- Selection tracking (mouse drag) ---------------------------------------
|
||||||
|
|
||||||
|
(defvar *selection-active* nil
|
||||||
|
"T when a drag selection is in progress.")
|
||||||
|
|
||||||
|
(defvar *selection-start* nil
|
||||||
|
"Cons (X . Y) of mouse-down position during drag.")
|
||||||
|
|
||||||
|
(defvar *selection-end* nil
|
||||||
|
"Cons (X . Y) of current mouse position during drag.")
|
||||||
|
|
||||||
|
(defun start-selection (x y)
|
||||||
|
"Begin a drag selection at (X Y)."
|
||||||
|
(setf *selection-start* (cons x y)
|
||||||
|
*selection-end* (cons x y)
|
||||||
|
*selection-active* t))
|
||||||
|
|
||||||
|
(defun update-selection (x y)
|
||||||
|
"Update the drag selection end position to (X Y)."
|
||||||
|
(setf *selection-end* (cons x y)))
|
||||||
|
|
||||||
|
(defun selection-active-p ()
|
||||||
|
"Return T if a drag selection is in progress."
|
||||||
|
*selection-active*)
|
||||||
|
|
||||||
|
(defun finalize-selection (fb)
|
||||||
|
"End the drag selection and extract text from the framebuffer."
|
||||||
|
(setf *selection-active* nil)
|
||||||
|
(when (and *selection-start* *selection-end* fb)
|
||||||
|
(let* ((x1 (car *selection-start*))
|
||||||
|
(y1 (cdr *selection-start*))
|
||||||
|
(x2 (car *selection-end*))
|
||||||
|
(y2 (cdr *selection-end*))
|
||||||
|
(text (cl-tty.rendering:extract-text fb x1 y1 x2 y2)))
|
||||||
|
(setf *selection* (make-selection :start-x x1 :start-y y1
|
||||||
|
:end-x x2 :end-y y2
|
||||||
|
:text text))
|
||||||
|
(setf *selection-start* nil *selection-end* nil)
|
||||||
|
text)))
|
||||||
|
|
||||||
|
;;; --- Link clicking ---------------------------------------------------------
|
||||||
|
|
||||||
|
(defun cell-link-at (fb x y)
|
||||||
|
"Return the link URL at (X Y) in framebuffer FB, or nil."
|
||||||
|
(cl-tty.rendering:fb-cell-link-url fb x y))
|
||||||
|
|
||||||
|
(defun open-link-at (fb x y)
|
||||||
|
"If there is a link URL at (X Y) in FB, open it via xdg-open."
|
||||||
|
(let ((url (cell-link-at fb x y)))
|
||||||
|
(when url
|
||||||
|
#+linux (sb-ext:run-program "xdg-open" (list url) :wait nil)
|
||||||
|
#+darwin (sb-ext:run-program "open" (list url) :wait nil))
|
||||||
|
url))
|
||||||
|
|||||||
@@ -175,6 +175,28 @@ Returns the number of changed cells."
|
|||||||
(end-sync backend))
|
(end-sync backend))
|
||||||
count))
|
count))
|
||||||
|
|
||||||
|
;;; --- Frame inspection ---------------------------------------------------
|
||||||
|
|
||||||
|
(defun fb-cell-link-url (fb x y)
|
||||||
|
"Return the link URL at (X Y) in framebuffer FB, or nil."
|
||||||
|
(when (and (arrayp fb) (>= y 0) (< y (array-dimension fb 0))
|
||||||
|
(>= x 0) (< x (array-dimension fb 1)))
|
||||||
|
(let ((c (aref fb y x)))
|
||||||
|
(cell-link-url c))))
|
||||||
|
|
||||||
|
(defun extract-text (fb x1 y1 x2 y2)
|
||||||
|
"Extract visible text from the rectangle between (X1,Y1) and (X2,Y2)."
|
||||||
|
(let ((x-min (min x1 x2)) (x-max (max x1 x2))
|
||||||
|
(y-min (min y1 y2)) (y-max (max y1 y2))
|
||||||
|
(h (if (arrayp fb) (array-dimension fb 0) 0))
|
||||||
|
(w (if (arrayp fb) (array-dimension fb 1) 0)))
|
||||||
|
(with-output-to-string (s)
|
||||||
|
(loop for y from y-min to (min y-max (1- h))
|
||||||
|
do (loop for x from x-min to (min x-max (1- w))
|
||||||
|
do (let ((c (aref fb y x)))
|
||||||
|
(princ (cell-char c) s)))
|
||||||
|
(when (< y y-max) (princ #\Newline s))))))
|
||||||
|
|
||||||
;;; ─── Scissor clipping ────────────────────────────────────────────────────────
|
;;; ─── Scissor clipping ────────────────────────────────────────────────────────
|
||||||
|
|
||||||
(defmacro with-scissor ((fb x y w h) &body body)
|
(defmacro with-scissor ((fb x y w h) &body body)
|
||||||
|
|||||||
@@ -16,7 +16,8 @@
|
|||||||
(setf cl-tty.mouse::*selection* (make-selection :text "hello"))
|
(setf cl-tty.mouse::*selection* (make-selection :text "hello"))
|
||||||
(is (equal "hello" (get-selection))))
|
(is (equal "hello" (get-selection))))
|
||||||
|
|
||||||
;; --- Selection tracking -------------------------------------------------
|
;; ── Selection tracking ──────────────────────────────────────
|
||||||
|
|
||||||
(def-test start-selection-initializes-state ()
|
(def-test start-selection-initializes-state ()
|
||||||
(start-selection 5 10)
|
(start-selection 5 10)
|
||||||
(is-true (selection-active-p))
|
(is-true (selection-active-p))
|
||||||
|
|||||||
Reference in New Issue
Block a user