;;; -*- Mode: Lisp; Package: DESIGN; Syntax: Ansi-common-lisp -*-


;; Rectangle object for storage

(defclass RECTANGLE (edges-mixin)
    ;; 4 edges
    ())

(defmethod area ((r rectangle))
  (bounding-area r))

;; Mod to allow intersection to be a list (for continuity measure code).

(defclass RECTANGLES ()
    ;; one of the rectangles might be the intersection of the others
    ((rectangles :initform nil :initarg :rectangles :accessor rectangles)
     (intersection :initform nil :initarg :intersection :accessor rectangles-intersection)
     (comments :initform nil :initarg :comments :accessor rectangles-comments)))

(defmethod print-object ((r rectangles) stream)
  (with-slots (comments) r
    (format stream "<RECTANGLES: ~a>" (small-string (mapcar #'name comments)))))

(defun make-rectangles-object (rectangles &optional intersection comments)
  (make-instance 'rectangles :rectangles rectangles :intersection intersection
		 :comments comments))

(defmethod draw-self ((r rectangles) stream)
  ;; move color setting to callers
;  (let ((*edge-color* clim::+red+))
    (with-slots (rectangles) r
      (dolist (rectangle rectangles)
	(draw-self rectangle stream))))

(defmethod draw-intersection ((r rectangles) stream)
  ;; can't put this in above method because sometimes draw list of rectangles and intersections
  ;; get overwritten by rectangle color
  (with-slots (intersection) r
    (when intersection
     ; (let ((*edge-color* clim::+blue+))
	(draw-self intersection stream))))

(defmethod draw-self ((l list) stream)
  (dolist (x l)
    (draw-self x stream)))

(defmethod edges-for-rectangles ((r rectangles))
  (with-slots (rectangles) r
    (loop for rectangle in rectangles
	  append (edges rectangle))))

(defmethod bounding-rectangle ((r rectangles))
  ;; returns min-x min-y max-x max-y
  (bounding-rectangle-for-edges (edges-for-rectangles r)))


(defun find-rectangle-of-max-extent (seg1 edges &rest endpoints-to-avoid)
  (make-instance 'rectangle
		 :edges (find-segments-for-rectangle-of-max-extent seg1 edges
								      endpoints-to-avoid)))


;; Testing

#+ignore
(defun test-max-rectangle ()
  (declare (special *b1* *d1*))
  (let ((seg-a (first (edges *b1*)))				; lr-dr-opening
	(segs (append (edges (bounded-region-for
				  (find-design-element 'colonial-1-dining-room *d1*)))
		      (edges (bounded-region-for
				  (find-design-element 'colonial-1-living-room *d1*))))))
    (find-edges-for-rectangle-of-max-extent seg-a segs)))

;; should get: (<EDGE: (15.0 5.625) (7.5 5.625)> <EDGE: (15.0 27.65625) (7.5 27.65625)>
;;              <EDGE: (15.0 5.625) (15.0 27.65625)> <EDGE: (7.5 5.625) (7.5 27.65625)>)


;; Rectangle intersection

#+ignore
(defun rectangle-intersection (r1 r2)
  (multiple-value-bind (min-x1 min-y1 max-x1 max-y1)
      (bounding-rectangle r1)
    (multiple-value-bind (min-x2 min-y2 max-x2 max-y2)
	(bounding-rectangle r2)
      (let ((min-x (max min-x1 min-x2))
	    (min-y (max min-y1 min-y2))
	    (max-x (min max-x1 max-x2))
	    (max-y (min max-y1 max-y2)))
	(when (and (<= min-x max-x)          ; <?
		   (<= min-y max-y))
	  (let* ((x1y1 (make-point min-x min-y))
		(x1y2 (make-point min-x max-y))
		(x2y2 (make-point max-x max-y))
		(x2y1 (make-point max-x min-y))
		(edges (list (make-basic-edge x1y1 x1y2)
				(make-basic-edge x1y2 x2y2)
				(make-basic-edge x2y2 x2y1)
				(make-basic-edge x2y1 x1y1))))
	    (make-instance 'rectangle :edges edges)))))))


(defun rectangle-intersection (rectangles)
  ;; bounds are min-x min-y max-x max-y
  (flet ((make-edges (min-x min-y max-x max-y)
	   (let ((x1y1 (make-point min-x min-y))
		 (x1y2 (make-point min-x max-y))
		 (x2y2 (make-point max-x max-y))
		 (x2y1 (make-point max-x min-y)))
		(list (make-basic-edge x1y1 x1y2)
		      (make-basic-edge x1y2 x2y2)
		      (make-basic-edge x2y2 x2y1)
		      (make-basic-edge x2y1 x1y1)))))
  (loop for b in (mapcar #'bounding-rectangle+ rectangles)
	maximize (first b) into min-x
	maximize (second b) into min-y
	minimize (third b) into max-x
	minimize (fourth b) into max-y
	finally (when (and (<= min-x max-x)          ; <?
		   (<= min-y max-y))
		  (return (make-instance 'rectangle
			       	 :edges (make-edges min-x min-y max-x max-y)))))))
		  
(defun rectangle-intersection& (&rest rectangles)
  (rectangle-intersection rectangles))

;; testing

(defun test-rectangle-intersection ()
  ;; rectangles are perpendicular
  (declare (special *b1* *d1*))
  (let* ((seg-a (first (edges *b1*)))			; lr-dr-opening
	 (seg-o (nth 17 (edges *b1*)))			; lr-sp-opening
	 (lr-segs (edges (bounded-region-for
			      (find-design-element 'colonial-1-living-room *d1*))))
	 (dr-segs (edges (bounded-region-for
			      (find-design-element 'colonial-1-dining-room *d1*))))
	 (sp-segs (edges (bounded-region-for
			      (find-design-element 'colonial-1-sun-porch *d1*))))
	 (r1 (find-rectangle-of-max-extent seg-a (append lr-segs dr-segs)))
	 (r2 (find-rectangle-of-max-extent seg-o (append lr-segs sp-segs)))
	 (r3 (rectangle-intersection (list r1 r2))))
    (make-instance 'rectangles
		   :rectangles (if r3 (list r1 r2 r3) (list r1 r2))
		   :intersection r3)))

(defun test-rectangle-intersection2 ()
  ;; should be no intersection; rectangles are parallel
  (declare (special *b1* *d1*))
  (let* ((seg-o (nth 17 (edges *b1*)))			; lr-sp-opening
	 (seg-b2 (nth 3 (edges *b1*)))			; 
	 (lr-segs (edges (bounded-region-for
			      (find-design-element 'colonial-1-living-room *d1*))))
	 (sp-segs (edges (bounded-region-for
			      (find-design-element 'colonial-1-sun-porch *d1*))))
	 (r1 (find-rectangle-of-max-extent seg-o (append lr-segs sp-segs)))
	 (r2 (find-rectangle-of-max-extent seg-b2 (append lr-segs sp-segs)))
	 (r3 (rectangle-intersection (list r1 r2))))
    (make-instance 'rectangles
		   :rectangles (if r3 (list r1 r2 r3) (list r1 r2))
		   :intersection r3)))

(defun test-rectangle-intersection3 ()
  ;; rectangles are parallel, but intersect
  (declare (special *b2* *d2*))
  (let* ((seg-9 (nth 9 (edges *b2*)))			; lr-vest-opening
	 (seg-25 (nth 25 (edges *b2*)))			; dr-vest-opening
	 (lr-segs (edges (bounded-region-for
			      (find-design-element 'colonial-2-living-room *d2*))))
	 (dr-segs (edges (bounded-region-for
			      (find-design-element 'colonial-2-dining-room *d2*))))
	 (vest-segs (edges (bounded-region-for
			      (find-design-element 'colonial-2-vestibule *d2*))))
	 (r1 (find-rectangle-of-max-extent seg-9 (append lr-segs vest-segs)))
	 (r2 (find-rectangle-of-max-extent seg-25 (append dr-segs vest-segs)))
	 (r3 (rectangle-intersection (list r1 r2))))
    (make-instance 'rectangles
		   :rectangles (if r3 (list r1 r2 r3) (list r1 r2))
		   :intersection r3)))