;;; -*- Mode: LISP; Syntax: COMMON-LISP; Base: 10.; Package: XIT; -*-
;;;__________________________________________________________________________
;;;
;;;                       System: XIT
;;;                       Module: Minimax
;;;                       (Version 1.0)
;;;
;;; Copyright (c): Forschungsgruppe DRUID, Thomas Schwab
;;;                Universitaet Stuttgart
;;;
;;; File: /usr/local/lisp/xit/kernel/minimax.lisp
;;; File Creation Date: 7/17/90 15:45:28
;;; Last Modification Time: 02/11/91 08:59:41
;;; Last Modification By: Juergen Herczeg



;;; Dirty hack to constraint window height and width
;;; Values of NIL mean no constraint

;;; If the constraints are not fix and must be computed at runtime
;;; define appropriate methods that override the slot accessing methods.

;;; Note: minimax-mixin should appear leftmost in the superclasses list

;;;__________________________________________________________________________
;;;
;;;
;;; Changes (worth to be mentioned):
;;; ================================
;;;
;;; 09/07/90 [Kalle] Resize trigger replaced by manage-geometry trigger
;;;__________________________________________________________________________

(in-package :xit)


(defclass minimax-mixin ()
  ((min-height :initarg :min-height :accessor min-height :initform 1)
   (min-width :initarg :min-width :accessor min-width :initform 1)
   (max-height :initarg :max-height :accessor max-height :initform nil)
   (max-width :initarg :max-width :accessor max-width :initform nil)))

#|| Replaced by a trigger in manage-geometry [Kalle]

(defmethod resize :around ((self minimax-mixin) width height border-width)
  (call-next-method self
		    (min (or (max-width self) most-positive-fixnum)
			      (max (or (min-width self) 1)
				   width))
		    (min (or (max-height self) most-positive-fixnum)
			 (max (or (min-height self) 1)
			      height))
                   border-width)
||#
    
(defmethod manage-geometry :around ((parent composite) (self minimax-mixin)
				    x y width height border-width &key)
  (multiple-value-bind
      (all-accepted? returned-x returned-y returned-width returned-height
       returned-border-width) (call-next-method)
    (let ((acceptable-width (min (or (max-width self) most-positive-fixnum)
				 (max (or (min-width self) 1)
				      returned-width)))
	  (acceptable-height (min (or (max-height self) most-positive-fixnum)
				  (max (or (min-height self) 1)
				       returned-height))))
      (values all-accepted?
		   
		   
              returned-x
              returned-y
              acceptable-width
	      acceptable-height
              returned-border-width))))
		    



(defmethod (setf min-width) :after (val (self minimax-mixin))
  (with-slots (width height parent) self
      (resize-window self (min (or (max-width self) most-positive-fixnum)
			      (max (or (min-width self) 1)
				   width))
		     (min (or (max-height self) most-positive-fixnum)
			  (max (or (min-height self) 1)
			       height)))
      (change-layout parent)))

(defmethod (setf max-width) :after (val (self minimax-mixin))
  (with-slots (width height parent) self
      (resize-window self (min (or (max-width self) most-positive-fixnum)
			      (max (or (min-width self) 1)
				   width))
		     (min (or (max-height self) most-positive-fixnum)
			  (max (or (min-height self) 1)
			       height)))
      (change-layout parent)))

(defmethod (setf min-height) :after (val (self minimax-mixin))
  (with-slots (width height parent) self
      (resize-window self (min (or (max-width self) most-positive-fixnum)
			      (max (or (min-width self) 1)
				   width))
		     (min (or (max-height self) most-positive-fixnum)
			  (max (or (min-height self) 1)
			       height)))
      (change-layout parent)))

(defmethod (setf max-height) :after (val (self minimax-mixin))
  (with-slots (width height parent) self
      (resize-window self (min (or (max-width self) most-positive-fixnum)
			      (max (or (min-width self) 1)
				   width))
		     (min (or (max-height self) most-positive-fixnum)
			  (max (or (min-height self) 1)
			       height)))
      (change-layout parent)))

