Changeset 3470

Show
Ignore:
Timestamp:
07/16/08 17:05:15 (4 months ago)
Author:
ksprotte
Message:

renamed allocation-cache to allocation-area-inclusion-cache

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/projects/bos/m2/map.lisp

    r3400 r3470  
    8080    pixel-rgb-value)) 
    8181 
    82 (defstruct (allocation-cache (:conc-name ac-)) 
     82;;; allocation-area-inclusion-cache 
     83(defstruct (allocation-area-inclusion-cache (:conc-name ac-)) 
    8384  x y width height array areas) 
    8485 
    85 (defvar *allocation-cache* nil 
    86   "allocation-cache struct indicating whether a certain square meter is inside of an allocation area") 
     86(defvar *allocation-area-inclusion-cache* nil 
     87  "allocation-area-inclusion-cache struct indicating whether a certain square meter is inside of an allocation area") 
    8788 
    8889(defun point-in-any-allocation-area-p% (x-coord y-coord) 
    …… 
    9394           (store-objects-with-class 'allocation-area))) 
    9495 
    95 (defun initialize-allocation-cache () 
     96(defun initialize-allocation-area-inclusion-cache () 
    9697  (destructuring-bind (x y width height) (allocation-areas-bounding-box) 
    97     (setf *allocation-cache* 
    98           (make-allocation-cache :x x :y y :width width :height height 
     98    (setf *allocation-area-inclusion-cache* 
     99          (make-allocation-area-inclusion-cache :x x :y y :width width :height height 
    99100                                 :array (make-array (list width height) :element-type '(unsigned-byte 1)) 
    100101                                 :areas (class-instances 'allocation-area)))) 
    101   (dolist (area (ac-areas *allocation-cache*)) 
     102  (dolist (area (ac-areas *allocation-area-inclusion-cache*)) 
    102103    (destructuring-bind (top-left-x top-left-y width height) (allocation-area-bounding-box2 area) 
    103104      (dotimes (x width) 
    …… 
    107108            (when (and (point-in-polygon-p x-coord y-coord (allocation-area-bounding-box area)) 
    108109                       (point-in-polygon-p x-coord y-coord (allocation-area-vertices area))) 
    109               (setf (aref (ac-array *allocation-cache*) 
    110                           (- x-coord (ac-x *allocation-cache*)) 
    111                           (- y-coord (ac-y *allocation-cache*))) 
     110              (setf (aref (ac-array *allocation-area-inclusion-cache*) 
     111                          (- x-coord (ac-x *allocation-area-inclusion-cache*)) 
     112                          (- y-coord (ac-y *allocation-area-inclusion-cache*))) 
    112113                    1)))))))) 
    113114 
    114 (defvar *allocation-cache-lock* (bt:make-lock "Area Cache Lock")) 
    115  
    116 (defun validate-allocation-cache () 
    117   (bt:with-lock-held (*allocation-cache-lock*) 
    118     (unless (and *allocation-cache* 
     115(defvar *allocation-area-inclusion-cache-lock* (bt:make-lock "Area Cache Lock")) 
     116 
     117(defun validate-allocation-area-inclusion-cache () 
     118  (bt:with-lock-held (*allocation-area-inclusion-cache-lock*) 
     119    (unless (and *allocation-area-inclusion-cache* 
    119120                 (equal (class-instances 'allocation-area) 
    120                         (ac-areas *allocation-cache*))) 
    121       (initialize-allocation-cache)))) 
     121                        (ac-areas *allocation-area-inclusion-cache*))) 
     122      (initialize-allocation-area-inclusion-cache)))) 
    122123 
    123124(defun point-in-any-allocation-area-p (x-coord y-coord) 
    124   (and (< -1 (- x-coord (ac-x *allocation-cache*)) (ac-width *allocation-cache*)) 
    125        (< -1 (- y-coord (ac-y *allocation-cache*)) (ac-height *allocation-cache*)) 
    126        (plusp (aref (ac-array *allocation-cache*) 
    127                     (- x-coord (ac-x *allocation-cache*)) 
    128                     (- y-coord (ac-y *allocation-cache*)))))) 
     125  (and (< -1 (- x-coord (ac-x *allocation-area-inclusion-cache*)) (ac-width *allocation-area-inclusion-cache*)) 
     126       (< -1 (- y-coord (ac-y *allocation-area-inclusion-cache*)) (ac-height *allocation-area-inclusion-cache*)) 
     127       (plusp (aref (ac-array *allocation-area-inclusion-cache*) 
     128                    (- x-coord (ac-x *allocation-area-inclusion-cache*)) 
     129                    (- y-coord (ac-y *allocation-area-inclusion-cache*)))))) 
    129130   
    130131(defclass image-tile (tile) 
    …… 
    153154 
    154155(defmethod image-tile-process ((tile image-tile) (operation (eql :areas))) 
    155   (validate-allocation-cache) 
     156  (validate-allocation-area-inclusion-cache) 
    156157  (do-rows (y) 
    157158    (do-pixels-in-row (x) 

  • trunk/projects/bos/test/allocation.lisp

    r3468 r3470  
    209209  (finishes (delete-object (make-contract (make-sponsor :login "test-sponsor") 1 :paidp nil)))) 
    210210 
    211 (test validate-allocation-cache 
     211(test validate-allocation-area-inclusion-cache 
    212212  (with-fixture initial-bos-store () 
    213213    (let ((area1 (make-allocation-rectangle 0 0 8 8))) 
    214       (finishes (bos.m2::validate-allocation-cache))))) 
     214      (finishes (bos.m2::validate-allocation-area-inclusion-cache)))))