From 1ba298e705b97683a9ef38de7d5efb931a44bc9c Mon Sep 17 00:00:00 2001 From: Hermes Date: Mon, 11 May 2026 22:43:49 +0000 Subject: [PATCH] v0.14.0: sync org files with mouse selection and framebuffer inspection --- org/framebuffer.org | 26 ++++++++++++ org/mouse.org | 68 ++++++++++++++++++++++++++++--- src/components/mouse-package.lisp | 7 +++- src/components/mouse.lisp | 54 ++++++++++++++++++++++++ src/rendering/framebuffer.lisp | 22 ++++++++++ tests/mouse-tests.lisp | 3 +- 6 files changed, 171 insertions(+), 9 deletions(-) diff --git a/org/framebuffer.org b/org/framebuffer.org index cf4455e..b9fe675 100644 --- a/org/framebuffer.org +++ b/org/framebuffer.org @@ -306,6 +306,32 @@ Returns the number of changed cells." count)) #+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 #+BEGIN_SRC lisp :tangle ../src/rendering/framebuffer.lisp diff --git a/org/mouse.org b/org/mouse.org index df3bba6..38c6a18 100644 --- a/org/mouse.org +++ b/org/mouse.org @@ -27,14 +27,17 @@ module adds: #+BEGIN_SRC lisp :tangle ../src/components/mouse-package.lisp :noweb no (defpackage :cl-tty.mouse - (:use :cl :cl-tty.input :cl-tty.box) + (:use :cl :cl-tty.input :cl-tty.box :cl-tty.rendering) (:export #:mouse-mixin #:on-mouse-down #:on-mouse-up #:on-mouse-move #:on-mouse-scroll #:handle-mouse-event #:hit-test #: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 #+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") :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 #+BEGIN_SRC lisp :tangle ../tests/mouse-tests.lisp :noweb no @@ -101,11 +158,9 @@ module adds: (def-test selection-set-and-get () (setf cl-tty.mouse::*selection* (make-selection :text "hello")) (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 () (start-selection 5 10) (is-true (selection-active-p)) @@ -133,4 +188,5 @@ module adds: (let ((text (finalize-selection fb))) (is (equal "hello world" text))))) -#+END_SRC + +#+END_SRC \ No newline at end of file diff --git a/src/components/mouse-package.lisp b/src/components/mouse-package.lisp index df13a1d..9cc2706 100644 --- a/src/components/mouse-package.lisp +++ b/src/components/mouse-package.lisp @@ -1,9 +1,12 @@ (defpackage :cl-tty.mouse - (:use :cl :cl-tty.input :cl-tty.box) + (:use :cl :cl-tty.input :cl-tty.box :cl-tty.rendering) (:export #:mouse-mixin #:on-mouse-down #:on-mouse-up #:on-mouse-move #:on-mouse-scroll #:handle-mouse-event #:hit-test #: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)) diff --git a/src/components/mouse.lisp b/src/components/mouse.lisp index b06200f..9a6aee0 100644 --- a/src/components/mouse.lisp +++ b/src/components/mouse.lisp @@ -41,3 +41,57 @@ #+linux (sb-ext:run-program "xclip" (list "-selection" "clipboard") :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)) diff --git a/src/rendering/framebuffer.lisp b/src/rendering/framebuffer.lisp index 67012d8..8526a68 100644 --- a/src/rendering/framebuffer.lisp +++ b/src/rendering/framebuffer.lisp @@ -175,6 +175,28 @@ Returns the number of changed cells." (end-sync backend)) 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 ──────────────────────────────────────────────────────── (defmacro with-scissor ((fb x y w h) &body body) diff --git a/tests/mouse-tests.lisp b/tests/mouse-tests.lisp index 8540c1f..7d3a90f 100644 --- a/tests/mouse-tests.lisp +++ b/tests/mouse-tests.lisp @@ -16,7 +16,8 @@ (setf cl-tty.mouse::*selection* (make-selection :text "hello")) (is (equal "hello" (get-selection)))) -;; --- Selection tracking ------------------------------------------------- +;; ── Selection tracking ────────────────────────────────────── + (def-test start-selection-initializes-state () (start-selection 5 10) (is-true (selection-active-p))