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

;;; New version:  Territory-Model replaces Boundary-Model.  [6/9/97 KK]

;;; Changes:  Move image, markers to design-model.  Circulation-model is copy of
;;; circulation-model on design-model, which only contains nodes for void-segments (no
;;; regions).  Add inducers, use-models to boundary-model.  (Not clear yet what fills
;;; inducers slot; could be design-elements or territories.)  


;;; See design-model.lisp for a description of the relationships between design models, edge
;;; models, and territory models.

;;; The Territory Model

;;; The territory model is a (2D) geometric abstraction of a design model and contains
;;; territories which are induced by design elements in the design model. A territory is
;;; represented as a collections of edges, which form the boundary of the territory.  The
;;; edges are derived from design elements and are stored in an edge model. Each design model
;;; (currently) has only one edge model, but may have several territory models.  One
;;; territory model that is useful for certain computations (e.g. circulation) contains
;;; disjoint territories that tile the floorplan of a design model.  Other territory models
;;; might contain overlapping territories.  For now, just store the disjoint territory model.
;;; Certain overlapping territories, such as those used in computing continuity, are
;;; currently derived dynamically rather than being stored (see max-rectangle code).




;; Edges now kept in geometry object.
;; Not clear yet what's stored in inducers slot.

(defclass TERRITORY (geometric-form territory-model-mixin interiorp-mixin basic-object)
    ((inducers :initform nil :initarg :inducers :accessor inducers)))

(defun make-territory (name edges model)
  (let ((territory (make-instance 'territory :name name :territory-model model)))
    (setf (edges territory) edges)
    territory))

(defmethod draw-self ((territory territory) stream)
  ;; assume edges have already been drawn by territory-model
  ;; might want to display label; :after method displays viewpoints
  stream
  )

(defmethod (setf edges) :after ((edges list) (region territory))
  (loop for edge in edges
	do (add-territory edge region)))

;; +++ need to make sure geometry object is instantiated when model is loaded
(defmethod save-form ((region territory))
  (append `((:name ,(name region)))
	    (loop for segment in (edges region)
		  collect (save-form segment))))

(defmethod add-edge :after ((region territory) (edge model-edge))
  (add-territory edge region)
  edge)


;; could use connectivity model
;; assumes territories don't overlap
(defmethod contiguous-territories ((region territory) &optional predicate)
  (loop for region2 in (remove region (territories (territory-model region)))
	when (shared-void-edges region region2)
	  collect region2 into territories
	finally (return (if predicate (remove-if-not predicate territories)
			    territories))))

;; might want to build adjacency model
(defmethod neighboring-territories ((region territory) &optional predicate)
  (loop for region2 in (remove region (territories (territory-model region)))
	when (shared-edges region region2)
	  collect region2 into territories
	finally (return (if predicate (remove-if-not predicate territories)
			    territories))))

(defmethod shared-contiguous-territories ((region1 territory) (region2 territory)
				      &optional predicate)
  (intersection (contiguous-territories region1 predicate)
		(contiguous-territories region2 predicate)))


;; The Edge Model

;; Edge model is derived from a design model's design-elements: union of abstractions of
;; design-element footprints (e.g. walls have no thickness, voids represented by void edges).
;; Each edge stored its derivations, which are used during modification stage.  (No longer
;; can just store design element on edge because not all edges are 1-to-1 with elements.)
;; Use edge model to derive circulation model. (Circulation model could be derived from edge
;; model without using void edges, but use them now because derivation is simpler.)
;; Circulation model contains nodes for void edges, links between void edges.  Assume there
;; is only one edge model per design model. (Alternately, could store separate edge models
;; for design element footprints, plus wall abstractions, plus void edges.)  How void edges
;; are derived is still in question.  


;; Derivation of edges:  Edges may have multiple derivations. Each derivation is a design
;; element plus one of:
;;   :in-footprint   edge in footprint of design element
;;   :abstraction  abstraction of footprint (e.g. of wall)
;;   :orthogonal-projection  orthogonal projection from another edge (e.g. of a footprint)
;;   :extension    extension (in same direction) of another edge (e.g. of a wall)

;; Actually, edges may be derived from other edges rather than just from design elements;
;; e.g. abstract wall elements, then deduce the open edge between them.  Need to figure out
;; how chain of reasoning will work.

(defclass EDGE-MODEL (basic-object basic-graph design-model-mixin circulation-model-mixin)
    ())

(defmethod add-edge :after ((model edge-model) (edge model-edge))
    (setf (edge-model edge) model)
    edge)

(defmethod add-edge-model :after ((dmodel design-model) (emodel edge-model))
  (setf (design-model emodel) dmodel))


;;; The Territory Model

;;; For now, include circulation model on territory model so can add nodes for path
;;; destinations (e.g. particular territories) without altering design model's circulation
;;; model, which only contains nodes for open boundary segments.  Does territory model need
;;; to store edge model, or can it be deduced from design model?  May be an ordering issue
;;; when create territory model.

;;; Assume all image info is associated with design model.  Don't have territory-model
;;; without design model, since boundaries of territories are derived from design elements.
;;; Get image info (e.g. scale) from design-model.  If later need different scale for
;;; territory model, store it in territory model.

;;; Mix in basic-graph as cache of points and edges, collected from the territories.  Not
;;; all edges in edge-model will be in territory-model, so need place to store just those
;;; edges and points in the territory model.  (Formerly just accessed edge-model for edges
;;; in territory-model.)  Can't just set edges in :after initialize-instance method because
;;; setup-tmodel adds edges later.  Will need to reset edges and points when modify list of
;;; territories.

(defclass TERRITORY-MODEL (basic-object basic-graph design-model-mixin 
					circulation-model-mixin territories-mixin
					derived-object)
    ())


(defmethod initialize-instance :after ((model territory-model) &rest plist)
  (save-model model)
  (let ((design-model (design-model model)))
    (when (and design-model (typep design-model 'design-model))
      (add-territory-model design-model model)))
  model)

(defmethod edge-model ((model territory-model))
  (edge-model (design-model model)))

;; could use default draw-self method from basic-graph, but looks weird to draw all points
;; first then edges

(defmethod draw-self ((model territory-model) stream)
  (dolist (edge (edges model)) (draw-self edge stream)))

(defmethod draw-self :after ((model territory-model) stream)
  ;; might want to display territories in some way
  (dolist (territory (territories model))
    (draw-self territory stream)))
  
(defmethod left-handed-coordinates-p ((model territory-model))
  (left-handed-coordinates-p (design-model model)))

(defmethod image-name ((model territory-model))
  (image-name (design-model model)))

(defmethod image-scale ((model territory-model))
  (image-scale (design-model model)))

(defmethod image-scale-units ((model territory-model))
  (image-scale-units (design-model model)))

(defmethod units ((model territory-model))
  (units (design-model model)))

(defmethod use-models ((model territory-model))
  (loop for umodel in (get-use-models)
	when (eq (territory-model umodel) model)
	  collect umodel))

;; Use plist to hold property values (e.g. visual openness); only called
;; by modifier functions for now

#+ignore
(defmethod abbrev-pvalue-data ((model territory-model))
  (loop for (key prop-data) on (plist model) by #'cddr
	with results
	do (loop for (prop args value) in prop-data
		 as name = (name prop)
		 do (push (list name (property-arg-abbrev name args) value) results))
	finally (return results)))


(defmethod check-territory-model ((bmodel territory-model))
  (every #'(lambda (x) (not (= (segment-length x) 0))) (edges bmodel)))

(defmethod remove-all-bad-edges ((bmodel territory-model))
  (remove-bad-edges bmodel)
  (mapcar #'remove-bad-edges (territories bmodel)))

(defmethod set-design-model ((bmodel territory-model) (dmodel design-model))
    (setf (design-model bmodel) dmodel))

(defmethod connect-models ((dmodel design-model) (bmodel territory-model))
  (add-territory-model dmodel bmodel)
  (set-design-model bmodel dmodel))

(defmethod connect-models ((bmodel territory-model) (dmodel design-model))
  (connect-models dmodel bmodel))

(defmethod remove-model ((dmodel design-model) bmodel)
  ;; remove design-model from territory-model
  (when bmodel
    (setf (design-model bmodel) nil)))

(defmethod remove-model ((bmodel territory-model) dmodel)
  ;; remove territory-model from design-model
  (when dmodel
    (setf (territory-models dmodel) (remove bmodel (territory-models dmodel)))
    (when (eq (default-territory-model dmodel) bmodel)
      (setf (default-territory-model dmodel) (car (territory-models dmodel))))))

(defmethod add-territory :after ((model territory-model) region)
  (setf (territory-model region) model)
  region)

(defmethod markers ((model territory-model))
  (markers (design-model model)))

;; finding territories

(defmethod find-territory ((name symbol) (bmodel territory-model))
  (find name (territories bmodel) :key #'name :test #'equal))

(defmethod find-territory ((element design-element) (bmodel territory-model))
  (find element (territories bmodel) :key #'design-element))

(defmethod find-territory ((name symbol) (bmodel symbol))
  (find name (territories (find-tmodel bmodel)) :key #'name :test #'equal))

(defmethod find-territory ((element design-element) (bmodel symbol))
  (find element (territories (find-tmodel bmodel)) :key #'design-element))