(define-record-type icon :icon
  (make-icon wm client window)
  icon?
  (wm icon:wm)
  (client icon:client)
  (window icon:window))

(define (create-icon wm client rect)
  (let* ((dpy (wm:dpy wm))
	 (window (create-simple-window dpy (wm:window wm)
				       (rectangle:x rect) (rectangle:y rect)
				       (rectangle:width rect)
				       (rectangle:height rect)
				       0
				       (black-pixel dpy) (white-pixel dpy)))
	 (gc (create-gc dpy window
			(make-gc-value-alist
			 (foreground (black-pixel dpy))
			 (background (white-pixel dpy))))))
    (spawn*
     (list 'move-wm-icon wm client window)
     (lambda (release)
       (call-with-current-continuation
	(lambda (exit)
	  (call-with-event-channel
	   dpy window (event-mask exposure
				  structure-notify
				  button-press)
	   (lambda (event-channel)
	     (release)
	     (let loop ()
	       (let ((xevent (receive event-channel)))
		 (cond
		  ((destroy-window-event? xevent) (exit 'destroyed))

		  ((expose-event? xevent)
		   (if (= 0 (expose-event-count xevent))
		       (draw-icon dpy window gc client)))

		  ((and (button-event? xevent)
			(eq? (event-type button-press)
			     (button-event-type xevent)))
		   (send (wm:internal-out-channel wm)
			 (list 'normalize-client client))
		   (exit 'normalized)))
		 (loop)))))))
       (free-gc dpy gc)))
    (make-icon wm client window)))

(define (map-icon icon)
  (map-window (wm:dpy (icon:wm icon)) (icon:window icon)))

(define (destroy-icon icon)
  (destroy-window (wm:dpy (icon:wm icon)) (icon:window icon)))

(define (draw-icon dpy window gc client)
  (let ((title (client-name dpy client)) ;; or WM_ICON_NAME ??
	(r (clip-rectangle dpy window)))
    (draw-image-string dpy window gc 2 14 title)))

(define (find-icon-rect wm-rect icons)
  (let* ((icon-w 200)
	 (icon-h 18)
	 (xs (iota (quotient (rectangle:width wm-rect) icon-w)))
	 (ys (reverse (iota (quotient (rectangle:height wm-rect) icon-h))))
	 (all (flatten (map (lambda (yi)
			      (map (lambda (xi)
				     (make-rectangle (* xi icon-w)
						     (* yi icon-h)
						     icon-w icon-h))
				   xs))
			    ys)))
	 (icon-rects (map (lambda (i)
			    (window-rectangle (wm:dpy (icon:wm i))
					      (icon:window i)))
			  icons))
	 (free (filter (lambda (r)
			 (not (any (lambda (ir)
				     (rectangles-overlap? r ir))
				   icon-rects)))
		       all)))
    (if (null? free)
	(if (null? all)
	    (make-rectangle 0 0 icon-w icon-h)
	    (car all))
	(car free))))