[bknr-cvs] ksprotte changed trunk/projects/bos/web/contract-tree.lisp

[BKNR Commits]

Revision: 3438
Author: ksprotte
URL: http://bknr.net/trac/changeset/3438

contract-tree small refactoring

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

Modified: trunk/projects/bos/web/contract-tree.lisp
===================================================================
--- trunk/projects/bos/web/contract-tree.lisp	2008-07-14 18:10:10 UTC (rev 3437)
+++ trunk/projects/bos/web/contract-tree.lisp	2008-07-15 07:45:57 UTC (rev 3438)
@@ -9,6 +9,9 @@
    (kml-req-count :initform 0 :accessor kml-req-count)
    (image-req-count :initform 0 :accessor image-req-count)))
 
+(defun contract-node-set-timestamp-now (node)
+  (setf (timestamp node) (get-universal-time)))
+
 (defun contract-node-find-corresponding-store-image (node)  
   (first (get-keyword-store-images (contract-node-keyword node))))
 
@@ -18,7 +21,7 @@
     (if (and image (probe-file (blob-pathname image)))
         (setf (image node) image
               (timestamp node) (blob-timestamp image))
-        (setf (timestamp node) (get-universal-time)))))
+        (contract-node-set-timestamp-now node))))
 
 (defvar *contract-tree* nil)
 (defparameter *contract-tree-images-size* 128) ; was 256
@@ -75,8 +78,7 @@
 (defun insert-contract (contract-tree contract)
   (let ((geo-box (contract-geo-box contract))
         (geo-center (contract-geo-center contract)))
-    (ensure-intersecting-children contract-tree geo-box
-                                  (lambda (node) (setf (timestamp node) (get-universal-time))))
+    (ensure-intersecting-children contract-tree geo-box #'contract-node-set-timestamp-now)
     (let ((placemark-node (find-node-if (lambda (node) (contract-placemark-at-node-p node contract))
                                         contract-tree
                                         :prune-test (lambda (node)
@@ -92,8 +94,7 @@
       (setf (placemark-contracts node)
             (delete contract (placemark-contracts node)))
       ;; mark intersecting children as dirty
-      (ensure-intersecting-children contract-tree geo-box
-                                    (lambda (node) (setf (timestamp node) (get-universal-time)))))))
+      (ensure-intersecting-children contract-tree geo-box #'contract-node-set-timestamp-now))))
 
 (defun contract-tree-changed (contract-tree contract &key type)
   (case type
@@ -232,7 +233,6 @@
       (cl-gd:with-image (cl-gd:*default-image* image-size image-size t)
         (setf (cl-gd:save-alpha-p) t
               (cl-gd:alpha-blending-p) nil)
-        ;; (cl-gd:draw-rectangle* 0 0 127 127 :filled nil :color (cl-gd:find-color 255 0 0))
         (let ((transparent (cl-gd:find-color 255 255 255 :alpha 127))
               (subbox (make-geo-box 0d0 0d0 0d0 0d0)))
           (cl-gd:do-rows (y)