284 lines
8.9 KiB
Scheme
284 lines
8.9 KiB
Scheme
(define-options-spec split-wm-options-spec
|
|
(orientation symbol 'horizontal) ;; horizontal | vertical
|
|
(aspect number 1/1)
|
|
(bar-width int 3)
|
|
(resize-step int 5)
|
|
(bar-style symbol 'raised) ;; raised | sunken | flat
|
|
(bar-colors colors '("#dddddd" "#888888" "#333333"))
|
|
)
|
|
|
|
;; ---------- ----------
|
|
;; | | | | |
|
|
;; ---------- vertical | | | horizontal
|
|
;; | | | | |
|
|
;; ---------- ----------
|
|
|
|
(define (create-split-wm external-in-channel dpy parent options . children)
|
|
(create-wm dpy parent options children
|
|
(manager-type split) split-wm-options-spec
|
|
external-in-channel
|
|
(lambda (wm in-channel)
|
|
(spawn (lambda ()
|
|
(split-wm-handler wm in-channel)))
|
|
wm)))
|
|
|
|
(define (split-wm-handler wm channel)
|
|
(let ((resizer-window (create-resizer wm)))
|
|
(map-window (wm:dpy wm) resizer-window)
|
|
(let loop ()
|
|
(let ((msg (receive channel)))
|
|
(case (car msg)
|
|
((draw-main-window) #t)
|
|
|
|
((fit-windows)
|
|
(fit-windows wm resizer-window))
|
|
|
|
((init-client)
|
|
(init-client wm (second msg) (third msg)))
|
|
|
|
((deinit-client)
|
|
(deinit-client wm (second msg)))
|
|
|
|
((draw-client-window) #t)
|
|
|
|
((fit-client)
|
|
;; client-window changed it's size
|
|
(fit-client-windows wm (second msg)))
|
|
|
|
((fit-client-window)
|
|
;; client changed it's size ??
|
|
(fit-client-window wm (second msg)))
|
|
|
|
((update-client-state) #t)
|
|
))
|
|
(loop))))
|
|
|
|
;(define (draw-main-window wm gc)
|
|
; (let* ((dpy (wm:dpy wm))
|
|
; (options (wm:options wm))
|
|
; (colors (get-option-value options 'bar-colors))
|
|
; (bar-style (get-option-value options 'bar-style))
|
|
; (rects (calc-rectangles wm))
|
|
; (bar-rect (second rects))
|
|
; (win (wm:window wm))
|
|
; (x1 (rectangle:x bar-rect))
|
|
; (y1 (rectangle:y bar-rect))
|
|
; (x2 (+ (rectangle:x bar-rect) (rectangle:width bar-rect) -1))
|
|
; (y2 (+ (rectangle:y bar-rect) (rectangle:height bar-rect) -1)))
|
|
; (mdisplay "bar drawing: " bar-rect "\n")
|
|
; (set-gc-foreground! dpy gc (second colors))
|
|
; (fill-rectangle dpy win gc x1 y1
|
|
; (rectangle:width bar-rect) (rectangle:height bar-rect))
|
|
; (if (and #f (not (eq? bar-style 'flat)))
|
|
; (let ((light (if (eq? bar-style 'raised)
|
|
; (first colors)
|
|
; (third colors)))
|
|
; (dark (if (eq? bar-style 'raised)
|
|
; (third colors)
|
|
; (first colors))))
|
|
; (set-gc-line-width! dpy gc 1)
|
|
; (set-gc-foreground! dpy gc light)
|
|
; (draw-lines dpy win gc (list (cons x1 y2) (cons x1 y1) (cons x2 y1))
|
|
; (coord-mode origin))
|
|
; (set-gc-foreground! dpy gc dark)
|
|
; (draw-lines dpy win gc (list (cons x2 (+ y1 1)) (cons x2 y2)
|
|
; (cons x1 y2))
|
|
; (coord-mode origin))))))
|
|
|
|
(define (calc-rectangles wm)
|
|
(let* ((options (wm:options wm))
|
|
(bar-width (get-option-value options 'bar-width))
|
|
(orientation (get-option-value options 'orientation))
|
|
(aspect (get-option-value options 'aspect))
|
|
(r (clip-rectangle (wm:dpy wm) (wm:window wm))))
|
|
(mdisplay "calc-rects: aspect " aspect "\n")
|
|
(if (eq? orientation 'horizontal)
|
|
(let* ((r1 (make-rectangle 0 0
|
|
(floor (/ (- (rectangle:width r) bar-width)
|
|
(+ 1 (/ 1 aspect))))
|
|
(rectangle:height r)))
|
|
(r2 (make-rectangle (rectangle:width r1) 0
|
|
bar-width (rectangle:height r)))
|
|
(r3 (make-rectangle (+ (rectangle:width r1) bar-width) 0
|
|
(- (rectangle:width r)
|
|
(+ (rectangle:width r1) bar-width))
|
|
(rectangle:height r))))
|
|
(list r1 r2 r3))
|
|
(let* ((r1 (make-rectangle 0 0 (rectangle:width r)
|
|
(floor (/ (- (rectangle:height r) bar-width)
|
|
(+ 1 (/ 1 aspect))))))
|
|
(r2 (make-rectangle 0 (rectangle:height r1)
|
|
(rectangle:width r) bar-width))
|
|
(r3 (make-rectangle 0 (+ (rectangle:height r1) bar-width)
|
|
(rectangle:width r)
|
|
(- (rectangle:height r)
|
|
(+ (rectangle:height r1) bar-width)))))
|
|
(list r1 r2 r3)))))
|
|
|
|
(define (fit-windows wm resizer-window)
|
|
(let* ((rects (calc-rectangles wm))
|
|
(clients (wm-clients wm))
|
|
(dpy (wm:dpy wm)))
|
|
(mdisplay "splitter rects: " rects "\n")
|
|
(move-resize-window* dpy resizer-window (second rects))
|
|
(if (and (pair? clients) (pair? (cdr clients)))
|
|
(move-resize-window* dpy
|
|
(client:client-window (second clients))
|
|
(first rects)))
|
|
(if (pair? clients)
|
|
(move-resize-window* dpy
|
|
(client:client-window (first clients))
|
|
(third rects)))))
|
|
|
|
(define (init-client wm client maybe-rect)
|
|
(let* ((rects (calc-rectangles wm))
|
|
(r (if (> (length (wm-clients wm)) 1)
|
|
(third rects)
|
|
(first rects))))
|
|
(let ((dpy (wm:dpy wm))
|
|
(options (wm:options wm)))
|
|
(set-window-border-width! dpy (client:window client) 0)
|
|
(move-resize-window* dpy (client:client-window client) r)
|
|
|
|
(map-window dpy (client:client-window client))
|
|
;;(select-client wm client))) ??
|
|
)))
|
|
|
|
(define (deinit-client wm client)
|
|
(let ((dpy (wm:dpy wm)))
|
|
;; maybe destroy-wm ?? TODO
|
|
#t))
|
|
|
|
(define (fit-client-windows wm client)
|
|
(let ((dpy (wm:dpy wm)))
|
|
(maximize-window dpy (client:window client))))
|
|
|
|
(define (fit-client-window wm client)
|
|
#t)
|
|
|
|
;; *******************************************************************
|
|
;; Resizer
|
|
;; *******************************************************************
|
|
|
|
(define (create-resizer wm)
|
|
(let* ((dpy (wm:dpy wm))
|
|
(main-window (wm:window wm))
|
|
(options (wm:options wm))
|
|
(window (create-simple-window dpy main-window 0 0 1 1 0
|
|
(white-pixel dpy) (black-pixel dpy)))
|
|
(root (window-root dpy window))
|
|
(gc (create-gc dpy window '()))
|
|
(root-gc (create-gc dpy window
|
|
(make-gc-value-alist
|
|
(function (gc-function xor))
|
|
(subwindow-mode (subwindow-mode
|
|
include-inferiors)))))
|
|
(cursor (create-font-cursor
|
|
dpy (if (eq? (get-option-value options 'orientation)
|
|
'horizontal)
|
|
xc-sb-h-double-arrow
|
|
xc-sb-v-double-arrow))))
|
|
(set-window-cursor! dpy window cursor)
|
|
(spawn*
|
|
(lambda (release)
|
|
(call-with-event-channel
|
|
dpy window (event-mask structure-notify
|
|
exposure
|
|
button-press button-release
|
|
button-1-motion)
|
|
(lambda (event-channel)
|
|
(release)
|
|
(letrec
|
|
((idle (lambda ()
|
|
(let* ((e (receive event-channel))
|
|
(type (any-event-type e)))
|
|
(cond
|
|
((eq? (event-type button-press) type)
|
|
(let ((r (root-rectangle dpy window)))
|
|
(grab-server dpy)
|
|
(draw-resizer r)
|
|
(drag r r (button-event-x e) (button-event-y e))))
|
|
((expose-event? e)
|
|
(draw-resizer-window)
|
|
(idle))
|
|
((destroy-window-event? e) #t)
|
|
(else (idle))))))
|
|
(drag (lambda (start-rect last-rect start-x start-y)
|
|
(let* ((e (receive event-channel))
|
|
(type (any-event-type e)))
|
|
(cond
|
|
((motion-event? e)
|
|
(draw-resizer last-rect)
|
|
(let ((new-rect (calc-new-rect
|
|
start-rect
|
|
(- (motion-event-x e) start-x)
|
|
(- (motion-event-y e) start-y))))
|
|
(draw-resizer new-rect)
|
|
(drag start-rect new-rect start-x start-y)))
|
|
((eq? (event-type button-release) type)
|
|
(draw-resizer last-rect)
|
|
(ungrab-server dpy)
|
|
(commit-resize (- (button-event-x e) start-x)
|
|
(- (button-event-y e) start-y))
|
|
(idle))
|
|
((expose-event? e)
|
|
(draw-resizer-window)
|
|
(drag start-rect last-rect start-x start-y))
|
|
((destroy-window-event? e) #t)
|
|
(else
|
|
(drag start-rect last-rect start-x start-y))))))
|
|
|
|
(draw-resizer
|
|
(lambda (rect)
|
|
(draw dpy root root-gc rect)))
|
|
(draw-resizer-window
|
|
(lambda ()
|
|
(draw dpy window gc (clip-rectangle dpy window))))
|
|
(commit-resize
|
|
(lambda (dx dy)
|
|
;; check if outside... TODO
|
|
(let* ((rects (calc-rectangles wm))
|
|
(r1 (first rects)) (r2 (third rects))
|
|
(aspect
|
|
(if (eq? 'horizontal
|
|
(get-option-value options 'orientation))
|
|
(if (= 0 (- (rectangle:width r2) dx))
|
|
0
|
|
(/ (+ (rectangle:width r1) dx)
|
|
(- (rectangle:width r2) dx)))
|
|
(if (= 0 (- (rectangle:height r2) dy))
|
|
0
|
|
(/ (+ (rectangle:height r1) dy)
|
|
(- (rectangle:height r2) dy))))))
|
|
(if (> aspect 0)
|
|
(begin
|
|
(set-option! options 'aspect aspect)
|
|
(fit-windows wm window))))))
|
|
(calc-new-rect
|
|
(lambda (start-rect dx dy)
|
|
(let ((width (rectangle:width start-rect))
|
|
(height (rectangle:height start-rect)))
|
|
(if (eq? (get-option-value options 'orientation)
|
|
'horizontal)
|
|
(make-rectangle (+ (rectangle:x start-rect) dx)
|
|
(rectangle:y start-rect)
|
|
width height)
|
|
(make-rectangle (rectangle:x start-rect)
|
|
(+ (rectangle:y start-rect) dy)
|
|
width height)))))
|
|
(draw
|
|
(lambda (dpy window gc r)
|
|
(let ((colors (get-option-value options 'bar-colors)))
|
|
(set-gc-foreground! dpy gc (second colors))
|
|
(fill-rectangle dpy window gc
|
|
(rectangle:x r) (rectangle:y r)
|
|
(rectangle:width r) (rectangle:height r))
|
|
;; Rest ??
|
|
)))
|
|
)
|
|
(idle)
|
|
(free-cursor dpy cursor)
|
|
(free-gc dpy gc)
|
|
(free-gc dpy root-gc))))))
|
|
window))
|