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


;;; Visibility Grid

;;; Grid make up of tiles of a fixed size; may have several grids per region.  Each grid
;;; stores tile-size, region, and list of viewpoints from other regions (which could be
;;; derived by walking through tiles).  Each tile stores midpoint and list of visibility data;
;;; visibility data consists of viewpoint and visiblep flag; viewpoint is a point and a
;;; region (which could be derived).

;;; To find out which tiles of region A are visible from region B, setup a grid for A, then
;;; viewpoints in B for each void segment shared between A and B.  Place viewpoint even with
;;; midpoint of segment and "just inside" B, e.g. 4 tiles inside.  For now, store viewpoints
;;; in the tiles and in the region used to create them (i.e. the one containing their points)


;; maybe need to define thing-with-region

(defclass VIEWPOINT (basic-point)
    ((region :initform nil :initarg :region :accessor viewpoint-region)
     (segment :initform nil :initarg :segment :accessor viewpoint-segment)
     (distance :initform nil :initarg :distance :accessor viewpoint-distance)))

(defmethod print-object ((viewpoint viewpoint) stream)
  (with-slots (region) viewpoint
    (format stream "<VIEWPOINT: ~a ~a (~a)>" (point-x viewpoint) (point-y viewpoint)
	    (name region))))

(defun make-viewpoint (x y d &optional segment region)
  (make-instance 'viewpoint :x x :y y :distance d :segment segment :region region))


(defclass VISIBILITY-DATA ()
    ((viewpoint :initform nil :initarg :viewpoint :accessor viewpoint)
     (visiblep :initform 'unk :initarg :visiblep)
     (obstructing-edges :initform nil :accessor obstructing-edges)))


(defmethod print-object ((vis visibility-data) stream)
  (with-slots (viewpoint visiblep) vis
    (format stream "<VIS: ~a ~a>" viewpoint visiblep)))

(defmethod set-visiblep ((vis visibility-data) value)
  (with-slots (visiblep) vis
    (setf visiblep value)))

(defmethod add-edge ((vis visibility-data) edge)
  (with-slots (obstructing-edges) vis
    (pushnew edge obstructing-edges)))

(defmethod unknown-visiblep ((vis visibility-data))
  (with-slots (visiblep) vis
    (eq visiblep 'unk)))

(defmethod visiblep ((vis visibility-data))
  (with-slots (visiblep) vis
    (and visiblep (not (eq visiblep 'unk)))))

(defmethod viewpoint-region ((vis visibility-data))
  (with-slots (viewpoint) vis
    (viewpoint-region viewpoint)))


(defclass TILE ()
    ((midpoint :initform (make-point nil nil) :initarg :midpoint :accessor tile-midpoint)
     (visibility :initform nil :initarg :visibility :accessor tile-visibility)))
 

(defun make-tile (x y)
  (make-instance 'tile :midpoint (make-basic-point x y)))

(defmethod print-object ((tile tile) stream)
  (with-slots (midpoint) tile
    (format stream "<TILE: ~a ~a>" (point-x midpoint) (point-y midpoint))))

(defmethod viewpoints ((tile tile))
  (with-slots (visibility) tile
    (mapcar #'viewpoint visibility)))

(defmethod clear-visibility-data ((tile tile))
  (with-slots (visibility) tile
    (setf visibility nil)))

(defmethod find-or-make-vis-data ((tile tile) viewpoint &aux vis)
  (with-slots (visibility) tile
    (or (find viewpoint visibility :test #'point-equal :key #'viewpoint)
	(prog1 (setq vis (make-instance 'visibility-data :viewpoint viewpoint))
	       (setf visibility (push vis visibility))))))

(defmethod set-tile-visibility ((tile tile) viewpoint value &optional edge)
  (with-slots (visibility) tile
   (let ((vis (find-or-make-vis-data tile viewpoint)))
      (set-visiblep vis value)
      (when edge (add-edge vis edge)))))

;; checks cached info
#+ignore
;; have to check specific viewpoints now
(defmethod visible-from-p ((tile tile) (region territory))
  (loop for vis in (tile-visibility tile)
	when (and (eq region (viewpoint-region vis))
		  (visiblep vis))				
	  do (return t)))

(defmethod visible-from-p ((tile tile) (viewpoint viewpoint))
  (loop for vis in (tile-visibility tile)
	when (and (point-equal viewpoint (viewpoint vis))
		  (visiblep vis))
	  do (return t)))

#+ignore
(defmethod invisible-from-p ((tile tile) (region territory))
  (loop for vis in (tile-visibility tile)
	when (and (eq region (viewpoint-region vis))
		  (not (visiblep vis)))
	  do (return t)))

(defmethod invisible-from-p ((tile tile) (viewpoint viewpoint))
  (loop for vis in (tile-visibility tile)
	when (and (point-equal viewpoint (viewpoint vis))
		  (not (visiblep vis)))
	  do (return t)))

(defmethod unknown-visible-from-p ((tile tile) (viewpoint viewpoint))
  (loop for vis in (tile-visibility tile)
	when (and (point-equal viewpoint (viewpoint vis))
		  (unknown-visiblep vis))
	  do (return t)))


(defun validp (tile)
  tile)

;; version that checks grid cache

;; Store region and viewpoint parameters on grid; store parameters and viewpoints on region.

(defvar *default-tile-size* 1.0)
(defvar *default-viewpoint-d* 3.0)
(defvar *default-viewpoint-n* nil)
(defvar *default-viewpoint-s* 1.5)

(defclass GRID ()
    ((region :initform nil :initarg :region :accessor grid-region)
     (tile-size :initform nil :initarg :tile-size :accessor grid-tile-size)
     (tiles :initform nil :initarg :tiles :accessor grid-tiles)
     (tile-count :initform nil :initarg :tile-count :accessor grid-tile-count)
     (viewpoint-data :initform nil :initarg :viewpoint-data :accessor grid-viewpoint-data)))

(defmethod save-viewpoint-data ((grid grid) from-region d n s)
  (with-slots (viewpoint-data) grid
    (push (list from-region (cons-viewpoint-parameters d n s)) viewpoint-data)))

(defmethod find-viewpoint-data ((grid grid) from-region d n s)
  (with-slots (viewpoint-data) grid
    (find (list from-region (cons-viewpoint-parameters d n s)) viewpoint-data :test #'equal)))

(defmethod print-object ((grid grid) stream)
  (with-slots (region tile-size) grid
    (format stream "<GRID: ~a (~a ft/tile)>" (name region) tile-size)))

(defmacro loop-with-tiles (grid &body body)
  `(let* ((tiles (grid-tiles ,grid))
	 (dim (array-dimensions tiles)))
     (loop for i from 0 to (1- (car dim))
	   do (loop for j from 0 to (1- (cadr dim))
		    as tile = (aref tiles i j)
		    do (when (validp tile)
		            ,@body))))) 


(defmethod list-tiles ((grid grid))
  (with-slots (tiles) grid
    (show-2d-array tiles)))

(defmethod print-tile-locs ((grid grid) &optional (stream *standard-output*))
  (with-slots (tiles) grid
    (let ((dim (array-dimensions tiles)))
    (loop for i from 0 to (1- (car dim))
	  do (progn (terpri stream)
		    (loop for j from 0 to (1- (cadr dim))
			  do (format stream "~a  " (when (aref tiles i j) t))))))))
		    

#+ignore
(defmethod viewpoints ((grid grid))
  ;; assume if first tile has been checked, all have
  (with-slots (tiles) grid
    (viewpoints (aref tiles 0 0))))
  
(defmethod clear-visibility-data ((grid grid))
  (with-slots (viewpoint-data) grid
    (setf viewpoint-data nil))
  (loop-with-tiles grid
    (clear-visibility-data tile)))

(defmethod clear-visibility-data ((region territory))
  ;; clears all grids
  (clear-region-viewpoints region)
  (loop for grid in (grids-for-region region)
	do (clear-visibility-data grid))) 

(defmethod clear-visibility-data ((regions list))
  ;; assume have both to and from regions to clear
  (dolist (region regions)
    (clear-region-viewpoints region))
  (dolist (region regions)
    (clear-visibility-data region)))

(defmethod clear-visibility-data ((model territory-model))
  ;; clears all grids in all regions
  (loop for region in (territories model)
	do (clear-visibility-data region)))

;; Main setup function

;; Regions can be concave, so have to mark tiles that aren't in region.

(defun inside-regionp (x y region)
  (inside-polygon-p x y (edges region)))

#+ignore
(defun setup-grid (region &optional (tile-size *default-tile-size*)) 
  (flet ((tile-n (a b)
	   (floor (/ (abs (- a b)) tile-size))))
    (multiple-value-bind (left top right bottom)
	(bounding-rectangle region)
      (let* ((array-dim1 (tile-n right left))
	     (array-dim2 (tile-n bottom top))
	     (grid (make-instance 'grid :tile-size tile-size :region region
				  :tiles (make-array `(,array-dim1 ,array-dim2)
						     :element-type 'tile)))
	     (tile-incr (/ tile-size 2.0)))
	(loop for i from 0 to (1- array-dim1)
	      and x = (+ left tile-incr) then (+ x tile-size)
	      with tile-count = 0
	      do (loop for j from 0 to (1- array-dim2)
		       and y = (+ top tile-incr) then (+ y tile-size)
		       when (inside-regionp x y region)
			 do (progn (setf (aref (grid-tiles grid) i j) (make-tile x y))
				   (setf tile-count (1+ tile-count))))
		 finally (setf (grid-tile-count grid) tile-count))
	grid))))


;; add extra last row and column of tiles 

(defun setup-grid (region &optional (tile-size *default-tile-size*)) 
  (flet ((tile-n (a b)
	   (floor (/ (abs (- a b)) tile-size))))
    (multiple-value-bind (left top right bottom)
	(bounding-rectangle region)
      (let* ((array-dim1 (1+ (tile-n right left)))
	     (array-dim2 (1+ (tile-n bottom top)))
	     (grid (make-instance 'grid :tile-size tile-size :region region
				  :tiles (make-array `(,array-dim1 ,array-dim2)
						     :element-type 'tile)))
	     (tile-incr (/ tile-size 2.0)))
	(loop for i from 0 to (1- array-dim1)
	      and x = (+ left tile-incr) then (if (= i (1- array-dim1))
						  (+ x tile-incr) (+ x tile-size))
	      with tile-count = 0 
	      do (loop for j from 0 to (1- array-dim2)
		       and y = (+ top tile-incr) then (if (= j (1- array-dim2))
							  (+ y tile-incr)(+ y tile-size))
		       when (inside-regionp x y region)
			 do (progn (setf (aref (grid-tiles grid) i j) (make-tile x y))
				   (setf tile-count (1+ tile-count))))
		 finally (setf (grid-tile-count grid) tile-count))
	grid)))) 

(defun setup-new-grid (region &optional (tile-size *default-tile-size*))
  (set-property-value region 'grid (setup-grid region tile-size)))

;; Grids for regions: store multiple grids on regions

(defun find-or-make-grid-for-region (region &optional (tile-size *default-tile-size*))
  (or (find-grid-for-region region tile-size)
      (make-grid-for-region region tile-size)))

(defun find-grid-for-region (region tile-size)
  (find tile-size (grids-for-region region) :key #'grid-tile-size))

(defun make-grid-for-region (region tile-size)
  (add-grid-for-region region (setup-grid region tile-size)))

(defun add-grid-for-region (region grid)
  (add-property-value region 'grids grid)
  grid) 

(defun grid-for-region (region &optional (tile-size *default-tile-size*))
  (find-grid-for-region region tile-size))

(defun grids-for-region (region)
  (get-property-value region 'grids))

(defmethod delete-grids ((region territory))
  (set-property-value region 'grids nil))

;; Viewpoints for regions:  store multiple viewpoints, index by viewpoint parameters

(defun cons-viewpoint-parameters (d n s)
  (list d n s))

(defun find-or-make-region-viewpoints (region &optional (d *default-viewpoint-d*)
					      (n *default-viewpoint-n*)
					      (s *default-viewpoint-s*))
  (or (find-region-viewpoints region d n s)
      (make-region-viewpoints region d n s)))

(defun find-region-viewpoints (region &optional (d *default-viewpoint-d*)
				      (n *default-viewpoint-n*) (s *default-viewpoint-s*))
  (let ((data (find (cons-viewpoint-parameters d n s) (viewpoint-data-for-region region)
		:key #'car :test #'equal)))
    (when data (second data))))

(defun viewpoint-data-for-region (region)
  (get-property-value region 'viewpoint-data))

(defun make-region-viewpoints (region d n s)
  (let ((viewpoints (create-region-n-viewpoints region :distance d :number n :spacing s)))
    (add-property-value region 'viewpoint-data (list (cons-viewpoint-parameters d n s)
						     viewpoints))
    viewpoints))

(defun set-region-viewpoints (region d n s)
;; clears old data (for testing)
  (set-property-value region 'viewpoint-data (list (cons-viewpoint-parameters d n s)
						   (create-region-n-viewpoints region
							  :distance d :number n :spacing s))))

(defun clear-region-viewpoints (region)
  (remove-property region 'viewpoint-data)
  t)

(defun region-viewpoints (region &optional (d *default-viewpoint-d*) (n *default-viewpoint-n*)
				 (s *default-viewpoint-s*))
  (find-region-viewpoints region d n s))

;; need to generalize this to define more than one viewpoint, either by number of viewpoints or
;; by distance between them
#+ignore
(defun create-region-viewpoints (region &optional (d 2))
  (loop for segment in (void-edges region)
	collect (make-viewpoint-for-segment segment region d)))

(defun create-region-n-viewpoints (region &key (distance 2) (number 1) spacing)
  (if spacing
      (loop for segment in (void-edges region)
	    append (make-spaced-viewpoints-for-segment segment region distance spacing))
      (loop for segment in (void-edges region)
	    append (make-n-viewpoints-for-segment segment region distance number))))

#+ignore
(defun make-viewpoint-for-segment (segment region &optional (d 2))
  ;; one coordinate is even with midpoint, one is d inside region
  (flet ((dot (vector pt)
	   (loop for x in (segments region)
		 as dot = (dot-vectors vector (vector-between-pts pt (endpoint1 x)))
		 when (not (= dot 0))
		   do (return dot))))
  (let ((midpt (multiple-value-call #'make-point (midpoint-x-y segment)))
	 (vector (normal-to-segment segment)))
    (when (> (dot vector midpt) 0)
      (setf (x vector) (- (x vector)))
      (setf (y vector) (- (y vector))))
    (scalar-mult d vector)
    (make-viewpoint (+ (point-x midpt) (x vector))
		    (+ (point-y midpt) (y vector)) d segment region))))

#+ignore
;; doesn't work for concave spaces
(defmacro with-segment-normal (segment region d &body body)
  `(flet ((dot (vector pt)
	   (loop for x in (segments ,region)
		 as dot = (dot-vectors vector (vector-between-pts pt (endpoint1 x)))
		 when (not (= dot 0))
		   do (return dot))))
  (let ((normal-vector (normal-to-segment ,segment)))
    (when (> (dot normal-vector (endpoint1 ,segment)) 0)
      (setf (x normal-vector) (- (x normal-vector)))
      (setf (y normal-vector) (- (y normal-vector))))
    ;; move "into" region by d
    (scalar-mult ,d normal-vector)
      ,@body)))

;; Above doesn't work for concave spaces.  Have to walk segments, accumulating change in
;; direction.  If total is < 0, inside polygon is rot90 from segment; otherwise -rot90 from
;; segment.

;; Note:  current coordinate system is left-handed (window) coordinate system, so angles are
;; opposite usual coordinate system.

(defun walk-edges-and-sum-angles (segment segments)
  (flet ((next-segment (pt segs)
	   (find pt segs :test #'(lambda (pt x) (or (eq pt (endpoint1 x))
						 (eq pt (endpoint2 x)))))))
    (let* ((sum 0)
	   (start-pt (endpoint1 segment))
	   (current-pt start-pt)
	   (current-seg segment)
	   (current-segs (remove segment segments)))
      (loop as other-pt = (other-endpoint current-seg current-pt)
	    as next-seg = (next-segment other-pt current-segs)
	    until (null current-segs) 
	    do (progn (setq sum (+ sum (segment-direction-change current-seg next-seg)))
		      (setq current-segs (remove next-seg current-segs))
		      (setq current-seg next-seg)
		      (setq current-pt other-pt))
	    finally (return sum)))))

(defmacro with-segment-normal (segment region d &body body)
  `(let ((normal-vector (normal-to-segment ,segment)))
    (when (> (walk-edges-and-sum-angles ,segment (edges ,region)) 0)
      (setf (vectr-x normal-vector) (- (x normal-vector)))
      (setf (vectr-y normal-vector) (- (y normal-vector))))
    ;; move "into" region by d
    (scalar-mult ,d normal-vector)
      ,@body))

(defun make-n-viewpoints-for-segment (segment region &optional (d 2) (n 1))
  ;; d is distance inside region
  ;; n is number of viewpoints
  (with-segment-normal segment region d
    (let* ((pt1 (endpoint1 segment))
	   (pt2 (endpoint2 segment))
	   (x1 (point-x pt1)) 
	   (y1 (point-y pt1))
	   (x-incr (/ (- (point-x pt2) x1) (+ 1 n)))
	   (y-incr (/ (- (point-y pt2) y1) (+ 1 n)))
	   (normal-x (x normal-vector))
	   (normal-y (y normal-vector)))
    (loop for i from 1 to n
	  collect (make-viewpoint (+ x1 (* i x-incr) normal-x)
				  (+ y1 (* i y-incr) normal-y)
				  d segment region)))))

#+ignore
(defun make-spaced-viewpoints-for-segment (segment region &optional (d 2) (s 1))
  ;; d is distance inside region
  ;; s is distance between viewpoints
  ;; normal-vector is (nonunit) vector normal to segment
  ;; segment-vector is unit vector in direction from endpoint2 to endpoint1
  (with-segment-normal segment region d
    (let* ((segment-vector (scalar-mult s (segment-unit-vector segment))) 
	   (x-incr (x segment-vector))
	   (y-incr (y segment-vector))
	   (normal-x (x normal-vector))
	   (normal-y (y normal-vector))
	   (pt1 (endpoint2 segment)))
      (loop for i from 1 to (floor (/ (segment-length segment) s))
	    with x1 = (+ (point-x pt1) normal-x)
	    with y1 = (+ (point-y pt1) normal-y)
	    as x = (+ x1 (* i x-incr))
	    as y = (+ y1 (* i y-incr))
	    collect (make-viewpoint x y d segment region)))))

;; version that adds viewpoints from either end or at midpoint if segment is short
(defun make-spaced-viewpoints-for-segment (segment region &optional (d 2) (s 1))
  ;; d is distance inside region
  ;; s is distance between viewpoints
  ;; normal-vector is (nonunit) vector normal to segment
  ;; segment-vector is unit vector in direction from endpoint2 to endpoint1
  (with-segment-normal segment region d
    (let* ((segment-vector (scalar-mult s (segment-unit-vector segment))) 
	   (x-incr (x segment-vector))
	   (y-incr (y segment-vector))
	   (normal-x (x normal-vector))
	   (normal-y (y normal-vector))
	   (pt1 (endpoint2 segment))
	   (pt2 (endpoint1 segment)))
    (if (<= (segment-length segment) (* 2 s))
	(multiple-value-bind (x y) 
	  (midpoint-x-y segment)
	  (list (make-viewpoint (+ x normal-x) (+ y normal-y) d segment region)))
	(let* ((count (1- (floor (/ (segment-length segment) s))))
	      (pt1-count (floor (/ count 2)))
	      (pt2-count (ceiling (/ count 2)))
	      (viewpoints nil))
	  (flet ((add-viewpoints (x1 y1 x-incr y-incr count)
		   (loop initially (push (make-viewpoint x1 y1 d segment region) viewpoints)
			 for i from 1 to count
			 as x = (+ x1 (* i x-incr))
			 as y = (+ y1 (* i y-incr))
			 do (push (make-viewpoint x y d segment region) viewpoints))))
	    ;; add viewpoints from one end (in direction of segment-vector)
	    (add-viewpoints (+ (point-x pt1) (* .5 x-incr) normal-x)
			    (+ (point-y pt1) (* .5 y-incr) normal-y) x-incr y-incr pt1-count)
	    ;; add viewpoints from other end (in opposite direction)
	    (add-viewpoints (- (point-x pt2) (* .5 x-incr) (- normal-x))
			    (- (point-y pt2) (* .5 y-incr) (- normal-y)) (- x-incr) (- y-incr)
			    pt2-count))
	  viewpoints)))))


(defun edge-intersects-box-p (recpt1 recpt2 segpt1 segpt2)
  ;; does segment segpt1-segpt2 intersect rectangle formed by recpt1 recpt2
  ;; or is segment inside box
  (let* ((recpt1x (point-x recpt1)) (recpt2x (point-x recpt2))
	(recpt1y (point-y recpt1)) (recpt2y (point-y recpt2))
	(pt1x (point-x segpt1)) (pt2x (point-x segpt2))
	(pt1y (point-y segpt1)) (pt2y (point-y segpt2))
	(x- recpt1x) (x+ recpt2x) (y- recpt1y) (y+ recpt2y))
    (when (< recpt2x recpt1x)
      (setq x- recpt2x
	    x+ recpt1x))
    (when (< recpt2y recpt1y)
      (setq y- recpt2y
	    y+ recpt1y))
    (clipper pt1x pt1y pt2x pt2y x- x+ y- y+)))


;; utility functions for setting visible tiles


(defun viewpoints-for-void-path-segments (viewpoints paths)
  (let ((segs (loop for path in paths
		    append (loop for node in (nodes path)
			     as seg = (corresponding-edge node)
			     when (voidp seg)
			       collect seg))))
    (loop for v in viewpoints
	  when (member (viewpoint-segment v) segs)
	    collect v)))

;; Which tiles in region1 are visible from region2?  

;; Specify either number of viewpoints  (viewpoint-n) or spacing between viewpoints
;; (viewpoint-spacing); also specify distance of viewpoint inside region (viewpoint-d)
;; default is one viewpoint 2 feet inside region

;; Note:  Really need to only check viewpoints that are associated with opening in path
;; between the two regions; get extra viewpoints otherwise; e.g. Cheney entry has
;; viewpoint for front door, which shouldn't enter into calculation for living room
;; visibility from entry:  Check nodes in paths that correspond to segments (as opposed
;; to being nodes in the center of a space), then check for void segments; only use
;; viewpoints for void segments along a path; probably don't need to check each path and
;; its traversed regions separately, can just check all viewpoints corresponding to void
;; segments along paths and all traversed regions.

;; Actually, do have to check for particular regions with particular viewpoints:  e.g. Cheney
;; entry has viewpoint for hall, which shouldn't enter into calculation for visibility
;; from entry to living room; should use path through dining area, which would mean that
;; viewpoint doesn't contribute to visibility count; otherwise viewpoint to hall is used to
;; calculate visible tiles through other openings, which correspond to other viewpoints.

;; Version that checks for cached grid and viewpoints (change #'get-or-set-region-viewpoints to
;; #'find-or-make-region-viewpoints)

(defun set-visible-tiles (to-region from-region
			      &optional (tile-size *default-tile-size*)
			      (viewpoint-d *default-viewpoint-d*)
			      (viewpoint-n *default-viewpoint-n*)
			      (viewpoint-spacing *default-viewpoint-s*))
  (let ((grid (find-or-make-grid-for-region to-region tile-size)))
    (unless (find-viewpoint-data grid from-region viewpoint-d viewpoint-n viewpoint-spacing)
      (let* ((viewpoints (find-or-make-region-viewpoints from-region viewpoint-d viewpoint-n
					   viewpoint-spacing))	
	     (paths (paths-from-x-to-y from-region to-region (territory-model to-region)))
	     (traversed-regions (mapappend #'path-signature paths)))
	(save-viewpoint-data grid from-region viewpoint-d viewpoint-n viewpoint-spacing)
  ;; for each viewpoint, check each tile to see if its midpoint is visible from the
  ;; viewpoint; visible = line between viewpoint and midpoint does not cross a region
  ;; edge also have to check edges of regions between two being checked
  ;; check for all regions along paths, and check all possible viewpoints
  ;; in from-region (instead of just those in shortest path)
	(loop for v in (viewpoints-for-void-path-segments viewpoints paths)
	      do (check-visibility grid v traversed-regions paths))))
	grid))

;; Only set visibility to t if segment between viewpoint and tile crosses void segment in
;; path; cuts down on viewpoints "looking" through other void segments besides their own.
;; May need to loosen this requirement if allow overlapping regions (some void edges may
;; be inside region in question), or calculate paths using all segments not just those
;; that are in bounded regions.

(defun check-visibility (grid viewpoint regions paths)
  ;; edges of regions may block view
  ;; only check edges that intersect bounding box formed by viewpoint and tile midpt
  (flet ((all-edges ()
	   #+ignore (mapappend #'nonvoid-edges regions)
	   (mapappend #'edges regions)))
    ;; assume if viewpoint already saved on grid no need to recheck visibility
      (loop-with-tiles grid
	(let* ((tile-midpt (tile-midpoint tile))
	      (edges-to-check
		(loop for edge in (all-edges)
		      when (edge-intersects-box-p (tile-midpoint tile) viewpoint
					       (endpoint1 edge) (endpoint2 edge))
				      collect edge)))
	  (if edges-to-check
	      (loop for edge in edges-to-check
		    as pt1 = (endpoint1 edge)
		    as pt2 = (endpoint2 edge)
		    with crossed-segments = (mapappend #'open-edges-crossed-by-path
						      (paths-crossing-edge
							(viewpoint-segment viewpoint) paths))
		      do ;; if no intersection, no information
		         (when (edge-intersection pt1 pt2 viewpoint tile-midpt)
			   (if (and (voidp edge) (member edge crossed-segments))
			       (set-tile-visibility tile viewpoint t)
			       (progn (set-tile-visibility tile viewpoint nil)
				      (loop-finish)))))
	      (set-tile-visibility tile viewpoint t)))))
  grid)

;; check all edges in model; doesn't just check edges along path that includes viewpoint's 
;; opening; causes viewpoints to "look through" other openings; e.g. difference between 
;; vis-open for c-1 sunporch from living:  .796 with above fcn; .918 with below fcn

(defun check-visibility2 (grid viewpoint &rest ignore)
  ignore
  (flet ((all-edges ()
	   (mapappend #'edges (territories (territory-model (grid-region grid))))))
    ;; assume if viewpoint already saved on grid no need to recheck visibility
      (loop-with-tiles grid
	(let* ((tile-midpt (tile-midpoint tile))
	      (edges-to-check
		(loop for edge in (all-edges)
		      when (edge-intersects-box-p (tile-midpoint tile) viewpoint
					       (endpoint1 edge) (endpoint2 edge))
				      collect edge)))
	  (if edges-to-check
	      (loop for edge in edges-to-check
		    as pt1 = (endpoint1 edge)
		    as pt2 = (endpoint2 edge)
		      do ;; if no intersection, no information
		         (when (edge-intersection pt1 pt2 viewpoint tile-midpt)
			     (if (openp edge)
				 (set-tile-visibility tile viewpoint t)
				 (progn (set-tile-visibility tile viewpoint nil edge)
					#+ignore(loop-finish)))))	;if want all
	      (set-tile-visibility tile viewpoint t)))))
  grid)

;; what if want visible tiles for viewpoints other than the current ones?
;; now have to set current ones, then call this method

;; doesn't set visible tiles, just collects them
;; really need to specifry viewpoint-info too so can get particular viewpoints

(defmethod visible-tiles ((to-region territory) (from-region territory)
			  &optional (tile-size *default-tile-size*)
			  (d *default-viewpoint-d*) (n *default-viewpoint-n*)
			  (s *default-viewpoint-s*))
  (let ((vis-tiles nil)
	(viewpoints (region-viewpoints from-region d n s)))
    (loop-with-tiles (grid-for-region to-region tile-size)
      (when (some #'(lambda (x) (visible-from-p tile x)) viewpoints)
	(push tile vis-tiles)))
    vis-tiles))

(defmethod viewpoints-with-visible-tiles ((to-region territory) (from-region territory)
			  &optional (tile-size *default-tile-size*)
			  (d *default-viewpoint-d*) (n *default-viewpoint-n*)
			  (s *default-viewpoint-s*))
  (let ((vis-pts nil)
	(viewpoints (region-viewpoints from-region d n s)))
    (loop-with-tiles (grid-for-region to-region tile-size)
      (loop for v in viewpoints
	    when (visible-from-p tile v)
	      do (pushnew v vis-pts)))
    vis-pts))

(defmethod tiles-visible-from-any-region ((to-region territory) (from-regions list)
					  &optional (tile-size *default-tile-size*)
					  (d *default-viewpoint-d*) (n *default-viewpoint-n*)
					  (s *default-viewpoint-s*))
  (let ((vis-tiles nil)
	(viewpoints (mapappend #'(lambda(x) (region-viewpoints x d n s)) from-regions)))
    (loop-with-tiles (grid-for-region to-region tile-size)
      (when (some #'(lambda (x) (visible-from-p tile x)) viewpoints)
	(push tile vis-tiles)))
    vis-tiles))

(defmethod tiles-visible-from-all-regions ((to-region territory) (from-regions list)
					   &optional (tile-size *default-tile-size*)
					   (d *default-viewpoint-d*) (n *default-viewpoint-n*)
					   (s *default-viewpoint-s*))
  (let ((vis-tiles nil)
	(all-viewpoints (mapcar #'(lambda(x) (region-viewpoints x d n s)) from-regions)))
    (loop-with-tiles (grid-for-region to-region tile-size)
      (block viewpoint-loop
	(loop for viewpoints in all-viewpoints
	      do (unless (some #'(lambda (x) (visible-from-p tile x)) viewpoints)
		   (return-from viewpoint-loop))
	       finally (push tile vis-tiles))))
    vis-tiles))

(defmethod invisible-tiles ((to-region territory) (from-region territory)
			    &optional (tile-size *default-tile-size*)
			    (d *default-viewpoint-d*) (n *default-viewpoint-n*)
			    (s *default-viewpoint-s*))
  (let ((vis-tiles nil)
	(viewpoints (region-viewpoints from-region d n s)))
    (loop-with-tiles (grid-for-region to-region tile-size)
      (when (every #'(lambda (x) (not (visible-from-p tile x))) viewpoints)
	(push tile vis-tiles)))
    vis-tiles)) 



;; Measures

(defmethod visibility-measure ((to-region territory) from-region
			       &optional (tile-size *default-tile-size*)
			       (d *default-viewpoint-d*) (n *default-viewpoint-n*)
			       (s *default-viewpoint-s*))
  (/ (length (visible-tiles to-region from-region tile-size d n s))
     (float (grid-tile-count (grid-for-region to-region tile-size)))))

(defmethod visibility-measure ((number-of-tiles integer) region
			       &optional (tile-size *default-tile-size*)
			       d n s)
  d n s
  (/ number-of-tiles
     (float (grid-tile-count (grid-for-region region tile-size)))))

(defmethod visibility-measure ((tiles list) region
			       &optional (tile-size *default-tile-size*) d n s)
  d n s
  (/ (length tiles)
     (float (grid-tile-count (grid-for-region region tile-size))))) 


;;; display

(defvar *draw-viewpoints* nil)

(defmethod draw-self :after ((region territory) stream)
  (when *draw-viewpoints*
    (draw-viewpoints region stream)))

(defmethod draw-viewpoints ((region territory) stream &optional
			  (d *default-viewpoint-d*) (n *default-viewpoint-n*)
			  (s *default-viewpoint-s*)) 
  (dolist (viewpoint (region-viewpoints region d n s))
    (draw-self viewpoint stream)))

(defmethod draw-relevant-viewpoints ((to-region territory) (from-region territory)
				     stream &optional (tile-size *default-tile-size*)
			  (d *default-viewpoint-d*) (n *default-viewpoint-n*)
			  (s *default-viewpoint-s*))
  (dolist (viewpoint (viewpoints-with-visible-tiles to-region from-region tile-size d n s))
    (draw-self viewpoint stream)))

(defmethod draw-visible-tiles ((to-region territory) from-region stream
			       &optional (tile-size *default-tile-size*)
			  (d *default-viewpoint-d*) (n *default-viewpoint-n*)
			  (s *default-viewpoint-s*))
  (when (grid-for-region to-region tile-size)
    (dolist (tile (visible-tiles to-region from-region tile-size d n s))
      (draw-self (tile-midpoint tile) stream))))

(defmethod draw-all-tiles ((region territory) stream
			   &optional (tile-size *default-tile-size*))
  (let ((grid (grid-for-region region tile-size)))
    (when grid
      (loop-with-tiles grid
	(draw-self (tile-midpoint tile) stream)))))

(defmethod draw-tiles-visible-from-all-regions ((to-region territory) regions stream
						&optional (tile-size *default-tile-size*)
						(d *default-viewpoint-d*)
						(n *default-viewpoint-n*)
						(s *default-viewpoint-s*))
  (when (grid-for-region to-region tile-size)
    (dolist (tile (tiles-visible-from-all-regions to-region regions tile-size d n s))
      (draw-self (tile-midpoint tile) stream))))

(defmethod draw-tiles-visible-from-any-region ((to-region territory) regions stream
					       &optional (tile-size *default-tile-size*)
					       (d *default-viewpoint-d*)
					       (n *default-viewpoint-n*)
					       (s *default-viewpoint-s*))
  (when (grid-for-region to-region tile-size)
    (dolist (tile (tiles-visible-from-any-region to-region regions tile-size d n s))
      (draw-self (tile-midpoint tile) stream))))