scsh-conservatory
/
orion-wm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

changed initial-client-size calculation 

added algorithm to find a free position for a new window
This commit is contained in:
frese 2003-05-07 13:16:04 +00:00
parent a715599626
commit 75d449422a
1 changed files with 84 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

110
src/move-wm.scm
View File

@ -163,7 +163,7 @@
(define (init-client wm client maybe-rect)
(let ((dpy (wm:dpy wm)))
(let* ((r (initial-client-rect wm (client:window client) maybe-rect))
(let* ((r (initial-client-rect wm client maybe-rect))
(channel (make-channel))
(titlebar (create-client-titlebar channel wm client))
(resizer (create-resizer wm client))
@ -319,33 +319,91 @@
r light dark)))
(iota border-width))))))
(define (initial-client-rect wm win maybe-rect)
(if maybe-rect
maybe-rect
(let* ((dpy (wm:dpy wm))
(default-width 400)
(default-height 200)
(w.h-1
(let ((w.h (minimal-size/hints dpy win default-width
default-height)))
(cons (if (< default-width (car w.h))
(car w.h)
default-width)
(if (< default-height (cdr w.h))
(cdr w.h)
default-height))))
(w.h-2 (maximal-size/hints dpy win (car w.h-1) (cdr w.h-1)))
(w.h (desired-size/hints dpy win w.h-2))
;; TODO: look for a free position ?! Transients centered?
(maybe-x.y (find-free-position wm w.h (cons 0 0)))
(x.y (desired-position/hints dpy win maybe-x.y)))
(make-rectangle (car x.y) (cdr x.y)
(car w.h) (cdr w.h)))))
(define (initial-client-rect wm client maybe-rect)
(let* ((dpy (wm:dpy wm))
(win (client:window client))
(default-width (if maybe-rect (rectangle:width maybe-rect) 400))
(default-height (if maybe-rect (rectangle:height maybe-rect) 200))
(w.h (initial-client-size wm client default-width default-height))
;; TODO: Transients centered?
(maybe-x.y (find-free-position wm client w.h (cons 0 0)))
(x.y (desired-position/hints dpy win maybe-x.y)))
(make-rectangle (car x.y) (cdr x.y)
(car w.h) (cdr w.h))))
(define (find-free-position wm size default-pos)
(define (initial-client-size wm client default-width default-height)
(let* ((dpy (wm:dpy wm))
(win (client:window client))
(w.h-1
(let ((w.h (minimal-size/hints dpy win default-width
default-height)))
(cons (if (< default-width (car w.h))
(car w.h)
default-width)
(if (< default-height (cdr w.h))
(cdr w.h)
default-height))))
(w.h (maximal-size/hints dpy win (car w.h-1) (cdr w.h-1))))
;;(w.h (desired-size/hints dpy win w.h-2)))
w.h))
(define (find-free-position wm client size default-pos)
(let* ((dpy (wm:dpy wm))
(max-w (window-width dpy (wm:window wm)))
(max-h (window-height dpy (wm:window wm)))
(w (car size))
(h (cdr size)))
default-pos)) ;; TODO
(h (cdr size))
(rects (map (lambda (client)
(window-rectangle dpy (client:client-window client)))
(filter (lambda (c)
(and (not (eq? c client))
(not (client-data:icon c))))
(wm-clients wm))))
(list1 (map (lambda (x.y)
(make-rectangle (car x.y) (cdr x.y) w h))
(possible-positions rects)))
(list2 (filter (lambda (r) (rect-ok? r rects))
list1))
;; list2 may contain rects that are outside the wm
(list3 (filter (lambda (r)
(not (or (> (+ (rectangle:x r) (rectangle:width r))
max-w)
(> (+ (rectangle:y r) (rectangle:height r))
max-h))))
list2)))
(if (null? list3)
default-pos
(let ((r (car list3)))
(cons (rectangle:x r) (rectangle:y r))))))
;; possible positions are all rect-corners except the upper left, and
;; all intersection points of all bottom and right sides of the rects.
(define (possible-positions rects)
(let ((corners (flatten
(map (lambda (r)
(let* ((x1 (rectangle:x r))
(y1 (rectangle:y r))
(x2 (+ x1 (rectangle:width r)))
(y2 (+ y1 (rectangle:height r))))
(list (cons x1 y2)
;; (cons x2 y2) also included below
(cons x2 y1))))
rects)))
(xs (map (lambda (r)
(+ (rectangle:x r) (rectangle:width r)))
rects))
(ys (map (lambda (r)
(+ (rectangle:y r) (rectangle:height r)))
rects)))
(append (list (cons 0 0))
corners
(flatten (map (lambda (x)
(map (lambda (y) (cons x y))
ys))
xs)))))
;; it's ok if it does not overlap with any rect
(define (rect-ok? rect rects)
(not (any (lambda (r)
(rectangles-overlap? rect r))
rects)))