;;; -*- Mode:LISP; Readtable:ZL; Base:10 -*-

;;; Adjust sizes of commonly-used windows (found by name) to provide
;;; desk-top'ish effect.

;;; A-List keyed by window name 

(defconst *my-window-parameters*
	  '(("Lisp Listener 1"
	     :edges (0.01 0.01 0.8 0.8)
	     :borders (1 1 6 4)
	     :margin-width 6)
	    ("zmacs Frame 1"		   
	     :edges (0. 0.12 0.83 1.)
	     :borders 3
	     :margin-width 2)
	    ("Main ZMail window"		; needs to be big for PROFILE constraints
	     :edges  (0.12 0.07 0.98 0.92)
	     :margin-width 2)
	    ("Peek Frame 1" :edges (0.05 0.05 0.85 0.8) :borders 3)
	    ("Unix Stream 1"    :edges (0.12 0.2 0.8 0.8))
	    ("Supdup 1" :edges (0.2 0.04 0.95 0.75))
	    ("Telnet 1" :edges (0.15 0. 0.9 0.7))
	    ("Converse Frame 1" :edges (0.18 0.1 0.7 0.75))
	    ("Inspect Frame 1"  :edges (0.4 0.2 0.96 0.92))
	    ("Fed Frame 1" :edges (0.0 0.0 1. 1.))
	    ))

(defun mcc-relative-window-position (lx ly mx my)
  "lx and ly are at upper left, mx and my are at lower right, range 0. to 1."
  (multiple-value-bind (min-x min-y max-x max-y)
      (send tv:main-screen :edges)	   ; what do we have to work with?
    (let ((dx (- max-x min-x))		   ; horizontal points
	  (dy (- max-y min-y)))		   ; vertical points
      (list
	(round (+ (* lx dx) min-x))
	(round (+ (* ly dy) min-y))
	(round (+ (* mx dx) min-x))
	(round (+ (* my dy) min-y))
	))))

(defun adjust-window(w &key edges borders margin-width)
  (when edges (lexpr-send w :set-edges
		       (apply #'mcc-relative-window-position edges)))
  (when borders (send w :set-borders borders))
  (when margin-width (send w :set-border-margin-width margin-width)))

(defun set-my-windows ()
  (mapcan 
    #'(lambda (w &aux parms)			; for this window
	(print w)
	(if (setq parms
		  (cdr (ass #'string-equal (send w :name) *my-window-parameters*)))
	    (apply #'adjust-window w parms))
	)
    (send tv:main-screen :inferiors)		; try all inferiors of main screen
    ))

(SET-MY-WINDOWS)