From 8c8c17b1759e4c80000a9fb7783352e554e89ffd Mon Sep 17 00:00:00 2001 From: cage Date: Thu, 10 Mar 2022 17:29:24 +0100 Subject: [PATCH] - fixed passing focus between windows. --- src/2d-utils.lisp | 131 ++++++++++++++++++++++++++++++++++++++ src/filesystem-utils.lisp | 2 +- src/package.lisp | 25 ++++++++ src/ui-goodies.lisp | 38 ++++------- src/windows.lisp | 41 ++++++++++++ tinmop.asd | 1 + 6 files changed, 211 insertions(+), 27 deletions(-) create mode 100644 src/2d-utils.lisp diff --git a/src/2d-utils.lisp b/src/2d-utils.lisp new file mode 100644 index 0000000..b849c82 --- /dev/null +++ b/src/2d-utils.lisp @@ -0,0 +1,131 @@ +;; tinmop: an humble gemini and pleroma client +;; Copyright (C) 2022 cage + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +(in-package :2d-utils) + +(defun iaabb2-min-x (aabb) + (elt aabb 0)) + +(defun iaabb2-max-x (aabb) + (elt aabb 2)) + +(defun iaabb2-min-y (aabb) + (elt aabb 1)) + +(defun iaabb2-max-y (aabb) + (elt aabb 3)) + +(defun make-iaabb2 (min-x min-y max-x max-y) + (list min-x min-y max-x max-y)) + +(defun iaabb2~ (a b) + (and + (= (elt a 0) (elt b 0)) + (= (elt a 1) (elt b 1)) + (= (elt a 2) (elt b 2)) + (= (elt a 3) (elt b 3)))) + +(defun valid-iaabb2 (aabb) + (and (>= (elt aabb 0) 0) + (>= (elt aabb 1) 0) + (>= (elt aabb 2) 0) + (>= (elt aabb 3) 0) + (> (elt aabb 2) (elt aabb 0)) + (> (elt aabb 3) (elt aabb 1)))) + +(defun expand-iaabb2 (aabb coord) + (let ((cp (copy-list aabb))) + (when (< (elt coord 0) (elt aabb 0)) + (setf (elt cp 0) (elt coord 0))) + (when (> (elt coord 0) (elt aabb 2)) + (setf (elt cp 2) (elt coord 0))) + (when (< (elt coord 1) (elt aabb 1)) + (setf (elt cp 1) (elt coord 1))) + (when (> (elt coord 1) (elt aabb 3)) + (setf (elt cp 3) (elt coord 1))) + cp)) + +(defun union-iaabb2 (aabb aabb2) + (let ((cp (copy-list aabb))) + (setf cp (expand-iaabb2 cp (subseq aabb2 0 2))) + (setf cp (expand-iaabb2 cp (list (elt aabb2 2) (elt aabb2 1)))) + (setf cp (expand-iaabb2 cp (list (elt aabb2 2) (elt aabb2 3)))) + (setf cp (expand-iaabb2 cp (list (elt aabb2 0) (elt aabb2 3)))) + cp)) + +(defun iaabb2->irect2 (coords) + "(upper-left-x upper-left-y bottom-right-x bottom-right-y) to + (upper-left-x upper-left-y w h)" + (let ((x1 (elt coords 0)) + (y1 (elt coords 1)) + (x2 (elt coords 2)) + (y2 (elt coords 3))) + (list x1 y1 (- x2 x1) (- y2 y1)))) + +(defun irect2->iaabb2 (coords) + "(upper-left-x upper-left-y w h) to + (upper-left-x upper-left-y bottom-right-x bottom-right-y)" + (let ((x1 (elt coords 0)) + (y1 (elt coords 1)) + (w (elt coords 2)) + (h (elt coords 3))) + (list x1 y1 (+ x1 w) (+ y1 h)))) + +(defun irect2->iaabb2* (&rest coords) + (irect2->iaabb2 coords)) + +(defun inside-iaabb2-p (aabb x y) + "t if x y is inside this bounding box + aabb is: (upper-left-x upper-left-y bottom-right-x bottom-right-y)" + (and + (>= x (elt aabb 0)) + (<= x (elt aabb 2)) + (>= y (elt aabb 1)) + (<= y (elt aabb 3)))) + +(defun iaabb2-intersect-p (aabb1 aabb2) + (if (or (>= (iaabb2-min-x aabb1) (iaabb2-max-x aabb2)) + (<= (iaabb2-max-x aabb1) (iaabb2-min-x aabb2)) + (>= (iaabb2-min-y aabb1) (iaabb2-max-y aabb2)) + (<= (iaabb2-max-y aabb1) (iaabb2-min-y aabb2))) + nil + t)) + +(defun iaabb2-inglobe-p (host guest) + (and (inside-iaabb2-p host (iaabb2-min-x guest) (iaabb2-min-x guest)) + (inside-iaabb2-p host (iaabb2-max-x guest) (iaabb2-max-x guest)))) + +(defun iaabb2-null-p (aabb) + (let ((rect (iaabb2->irect2 aabb))) + (and (= 0 (elt rect 2)) + (= 0 (elt rect 3))))) + +(defun trasl-iaabb2 (aabb &optional (dx (- (elt aabb 0))) (dy (- (elt aabb 1)))) + (list (+ (elt aabb 0) dx) + (+ (elt aabb 1) dy) + (+ (elt aabb 2) dx) + (+ (elt aabb 3) dy))) + +(defun trasl-irect2 (rect &optional (dx (- (elt rect 0))) (dy (- (elt rect 1)))) + (list (+ (elt rect 0) dx) + (+ (elt rect 1) dy) + (elt rect 2) + (elt rect 3))) + +(defun center-iaabb2 (aabb) + (let ((rect (iaabb2->irect2 aabb))) + (list (+ (elt rect 0) (/ (elt rect 2) 2)) + (+ (elt rect 1) (/ (elt rect 3) 2))))) diff --git a/src/filesystem-utils.lisp b/src/filesystem-utils.lisp index 13a27b9..0b25df5 100644 --- a/src/filesystem-utils.lisp +++ b/src/filesystem-utils.lisp @@ -1,5 +1,5 @@ ;; tinmop: an humble gemini and pleroma client -;; Copyright (C) 2020 cage +;; Copyright (C) 2022 cage ;; This program is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by diff --git a/src/package.lisp b/src/package.lisp index 7ab48fb..7f12943 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -1715,6 +1715,29 @@ :help-fields-get-text :print-help)) +(defpackage :2d-utils + (:use :cl) + (:export + :iaabb2-min-x + :iaabb2-max-x + :iaabb2-min-y + :iaabb2-max-y + :make-iaabb2 + :iaabb2~ + :valid-iaabb2 + :expand-iaabb2 + :union-iaabb2 + :iaabb2->irect2 + :irect2->iaabb2 + :irect2->iaabb2* + :inside-iaabb2-p + :iaabb2-intersect-p + :iaabb2-inglobe-p + :iaabb2-null-p + :trasl-iaabb2 + :trasl-irect2 + :center-iaabb2)) + (defpackage :windows (:use :cl @@ -1785,6 +1808,8 @@ :refresh-config-sizes :calculate :draw + :aabb + :remove-intersecting-window :draw-all :refresh-config-all :calculate-all diff --git a/src/ui-goodies.lisp b/src/ui-goodies.lisp index 046744a..d2404be 100644 --- a/src/ui-goodies.lisp +++ b/src/ui-goodies.lisp @@ -622,32 +622,18 @@ along the focused window." (defun pass-focus-next () "Move focus to next window in left to right writing order." - (flet ((filter (fn) - (let ((all (stack:stack-select windows::*window-stack* fn))) - (remove-if (lambda (w) (or (eq w (main-window:focused-window *main-window*)) - (eq w *command-window*))) - all)))) - (let* ((window (main-window:focused-window *main-window*)) - (x-focused (win-x window)) - (y-focused (win-y window)) - (w-focused (1- (win-width window))) - (h-focused (1- (win-height window))) - (all-windows-on-right (filter (lambda (w) (> (win-x w) - (+ x-focused w-focused))))) - (all-windows-on-bottom (filter (lambda (w) (> (win-y w) - (+ y-focused - h-focused)))))) - (cond - ((and (null all-windows-on-right) ; bottom left corner - (null all-windows-on-bottom)) - (pass-focus-top-most) - (pass-focus-far-left :slide-to-top t)) - ((null all-windows-on-right) ; left side - (pass-focus-far-left :slide-to-top t) - (or (pass-focus-on-bottom) - (pass-focus-on-right :slide-to-top nil))) - (t - (pass-focus-on-right)))))) + (let* ((visible-sorted-window (windows:remove-intersecting-window)) + (focused-window (main-window:focused-window *main-window*)) + (focused-position (position focused-window visible-sorted-window)) + (next-window-position (rem (1+ focused-position) (length visible-sorted-window))) + (next-focused-window (elt visible-sorted-window next-window-position))) + (if (not (window-focused-pinned-p)) + (progn + (remove-focus-to-all-windows) + (give-focus next-focused-window nil)) + (progn + (warn-pinned-window) + nil)))) (defmacro gen-focus-to-window (function-suffix window-get-focus &key diff --git a/src/windows.lisp b/src/windows.lisp index 8b8589d..c4f7e14 100644 --- a/src/windows.lisp +++ b/src/windows.lisp @@ -266,6 +266,8 @@ height, position and so on)" (defgeneric draw (object) (:documentation "Draw object")) +(defgeneric aabb (object)) + (defmethod refresh-config (object) object) @@ -333,6 +335,45 @@ height, position and so on)" (declare (ignore object)) t) +(defmethod aabb ((object wrapper-window)) + (let ((x (win-x object)) + (y (win-y object)) + (w (win-width object)) + (h (win-height object))) + (2d-utils:make-iaabb2 x y (1- (+ x w)) (1- (+ y h))))) + +(defun remove-intersecting-window () + (labels ((copy-subwindows-stack () + (let ((copy '()) + (discarded-window-type '(main-window::main-window + command-window:command-window + notify-window:notify-window))) + (do-stack-element (w *window-stack*) + (when (and (win-visible-p w) + (not (find-if (lambda (a) (typep w a)) + discarded-window-type))) + (push w copy))) + copy)) + (%remove-intersecting-window (&optional + (windows (copy-subwindows-stack)) + (checked '())) + (if (null windows) + checked + (let* ((probe-window (first windows)) + (aabb-probe (aabb probe-window))) + (setf windows (remove probe-window windows)) + (loop for i in windows do + (let ((aabb (aabb i))) + (when (2d-utils:iaabb2-intersect-p aabb-probe aabb) + (setf windows (remove i windows))))) + (%remove-intersecting-window windows (push probe-window checked)))))) + (let ((visible-windows (%remove-intersecting-window))) + (sort visible-windows + (lambda (a b) + (if (= (win-y a) (win-y b)) + (< (win-x a) (win-x b)) + (< (win-y a) (win-y b)))))))) + (defun calculate-all (dt) (do-stack-element (window *window-stack*) (when (win-visible-p window) diff --git a/tinmop.asd b/tinmop.asd index fc998f5..1e26e67 100644 --- a/tinmop.asd +++ b/tinmop.asd @@ -106,6 +106,7 @@ (:file "api-client") (:file "api-pleroma") (:file "hooks") + (:file "2d-utils") (:file "windows") (:file "notify-window") (:file "suggestions-window")