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

;;; The Design Model

;;; The design model can be thought of as a simple CAD model.  A design model object contains
;;; an edge model, a list of territory models, and a list of design elements.  Possible
;;; design elements:  WALL, PARTITION, COLUMN, FIREPLACE, STAIR.  It also contains a
;;; circulation model, (conceptually) derived from the design elements. (As an approximation,
;;; it is actually derived from a territory model that contains disjoint territories which
;;; tile the design's floorplan.)

;;; Need a way to designate approach points, e.g. from the street.  Add Marker objects 
;;; to design model for now.

;;; Each design element contains information about material, tectonics (whatever dsk means by
;;; this), and geometry.  The geometry is currently represented as a plan view (aka
;;; footprint) consisting of a list of edges, and a height.  (Height is currently not used.)

;;; The design model is used to derive an edge model, which is a geometric abstraction of the
;;; design model and is used in computing such values as visual-openness.  Conceptually,
;;; there are three edge models possible:  one which contains edges collected from design
;;; element footprints, one in which certain footprints have been abstracted to a smaller
;;; number of edges (e.g. a single edge for a wall), and one in which open boundary segments
;;; (aka void edges) have been deduced and added.  The open boundary segments simplify
;;; certain computations, e.g.  modification of design elements to increase/decrease visual
;;; openness more naturally focuses initially on open boundary segments rather than on the
;;; design elements inducing those boundary segments.  For now, store only one edge model,
;;; which includes both abstractions and void edges.  Each edge stores its derivation
;;; information so that the process of modifying a design model can reverse the derivation.

;;; For now assume that an image is associated with a design model, and that each territory
;;; model shares that image.  This assumption restricts all territory models to having the
;;; same scale, since scale is associated with an image.  Should this restriction need to be
;;; removed, image information will need to also be stored in territory models, with default
;;; information stored with the design model.

;;; Changes:  Move image, circulation-model, markers to design-model (from boundary-model);
;;;           add disjoint-territory-model, edge-model to design-model; spaces are no longer
;;;           design elements.

(defclass IMAGE-SCALE-MIXIN ()
    ((image-scale :initform nil :initarg :image-scale :accessor image-scale)
     (image-scale-units :initform nil :initarg :image-scale-units
			:accessor image-scale-units)))

(defclass IMAGE-MIXIN (IMAGE-SCALE-MIXIN)
    ((left-handed-coordinates-p :initform nil :initarg :left-handed-coordinates-p
			      :accessor left-handed-coordinates-p)
     (image-name :initform nil :initarg :image-name :accessor image-name)
     (units :initform nil :initarg :units :accessor model-units))) ; not used (feet so far)

(defmethod plist-for-save append ((model image-mixin))
  (with-slots (left-handed-coordinates-p image-name image-scale image-scale-units
			    units) model
  `(:left-handed-coordinates-p ,left-handed-coordinates-p
    :image-name ,image-name :image-scale ,image-scale :image-scale-units ,image-scale-units
    :units ,units)))

(defmethod add-image ((model image-mixin) name scale &optional image-units)
  (with-slots (image-name image-scale units) model
    (setf image-name name)
    (setf image-scale scale)
    (setf units image-units)))
#|
(defmethod has-image-data-p ((model image-mixin))
  ;; really only need scale
  (with-slots (image-scale) model
     image-scale))

(defmethod copy-image-data ((from image-mixin) (to image-mixin))
  (with-slots (left-handed-coordinates-p image-name image-scale image-scale-units units) from
    (setf (left-handed-coordinates-p to) left-handed-coordinates-p)
    (setf (image-name to) image-name)
    (setf (image-scale to) image-scale)
    (setf (image-scale-units to) image-scale-units)))
|#

(defmethod image-scale ((model (eql 'nil)))
  nil)

(defmethod image-scale-units ((model (eql 'nil)))
  nil)

(defmethod left-handed-coordinates-p ((thing t))
  nil)

;; used mainly for testing
(defun draw-object (object &optional (stream *standard-output*))
  ;; measure object in model
  ;; screen-coord = scale*model-coord + shift
  ;; flip for y (use -scale)
  (multiple-value-bind (min-x min-y max-x max-y)		;in model coords (e.g. ft)
    (bounding-rectangle object)					;shadow from clim?
    (multiple-value-bind (screen-left screen-top screen-right screen-bottom)
	(clim:pointer-input-rectangle* :stream stream)
      (let* ((leftp (left-handed-coordinates-p object))
	     (y-factor (if leftp -1 1))
	     (model-dx (- max-x min-x))
	     (model-dy (- max-y min-y))
	     (screen-dx (- screen-right screen-left))
	     (screen-dy (- screen-bottom screen-top))
	     (x-scale (/ screen-dx model-dx))
	     (y-scale (/ screen-dy model-dy))
	     (scale (min x-scale y-scale))
	     (x-shift (- screen-left (* scale min-x)))
	     (y-shift (- (if leftp screen-bottom screen-top) (* scale min-y y-factor))))
	(clim:with-translation (stream x-shift y-shift)		;draws in correctly shifted
	  (clim:with-scaling (stream scale (* scale y-factor)) ;draws in shifted pixels
	    (draw-self object stream)))))))


;; May have more than one disjoint-territory-model?  No.  Assume that territories in the
;; disjoint-territory-model are convex.  Assume only one edge-model and that all edges are in
;; boundaries for territories in the disjoint-territory-model; i.e, no edge exists in the
;; edge model that doesn't serve as a boundary for at least one disjoint convex territory.
;; The disjoint-territory-model is used to compute a circulation model for the design model.
;; This circulation model is then used as a basis for circulation-models for other territory
;; models.  e.g. A territory model might include concave territories which are the union of
;; smaller convex territories.  The circulation model for that territory model will include
;; nodes for the centers of each territory, each center node connected to other nodes such
;; that the newly added link doesn't cross an opaque edge in the edge model. Note that
;; because the circulation model and the edge model are both "overlaid" on top of the design
;; element model, they use the same coordinate system and the links in the former can be
;; checked against the edges in the latter.

;; Design model's default circulation model is stored on edge model (and computed using
;; disjoint-territory-model).  For now don't bother to copy it for the other territory
;; models; just create new circulation models for each territory model.

(defclass DESIGN-MODEL (basic-object edge-model-mixin markers-mixin image-mixin) 
    ((design-elements :initform nil :initarg :design-elements :accessor design-elements)
     (territory-models :initform nil :initarg :territory-models :accessor
		       territory-models)
     (disjoint-territory-model :initform nil :initarg :disjoint-territory-model
			       :accessor disjoint-territory-model) 
     (default-territory-model :initform nil :initarg :default-territory-model
			     :accessor default-territory-model)
     (current-territory-model :initform nil :initarg :current-territory-model
			      :accessor current-territory-model)))

(defmethod initialize-instance :after ((model design-model) &rest plist)
  plist
    (save-model model))

(defmethod current-territory-model :before ((model design-model))
  (with-slots (current-territory-model default-territory-model) model
    (unless current-territory-model (setq current-territory-model default-territory-model))))

(defmethod circulation-model ((model design-model))
  (circulation-model (edge-model model)))

(defmethod territory-model-for-circulation-model ((model design-model))
  (with-slots (disjoint-territory-model) model
    disjoint-territory-model))
  
(defmethod territory-model ((model design-model))
  (with-slots (current-territory-model) model
    current-territory-model))

(defmethod add-territory-model ((model design-model) territory-model)
  (when territory-model
    (with-slots (territory-models default-territory-model) model
      (setf territory-models (pushnew territory-model territory-models))
      (unless default-territory-model (setf default-territory-model territory-model)))))

(defmethod add-design-element ((model design-model) elt)
  (with-slots (design-elements) model
    (pushnew elt design-elements)
    (setf (design-model elt) model)
    elt))

(defmethod set-design-elements ((model design-model) elts)
  (with-slots (design-elements) model
    (setf design-elements elts)
    (mapcar #'(lambda (x) (setf (design-model x) model)) elts))
    elts)

(defmethod delete-design-element ((model design-model) elt)
  (with-slots (design-elements) model
    (setf design-elements (remove elt design-elements))))

(defmethod copy-design-elements ((model design-model) new-model)
  (with-slots (design-elements) model
    (dolist (elt design-elements)
      (add-design-element new-model (copy-design-element elt)))))

(defmethod edges ((model design-model))
  (edges (edge-model model)))

;; design-elements are instances of physical-form

(defclass PHYSICAL-FORM (basic-object geometric-form)
    ((material :initform nil :initarg :material :accessor material)
     (color :initform nil :initarg :color :accessor color)
     (tectonics :initform nil :initarg :tectonics :accessor tectonics)))


;; Physical-form gives footprint; territory slot stores territory orthogonal to design
;; element; probably should add another slot for parallel territory (inline with element)

(defclass DESIGN-ELEMENT (physical-form design-model-mixin)
   ((territory :initform nil :initarg :territory :accessor territory)))

(defmethod save-form ((element design-element))
  (cons (type-of element) (plist-for-save element)))

(defmethod copy-design-element ((element design-element))
  (apply #'make-instance (save-form element)))

(defun find-design-element (element-name design-model)
  (find element-name (design-elements design-model) :key #'name))

(defmethod default-territory-model ((element design-element))
  (default-territory-model (design-model element)))

(defmethod territory-model ((element design-element))
  (territory-model (design-model element)))

;;; method for finding edges that correspond to elements
;;; if want actual edges for design-element, get them from the geometry slot

(defmethod edges-for ((x design-element) &optional derivation-type)
  ;; at some point add pointers from elt to edge, for now search
  (flet ((edge-search (test-fcn)
	   (loop for edge in (edges (design-model x))
	    with edges
	    do (loop for deriv in (derivation-info edge)
		     when (funcall test-fcn deriv)
		       do (push edge edges))
	       finally (return edges))))
	 (if derivation-type
	     (edge-search #'(lambda (deriv) (and (eq x (derived-from deriv))
					    (eql (derivation deriv) derivation-type))))
	     (edge-search #'(lambda (deriv) deriv
				   (eq x (derived-from deriv)))))))


;; For now just have wall, half-wall, screen, door, window, steps, fireplace.  Represent
;; stair by steps (as physical-form) and stair-space (as use-space). Or define a staircase
;; as the physical form.  Do openings need to be explicitly represented?  Makes some
;; operations easier; probably could deduce them rather than making user create them.
;; Later.

(defclass WALL (design-element)
    ())

(defclass HALF-WALL (design-element)
    ()) 

(defclass SCREEN (design-element)
    ()) 

(defclass DOOR (design-element)
    ())

(defclass DOORWAY (design-element)				;should this be an element?
    ((doors :initform nil :initarg :doors :accessor doors)
     (number-of-doors :initform 1 :initarg :number-of-doors :accessor number-of-doors)))

(defmethod abstracted-edge-for ((x doorway))
  (car (edges-for x :abstraction)))

(defclass WINDOW (design-element)
    ())

(defclass STEPS (design-element)
    ;; probably don't need level vars for current reasoning tasks
   ((from-level :initform 1 :initarg :from-level :accessor from-level)
    (to-level :initform 2 :initarg :to-level :accessor to-level)))


(defclass FIREPLACE (design-element)
    ())

(defclass STAIRCASE (steps)
    ())