;; -*- indent-tabs-mode: nil -*-
;;
;; File: repel.jl
;; Version: $Revision: 1.3 $
;; Description: 
;;     OK, this is just plain silly.
;;
;;     This teaches windows to hate each other.  They'll push each other out of
;;     the way.  Over time, this will result in a layout of minimum overlap.
;;     Or, well, that's the theory; the reality is that the resulting layout
;;     may not be so great, but it's sure fun watching it get there.
;;
;; Installation:
;;     Install this file, and add the following lines to your .sawmillrc:
;;
;; (setq load-path (cons "/directory/containing/this/file/" load-path))
;; (require 'repel)
;;
;;     And then bind the "repel-toggle" command to a handy key.
;;
;;     Note that this requires that you have also installed version 1.3 or
;;     greater of the undo.jl package.  There's no good reason for that, but I
;;     don't know how to write the lisp code for
;;     "call-this-function-if-it-only-exists" and make it work right with the
;;     compiler and stuff.
;;
;; Author:
;;     Terry Weissman <terry@weissman.org>
;;     Latest version can be found at http://www.weissman.org/sawfish
;;
;; Changelog:
;;    $Log: repel.jl,v $
;;    Revision 1.3  2000/06/01 13:40:16  terry
;;    Remove hard dependency on undo.jl (but it will still work well with undo
;;    if you have both installed.)
;;
;;    Revision 1.2  2000/05/31 22:13:36  terry
;;    Repel things partially off screen to get back on.
;;
;;    Revision 1.1  2000/05/31 21:28:33  terry
;;    Initial revision
;;


(require 'rects)

(defvar repel-timer nil)
 
(defun repel-log (str)
  (let* ((fid (open-file "/tmp/repellog" 'append)))
    (write fid (prin1-to-string str))
    (write fid "\n")
    (close-file fid)))

(defun repel-limit-delta (win)
  (let* ((delta (window-get win 'repel-delta))
         (dx (car delta))
         (dy (cdr delta)))
    (if (or (> dx 10.0) (< dx -10.0)
            (> dy 10.0) (< dy -10.0))
        (let* ((m (max (abs dx) (abs dy))))
          (setq dx (* 10.0 (/ dx m)))
          (setq dy (* 10.0 (/ dy m)))
          (window-put win 'repel-delta (cons dx dy))))))

(defun repel-not-zero (v)
  (if (= v 0)
      (- (/ (random 10) 10) 0.5)
    v))

(defun repel-one-rect (win rect)
  (let* ((dims (window-frame-dimensions win))
         (point (window-position win))
         (weight (rect-2d-overlap dims point rect)))
    (if (> weight 0)
        (let* ((cx (+ (car point) (/ (car dims) 2)))
               (cy (+ (cdr point) (/ (cdr dims) 2)))
               (rx (/ (+ (car rect) (caddr rect)) 2))
               (ry (/ (+ (cadr rect) (nth 3 rect)) 2))
               (delta (window-get win 'repel-delta))
               (dx (car delta))
               (dy (cdr delta))
               (diffx (repel-not-zero (- cx rx)))
               (diffy (repel-not-zero (- cy ry))))
          (setq dx (+ dx (* weight (- cx rx))))
          (setq dy (+ dy (* weight (- cy ry))))
          (window-put win 'repel-delta (cons dx dy))))))


(defun repel-move-window-limiting (win x y)
  (let* ((oldloc (window-position win))
         (oldx (car oldloc))
         (oldy (cdr oldloc))
         (dims (window-frame-dimensions win))
         (width (car dims))
         (height (cdr dims))
         (maxx (- (- (screen-width) width) 0))
         (maxy (- (- (screen-height) height) 0)))
;     (if (and (> x maxx) (<= oldx maxx))
;         (setq x maxx))
;     (if (and (< x 0) (>= oldx 0))
;         (setq x 0))
;     (if (and (> y maxy) (<= oldy maxy))
;         (setq y maxy))
;     (if (and (< y 0) (>= oldy 0))
;         (setq y 0))
    (if (and (> x maxx) (> x oldx))
        (setq x oldx))
    (if (and (< x 0) (< x oldx))
        (setq x oldx))
    (if (and (> y maxy) (> y oldy))
        (setq y oldy))
    (if (and (< y 0) (< y oldy))
        (setq y oldy))
    (move-window-to win x y)))

                

(defun repel-once ()
  (if repel-timer (set-timer repel-timer))
  (display-message "Repelling")
  (let* ((ws current-workspace)
         (masterlist (append (avoided-windows) (window-order ws)))
         (glued nil)
         (mobile nil)
         (moved nil)
         (sw (screen-width))
         (sh (screen-height))
         (borderrects `((-10000 -10000 10000 0)
                        (-10000 -10000 0 10000)
                        (-10000 ,sh 10000 10000)
                        (,sw -10000 10000 10000))))
    (mapc (lambda (x)
            (if (or (window-avoided-p x)
                              (window-get x 'sticky))
                (setq glued (cons x glued))
              (setq mobile (cons x mobile))))
          masterlist)
    (mapc
     (lambda (me)
       (let* ((rects
               (append borderrects
                       (rectangles-from-windows (filter (lambda (x)
                                                          (not (equal x me)))
                                                        masterlist))))
              (trueloc (window-position me))
              (loc (window-get me 'repel-loc)))
         (if (or (null loc)
                 (/= (car trueloc) (round (car loc)))
                 (/= (cdr trueloc) (round (cdr loc))))
             (progn
               (setq loc trueloc)
               (window-put me 'repel-loc loc)))
         (window-put me 'repel-delta '(0 . 0))
         (mapc (lambda (x) (repel-one-rect me x)) rects)
         (repel-limit-delta me)
         (let* ((delta (window-get me 'repel-delta)))
           (unless (equal delta '(0 . 0))
             (setq moved t))
           (setq loc (cons (+ (car loc) (car delta))
                           (+ (cdr loc) (cdr delta))))
           (window-put me 'repel-loc loc)
           (repel-move-window-limiting me
                                       (round (car loc)) (round (cdr loc))))))
     mobile)
    (unless moved (if repel-timer (repel-toggle)))))
    
       

         
(defun repel-toggle ()
  "Turn on or off the repel stuff"
  (interactive)
  (if repel-timer
      (progn
        (delete-timer repel-timer)
        (setq repel-timer nil)
        (display-message nil)
        (if (boundp 'undo-end-group)
            (eval '(undo-end-group))))
    (progn
      (if (boundp 'undo-start-group)
          (eval '(undo-start-group)))
      (setq repel-timer (make-timer repel-once 0 100))
      (repel-once))))