Changeset 3197
- Timestamp:
- 05/27/08 14:48:28 (8 months ago)
- Files:
-
- trunk/projects/bos/web/sat-tree.lisp (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
- Modified
- Copied
- Moved
trunk/projects/bos/web/sat-tree.lisp
r3179 r3197 3 3 (defclass sat-node (node-extension) 4 4 ((image :accessor image :initarg :image :type store-image))) 5 6 (defmethod leaf-node-p ((node sat-node))7 t) ; for now8 5 9 6 (defpersistent-class sat-layer () … … 12 9 (defpersistent-class sat-image (store-image) 13 10 ((layer :reader layer :initarg :layer) 14 (node :reader node :initarg :node) 11 (node :reader node :initarg :node :transient t) 12 (path :reader path :initarg :path) 15 13 (image-geo-box :accessor image-geo-box :initarg :image-geo-box 16 14 :type geo-box … … 23 21 (name (layer obj))) 24 22 25 (defun make-sat-layer (image geo-box name &optional (start-depth 0)) 26 (check-type image cl-gd::image) 27 (assert (geo-box-encloses-p *m2-geo-box* geo-box)) 28 (check-type name symbol) 29 (assert (not (find name (class-instances 'sat-layer) :key #'name))) 30 (check-type start-depth (integer 0)) 31 ) 23 ;;; was passiert, wenn die tile intersections sehr klein (sozusagen 24 ;;; Rundungsfehler) sind 25 (defun make-sat-layer (image geo-box name &optional (start-depth 0)) 26 (labels ((layer-quad-nodes () 27 (let (nodes) 28 (ensure-intersecting-children *quad-tree* geo-box 29 (lambda (n) (when (= start-depth (depth n)) 30 (push n nodes))) 31 (lambda (n) (= start-depth (depth n)))) 32 nodes))) 33 (check-type image cl-gd::image) 34 (assert (geo-box-encloses-p *m2-geo-box* geo-box)) 35 (check-type name symbol) 36 (assert (not (find name (class-instances 'sat-layer) :key #'name))) 37 (check-type start-depth (integer 0)) 38 (let ((layer-quad-nodes (layer-quad-nodes))) 39 layer-quad-nodes))) 32 40 41 ;; (with-store-image (image (first (class-instances 'store-image))) 42 ;; (make-sat-layer image 43 ;; (rectangle-geo-box (make-rectangle :x 5400 :y 5400 :width 2000 :height 2000)) 44 ;; :sat1 45 ;; 3)) 46
