;; contrib/wmresize.jl -- wm-like resize/move boxes

;; version 0.1

;; Copyright (C) 2002 Jindrich Makovicka <makovick@kmlinux.fjfi.cvut.cz>

;; http://merlin.org/sawfish/

;; This is free software; you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with sawfish; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;;;;;;;;;;;;;;;;;
;; INSTALLATION ;;
;;;;;;;;;;;;;;;;;;

;; Create a directory ~/.sawfish/lisp/contrib and then put this file there:
;;   mkdir -p ~/.sawfish/lisp/contrib
;;   mv wmresize.jl ~/.sawfish/lisp/contrib

;; Then add to your .sawfishrc:
;;   (require 'contrib.wmresize)

;; Then restart sawfish and go to Customize->Move/Resize and select
;; the dimension animation mode.

;; The appearance of the animation mode can be customized under
;; Customize->Move/Resize->Ugliness.

(define-structure contrib.wmresize

  (export)

  (open
   rep
   rep.system
   sawfish.wm
   sawfish.wm.custom
   sawfish.wm.util.x
   sawfish.wm.util.window-outline)

  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;; move-resize basic ugliness settings
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

  (defgroup move-ugliness "Ugliness" :group move)

  (defcustom ugly-move-resize-dim-font default-font
    "Font for move/resize dimension marks."
    :type font
    :group (move move-ugliness))

  (defcustom ugly-dim-text-shift 0
    "Y-axis position correction for dimension text."
    :type number
    :range (-100 . 100)
    :group (move move-ugliness))

  (defcustom ugly-dim-offset 3
    "Dimension offset."
    :type number
    :range (0 . 100)
    :group (move move-ugliness))

  (defcustom ugly-dim-width 16
    "Dimension width."
    :type number
    :range (0 . 100)
    :group (move move-ugliness))

  (defcustom ugly-dim-arrow-size (cons 4 8)
    "Dimension arrow size."
    :type (pair (labelled "Width:" (number 0 100)) (labelled "Length:" (number 0 100)))
    :group (move move-ugliness))

  (if (not (memq 'dimension (custom-get-options 'move-outline-mode)))
    (custom-add-option 'move-outline-mode 'dimension))
  (if (not (memq 'dimension (custom-get-options 'resize-outline-mode)))
    (custom-add-option 'resize-outline-mode 'dimension))

  (define (draw-dim-outline x y width height)
    (require 'sawfish.wm.util.x)
    (require 'sawfish.wm.fonts)
    (let ((gc (x-create-root-xor-gc))
	  (wtext (format nil "%d" width))
	  (htext (format nil "%d" height))
	  (htwidth) (wtwidth) (dim) (halfdim)
	  (off ugly-dim-offset)
	  (halfdimoff) (w-orig-y) (h-orig-x)
	  (arrw (car ugly-dim-arrow-size)) (arrl (cdr ugly-dim-arrow-size))
	  (fheight (font-height ugly-move-resize-dim-font))
	  )

      (x-draw-rectangle 'root gc (cons x y) (cons width height))

      (setq wtwidth (text-width wtext ugly-move-resize-dim-font))
      (setq htwidth (text-width htext ugly-move-resize-dim-font))
      (setq dim ugly-dim-width)
      (setq halfdim (round (/ dim 2)))
      (setq halfdimoff (+ halfdim off))

      ;; check where to draw (top/bottom, left/right)
      (if (> (+ dim off) y) (setq w-orig-y (+ y height dim (* off 2))) (setq w-orig-y y) )
      (if (> (+ dim off) x) (setq h-orig-x (+ x width dim (* off 2))) (setq h-orig-x x) )

      ;; horizontal dimension
      (if (or (> (+ wtwidth 2 (* arrl 2)) width) (> w-orig-y (screen-height))) (setq wtwidth 0)
	(x-draw-line 'root gc (cons x (- w-orig-y off)) (cons x (- w-orig-y off dim)) )
	(x-draw-line 'root gc (cons (+ x width -1) (- w-orig-y off)) (cons (+ x width -1) (- w-orig-y off dim)) )

    	(x-draw-string 'root gc (cons
				 (round (+ x (- (/ width 2) (/ wtwidth 2)))) 
				 (round (+ (- w-orig-y halfdimoff) (/ fheight 2) ugly-dim-text-shift))) wtext ugly-move-resize-dim-font)
	        
	(x-draw-line 'root gc 
		     (cons x (- w-orig-y halfdimoff))
		     (cons (round (+ x (- (/ width 2) (/ wtwidth 2) 2) ) ) (- w-orig-y halfdimoff) )
		     )

	(x-draw-line 'root gc 
		     (cons (round (+ x (+ (/ width 2) (/ wtwidth 2) 2 ) ) ) (- w-orig-y halfdimoff) )
		     (cons (+ x width) (- w-orig-y halfdimoff))
		     )

	(x-draw-line 'root gc (cons (+ x arrl) (- w-orig-y (+ halfdimoff arrw)))
		     (cons x (- w-orig-y halfdimoff)))
	(x-draw-line 'root gc (cons (+ x arrl) (- w-orig-y (- halfdimoff arrw)))
		     (cons x (- w-orig-y halfdimoff)))
	(x-draw-line 'root gc (cons (- (+ x width) arrl) (- w-orig-y (+ halfdimoff arrw)))
		     (cons (+ x width) (- w-orig-y (+ halfdim off))))
	(x-draw-line 'root gc (cons (- (+ x width) arrl) (- w-orig-y (- halfdimoff arrw)))
		     (cons (+ x width) (- w-orig-y halfdimoff)))

	)

      ;; vertical dimension
      (if (or (> (+ fheight 2 (* arrl 2)) height) (> h-orig-x (screen-width))) (setq fheight 0)
	(x-draw-line 'root gc (cons (- h-orig-x off dim) y) (cons (- h-orig-x off) y) )
	(x-draw-line 'root gc (cons (- h-orig-x off dim) (+ y height)) (cons (- h-orig-x off) (+ y height)) )

	(x-draw-string 'root gc (cons
				 (round (- h-orig-x (/ htwidth 2) halfdimoff))
				 (round (+ y (/ height 2) (/ fheight 2) ugly-dim-text-shift))) htext ugly-move-resize-dim-font)

	(x-draw-line 'root gc 
		     (cons (- h-orig-x halfdimoff) y)
		     (cons (- h-orig-x halfdimoff) (round (+ y (- (/ height 2) (/ fheight 2) 2 ) ) ) )
		     )

	(x-draw-line 'root gc 
		     (cons (- h-orig-x halfdimoff) (round (+ y (+ (/ height 2) (/ fheight 2) 2 ) ) ) )
		     (cons (- h-orig-x halfdimoff) (+ y height))
		     )

	(x-draw-line 'root gc (cons (- h-orig-x (+ halfdimoff arrw)) (+ y arrl)) (cons (- h-orig-x halfdimoff) y))
	(x-draw-line 'root gc (cons (- h-orig-x (- halfdimoff arrw)) (+ y arrl)) (cons (- h-orig-x halfdimoff) y))
	(x-draw-line 'root gc (cons (- h-orig-x (+ halfdimoff arrw)) (- (+ y height) arrl))
		     (cons (- h-orig-x halfdimoff) (+ y height)))
	(x-draw-line 'root gc (cons (- h-orig-x (- halfdimoff arrw)) (- (+ y height) arrl))
		     (cons (- h-orig-x halfdimoff) (+ y height)))
	)
	
      (x-destroy-gc gc)))

  (define-window-outliner 'dimension draw-dim-outline))