Changeset 3138

Show
Ignore:
Timestamp:
05/19/08 10:29:28 (6 months ago)
Author:
ksprotte
Message:

making the syntax for kml-overlay more flexible

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/projects/bos/tmp/chess-board.lisp

    r3017 r3138  
    162162                         (let ((rect (make-rectangle2 (geo-location obj)))) 
    163163                           (kml-overlay (format nil "http://~a/contract-tree-image/~d" (website-host) (id obj)) 
    164                                         rect (+ 100 (depth obj)) 0)))        
     164                                        rect :draw-order (+ 100 (depth obj)) :absolute 0)))        
    165165                       ;; (cond 
    166166                       ;;                            ;; we deal with small-contracts differently at last layer 

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

    r3135 r3138  
    135135  (some #'identity (children node))) 
    136136 
     137(defun any-child (node) 
     138  (find-if #'identity (children node))) 
     139 
    137140(defun child-index (node child) 
    138141  (dotimes (i 4) 
    …… 
    190193(defclass contract-tree-node (quad-tree-node) 
    191194  ((timestamp :accessor timestamp :initform (get-universal-time)) 
    192    (placemark-contracts :initform nil :accessor placemark-contracts))) 
     195   (placemark-contracts :initform nil :accessor placemark-contracts) 
     196   (kml-req-count :initform 0 :accessor kml-req-count) 
     197   (image-req-count :initform 0 :accessor image-req-count))) 
    193198 
    194199(defvar *contract-tree* nil) 
    …… 
    284289  (if (zerop (depth node)) 
    285290      16 
    286       256)) 
     291      512)) 
    287292 
    288293(defmethod network-link-lod-max ((node contract-tree-node)) 
    …… 
    318323                        (rmcpath) (rmcid)) 
    319324      (handle-if-node-modified 
     325        (incf (kml-req-count node)) 
    320326        (setf (hunchentoot:header-out :last-modified) 
    321327              (hunchentoot:rfc-1123-date (timestamp node))) 
    …… 
    336342            ;; overlay 
    337343            (kml-overlay (format nil "http://~a/contract-tree-image?path=~{~d~}" (website-host) path) 
    338                          rect (+ 1 (* 2 (depth node))) 0 
     344                         rect 
     345                         :draw-order (+ 1000 (depth node)) 
     346                         ;; :absolute 0 
    339347                         ;; GroundOverlay specific LOD 
    340                          `(:min ,(network-link-lod-min node) :max ,(network-link-lod-max node))) 
     348                         :lod `(:min ,(network-link-lod-min node) 
     349                                     :max ,(if (node-has-children-p node) 
     350                                               (* 6 (network-link-lod-min (any-child node))) 
     351                                               -1))) 
    341352            ;; placemark-contracts 
    342353            (let ((placemark-contracts 
    …… 
    389400  (with-query-params (path) 
    390401    (handle-if-node-modified 
     402      (incf (image-req-count node)) 
    391403      (let ((box (geo-box node)) 
    392             (image-size *contract-tree-images-size*))         
     404            (image-size (progn *contract-tree-images-size* 128)))         
    393405        (cl-gd:with-image (cl-gd:*default-image* image-size image-size t) 
    394406          (setf (cl-gd:save-alpha-p) t 
    395407                (cl-gd:alpha-blending-p) nil) 
     408          ;; (cl-gd:draw-rectangle* 0 0 127 127 :filled nil :color (cl-gd:find-color 255 0 0)) 
    396409          (let ((white (cl-gd:find-color 255 255 255 :alpha 127)) 
    397410                (subbox (make-geo-box 0d0 0d0 0d0 0d0))) 

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

    r3122 r3138  
    284284  (kml-lat-lon-box rect "LatLonAltBox")) 
    285285 
    286 (defun kml-overlay (img-path rect &optional (drawOrder 0) absolute lod) 
     286(defun kml-overlay (img-path rect &key (draw-order 0) absolute lod) 
    287287  (with-element "GroundOverlay" 
    288288    (with-element "name" (text (file-namestring img-path))) 
    289289    (when lod (kml-region rect lod)) 
    290     (with-element "drawOrder" (integer-text drawOrder)) 
     290    (with-element "drawOrder" (integer-text draw-order)) 
    291291    (with-element "Icon" 
    292292      (with-element "href" (text img-path)) 
    …… 
    622622        (kml-region rect lod) 
    623623        (kml-overlay (format nil "http://~a/image/~d" (website-host) (store-object-id obj)) 
    624                      rect (* 2 (depth obj)) 0) 
     624                     rect 
     625                     :draw-order (depth obj) 
     626                     ;; :absolute 0 
     627                     ) 
    625628        (dolist (child (children obj)) 
    626629          (kml-network-link (format nil "http://~a/image-tree-kml/~d" (website-host) (store-object-id child))