;; TODO: -> options ??
(define default-cursor xc-X-cursor)
(define frame-size 3)

(define (create-resizer wm client)
  (let* ((dpy (wm:dpy wm))
	 (window (client:client-window client))
	 (gc (create-gc dpy (default-root-window dpy)
			(make-gc-value-alist
			 (foreground (white-pixel dpy))
			 (subwindow-mode (subwindow-mode include-inferiors))
			 (line-width frame-size)
			 (function (gc-function xor)))))
	 (cursors
	  (map (lambda (dir id)
		 (cons dir (create-font-cursor dpy id)))
	       '(west north-west north north-east east south-east south
		      south-west none)
	       (list xc-left-side xc-top-left-corner xc-top-side
		     xc-top-right-corner xc-right-side xc-bottom-right-corner
		     xc-bottom-side xc-bottom-left-corner default-cursor))))
    
    (spawn*
     (list 'move-wm-resizer wm client)
     (lambda (release)
       (call-with-event-channel
	dpy window
	(event-mask structure-notify
		    button-press button-release
		    pointer-motion)
	(lambda (event-channel)
	  (release)
	  (letrec
	      ((idle
		(lambda ()
		  (let ((xevent (receive event-channel)))
		    (cond
		     ((and (motion-event? xevent) (window-exists? dpy window))
		      (set-resize-cursor wm client cursors
					 (motion-event-x xevent)
					 (motion-event-y xevent))
		      (idle))
		     ((and (eq? (event-type button-press)
				(any-event-type xevent))
			   (window-exists? dpy window))
		      (let* ((x (button-event-x xevent))
			     (y (button-event-y xevent))
			     (dir (resizer-direction wm client x y)))
			(if (eq? dir 'none)
			    (idle)
			    (let ((r (root-rectangle dpy window)))
			      (grab-server dpy)
			      (rubber-draw dpy gc r)
			      (drag x y r r dir)))))
		     ((destroy-window-event? xevent) #t)
		     (else (idle))))))

	       (drag
		(lambda (start-x start-y start-r prev-rect dir)
		  (let ((xevent (receive event-channel)))
		    (cond
		     ((motion-event? xevent)
		      (let ((new-rect
			     (adjust-rect wm client start-r
					  (- (motion-event-x xevent) start-x)
					  (- (motion-event-y xevent) start-y)
					  dir)))
			(rubber-draw dpy gc prev-rect)
			(rubber-draw dpy gc new-rect)
			(drag start-x start-y start-r new-rect dir)))
		     ((eq? (event-type button-release)
			   (any-event-type xevent))
		      (rubber-draw dpy gc prev-rect)
		      (ungrab-server dpy)
		      (commit-resize wm client
				     (- (button-event-x xevent) start-x)
				     (- (button-event-y xevent) start-y)
				     dir)
		      (idle))
		     ((destroy-window-event? xevent) #t)
		     (else (drag start-x start-y start-r
				 prev-rect dir)))))))
	    (idle))))
       (free-gc dpy gc)
       (for-each (lambda (c) (free-cursor dpy (cdr c))) cursors)))
    window))

(define (destroy-resizer dpy resizer)
  (destroy-window dpy resizer))

(define (rubber-draw dpy gc rect)
  (draw-rectangle dpy (default-root-window dpy) gc
		  (rectangle:x rect) (rectangle:y rect)
		  (rectangle:width rect) (rectangle:height rect)))

(define (adjust-rect wm client sr dx dy dir)
  (let* ((w.h (maximal-size/hints (wm:dpy wm) (client:window client)
				  (+ (rectangle:width sr) dx)
				  (+ (rectangle:height sr) dy)))
	 (dx (- (car w.h) (rectangle:width sr)))
	 (dy (- (cdr w.h) (rectangle:height sr))))

    (case dir
      ((west)
       (make-rectangle (+ (rectangle:x sr) dx)
		       (rectangle:y sr)
		       (- (rectangle:width sr) dx)
		       (rectangle:height sr)))
      ((north-west)
       (make-rectangle (+ (rectangle:x sr) dx)
		       (+ (rectangle:y sr) dy)
		       (- (rectangle:width sr) dx)
		       (- (rectangle:height sr) dy)))
      ((north)
       (make-rectangle (rectangle:x sr)
		       (+ (rectangle:y sr) dy)
		       (rectangle:width sr)
		       (- (rectangle:height sr) dy)))
      ((north-east)
       (make-rectangle (rectangle:x sr)
		       (+ (rectangle:y sr) dy)
		       (+ (rectangle:width sr) dx)
		       (- (rectangle:height sr) dy)))
      ((east)
       (make-rectangle (rectangle:x sr)
		       (rectangle:y sr)
		       (+ (rectangle:width sr) dx)
		       (rectangle:height sr)))
      ((south-east)
       (make-rectangle (rectangle:x sr)
		       (rectangle:y sr)
		       (+ (rectangle:width sr) dx)
		       (+ (rectangle:height sr) dy)))
      ((south)
       (make-rectangle (rectangle:x sr)
		       (rectangle:y sr)
		       (rectangle:width sr)
		       (+ (rectangle:height sr) dy)))
      ((south-west)
       (make-rectangle (+ (rectangle:x sr) dx)
		       (rectangle:y sr)
		       (- (rectangle:width sr) dx)
		       (+ (rectangle:height sr) dy)))
      (else sr))))

(define (commit-resize wm client dx dy dir)
  (let* ((dpy (wm:dpy wm))
	 (win (client:client-window client))
	 (sr (window-rectangle dpy win))
	 (rect (adjust-rect wm client sr dx dy dir)))
    (move-resize-window dpy win
			(rectangle:x rect)
			(rectangle:y rect)
			(rectangle:width rect)
			(rectangle:height rect))))

(define (set-resize-cursor wm client cursors x y)
  (let* ((dpy (wm:dpy wm))
	 (c (assq (resizer-direction wm client x y) cursors)))
    (if c
	(define-cursor dpy (client:client-window client) (cdr c)))))

(define (resizer-direction wm client x y)
  (let* ((dpy (wm:dpy wm))
	 (win (client:client-window client))
	 (width (window-width dpy win))
	 (height (window-height dpy win))
	 (corner-size (get-option (wm:options wm) 'corner-width))
	 (fc-size (+ frame-size corner-size)))
    (let ((region-alist
	   (list (cons 'west
		       (list (make-rectangle 0 fc-size frame-size
					     (- height (* 2 fc-size)))))
		 (cons 'north-west
		       (list (make-rectangle 0 frame-size frame-size
					     corner-size)
			     (make-rectangle 0 0 frame-size frame-size)
			     (make-rectangle frame-size 0 corner-size
					     frame-size)))
		 (cons 'north
		       (list (make-rectangle fc-size 0 (- width (* 2 fc-size))
					     frame-size)))
		 (cons 'north-east
		       (list (make-rectangle (- width fc-size) 0 corner-size
					     frame-size)
			     (make-rectangle (- width frame-size) 0
					     frame-size frame-size)
			     (make-rectangle (- width frame-size) frame-size
					     frame-size corner-size)))
		 (cons 'east
		       (list (make-rectangle (- width frame-size) fc-size
					     frame-size
					     (- height (* 2 fc-size)))))
		 (cons 'south-east
		       (list (make-rectangle (- width frame-size)
					     (- height fc-size) frame-size
					     corner-size)
			     (make-rectangle (- width frame-size)
					     (- height frame-size)
					     frame-size frame-size)
			     (make-rectangle (- width fc-size)
					     (- height frame-size)
					     corner-size frame-size)))
		 (cons 'south
		       (list (make-rectangle fc-size (- height frame-size)
					     (- width (* 2 fc-size))
					     frame-size)))
		 (cons 'south-west
		       (list (make-rectangle frame-size
					     (- height frame-size) corner-size
					     frame-size)
			     (make-rectangle 0 (- width frame-size)
					     frame-size frame-size)
			     (make-rectangle 0 (- height fc-size)
					     frame-size corner-size))))))
      (let ((matches (filter (lambda (d.rs)
			       (any (lambda (r)
				      (point-in-rectangle? r x y))
				    (cdr d.rs)))
			     region-alist)))
	(if (null? matches)
	    'none
	    (car (car matches)))))))