cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-02 04:36:43 +01:00
Code Issues

- fixed passing focus between windows.

Browse Source
This commit is contained in:
cage 2022-03-10 17:29:24 +01:00
parent 0389c090a7
commit 8c8c17b175
6 changed files with 211 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

131
src/2d-utils.lisp Normal file
View File

@ -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 <http://www.gnu.org/licenses/>.
(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)))))

2
src/filesystem-utils.lisp
View File

@ -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

25
src/package.lisp
View File

@ -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

38
src/ui-goodies.lisp
View File

@ -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

41
src/windows.lisp
View File

@ -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)

1
tinmop.asd
View File

@ -106,6 +106,7 @@
(:file "api-client")
(:file "api-pleroma")
(:file "hooks")
(:file "2d-utils")
(:file "windows")
(:file "notify-window")
(:file "suggestions-window")