Changeset 3196

Show
Ignore:
Timestamp:
05/27/08 14:47:59 (8 months ago)
Author:
ksprotte
Message:

new function rectangle-geo-box

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/projects/bos/web/quad-tree.lisp

    r3195 r3196  
    6464                 :top-left (make-point :lon (geo-box-west box) :lat (geo-box-north box)) 
    6565                 :bottom-right (make-point :lon (geo-box-east box) :lat (geo-box-south box)))) 
     66 
     67(defun rectangle-geo-box (rectangle) 
     68  (multiple-value-bind (west north) 
     69      (point-lon-lat (top-left rectangle)) 
     70    (multiple-value-bind (east south) 
     71        (point-lon-lat (bottom-right rectangle)) 
     72      (make-geo-box west north east south)))) 
    6673 
    6774(defun geo-subbox (box x y divisor subbox) 
    …… 
    130137          "~s needs a geo-box" obj)) 
    131138 
     139(defmethod print-object ((node quad-node) stream) 
     140  (print-unreadable-object (node stream :type t :identity t) 
     141    (format stream "path: ~a" (node-path node)))) 
     142 
    132143(defmethod extensions ((node null)) nil) 
    133144 
    …… 
    265276  (unless (funcall leaf-test node) 
    266277    (dolist (index (intersecting-children-indices node geo-box)) 
    267       (ensure-intersecting-children (ensure-child node index) geo-box function)))) 
     278      (ensure-intersecting-children (ensure-child node index) geo-box function leaf-test)))) 
    268279 
    269280(defun map-nodes (function node &key (prune-test (constantly nil)))