(%trace ";resizer-motion-handler "resizer" "modifiers" "x" "y"\n")
(if (fix-resizer-dragging? resizer)
(if (equal? modifiers '(button1))
- (let ((geom (fix-widget-geometry resizer)))
- (let ((dx
- (if (fix-resizer-stack-vertical? resizer)
- 0
- ;; Before is left; if pointer is right of the
- ;; middle (at greater X), the before widget
- ;; should grow.
- (fix:- x (fix:quotient (fix-rect-width geom) 2))))
- (dy
- (if (fix-resizer-stack-vertical? resizer)
- ;; After is above; if pointer is below start
- ;; (at greater Y), resizee should grow.
- (fix:- y (fix:quotient (fix-rect-height geom) 2))
- 0)))
-
- (define (adjust widget dx dy)
- (let ((w.h (gtk-widget-get-size widget)))
- (let ((w (fix:max 5 (fix:+ (car w.h) dx)))
- (h (fix:max 5 (fix:+ (cdr w.h) dy))))
- (%trace "; resizing "widget" to "w"x"h"\n")
- (gtk-widget-set-size-request widget w h))))
-
- (without-interrupts
- (lambda ()
- (adjust (fix-resizer-before resizer)
- dx dy)
- (adjust (fix-resizer-after resizer)
- (fix:* -1 dx) (fix:* -1 dy))))))
+ (let ((geom (fix-widget-geometry resizer))
+ (before (fix-resizer-before resizer))
+ (after (fix-resizer-after resizer)))
+ (let ((w.h-before (gtk-widget-get-size before))
+ (w.h-after (gtk-widget-get-size after)))
+
+ (define-integrable adjust!
+ (named-lambda (adjust! dx dy)
+ (if (not (and (fix:zero? dx) (fix:zero? dy)))
+ (begin
+ (let ((w (fix:+ (car w.h-before) dx))
+ (h (fix:+ (cdr w.h-before) dy)))
+ (%trace "; resizing "before" to "w"x"h"\n")
+ (gtk-widget-set-size-request before w h))
+ (let ((w (fix:- (car w.h-after) dx))
+ (h (fix:- (cdr w.h-after) dy)))
+ (%trace "; resizing "after" to "w"x"h"\n")
+ (gtk-widget-set-size-request after w h))))))
+
+ (if (fix-resizer-stack-vertical? resizer)
+
+ (let* ((y-middle (fix:quotient (fix-rect-height geom) 2))
+ ;; Before is above; if pointer is below the middle
+ ;; (at greater Y), the before widget should grow.
+ (dy (fix:- y y-middle))
+ ;; Neither widget should be sized too small.
+ (dy-clamped
+ (if (fix:< 0 dy)
+ ;; After should get only so small.
+ (let ((dy-max
+ (fix:max 0
+ (fix:- (cdr w.h-after) 5))))
+ (fix:min dy dy-max))
+ ;; Before should get only so small.
+ (let ((dy-min
+ (fix:min 0
+ (fix:*
+ -1 (fix:- (cdr w.h-before) 5)))))
+ (fix:max dy-min dy)))))
+ (adjust! 0 dy-clamped))
+
+ (let* ((x-middle (fix:quotient (fix-rect-width geom) 2))
+ ;; Before is left; if pointer is right of the
+ ;; middle (at greater X), the before widget
+ ;; should grow.
+ (dx (fix:- x x-middle))
+ (dx-clamped
+ (if (fix:< 0 dx)
+ ;; After should get only so small.
+ (let ((dx-max
+ (fix:max 0
+ (fix:- (car w.h-after) 5))))
+ (fix:min dx dx-max))
+ ;; Before should get only so small.
+ (let ((dx-min
+ (fix:max 0
+ (fix:- (car w.h-before) 5))))
+ (fix:max dx-min dx)))))
+ (adjust! dx-clamped 0)))))
(begin
(%trace "; drag dropped!\n")
(C-call "gtk_grab_remove" (gobject-alien resizer))