[bknr-cvs] ksprotte changed trunk/projects/bos/

[BKNR Commits]

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

moved simple queue to bos.m2
U   trunk/projects/bos/m2/allocation.lisp
U   trunk/projects/bos/m2/packages.lisp
U   trunk/projects/bos/m2/utils.lisp
U   trunk/projects/bos/web/quad-tree.lisp

Modified: trunk/projects/bos/m2/allocation.lisp
===================================================================
--- trunk/projects/bos/m2/allocation.lisp	2008-07-23 16:19:59 UTC (rev 3592)
+++ trunk/projects/bos/m2/allocation.lisp	2008-07-23 17:53:36 UTC (rev 3593)
@@ -299,13 +299,13 @@
   (unless (funcall pred start-x start-y)
     (error "sqm ~A/~A not allocatable" start-x start-y))
   (let* ((allocated (make-hash-table :test #'equal))
-         (border-queue (bos.web::make-queue))
+         (border-queue (make-queue))
          connected)
     (labels
-        ((enqueue (x y)
+        ((enqueue* (x y)
            (let ((key (list x y)))
              (setf (gethash key allocated) t)
-             (bos.web::enqueue key border-queue)))
+             (enqueue key border-queue)))
          (try-get (&rest key)           
            (and (not (gethash key allocated))
                 (apply pred key)
@@ -315,20 +315,20 @@
                (try-get x (1+ y))
                (try-get (1- x) y)
                (try-get x (1- y)))))
-      (enqueue start-x start-y)
+      (enqueue* start-x start-y)
       (dotimes (i (1- n)
-                (append connected (bos.web::queue-elements border-queue)))
+                (append connected (queue-elements border-queue)))
         (tagbody
          retry
-           (destructuring-bind (x y) (bos.web::peek-queue border-queue)
+           (destructuring-bind (x y) (peek-queue border-queue)
              (let ((next (get-next-neighbor x y)))
                (cond
                  (next
-                  (apply #'enqueue next))
-                 ((bos.web::queue-empty-p border-queue)
+                  (apply #'enqueue* next))
+                 ((queue-empty-p border-queue)
                   (return nil))
                  (t
-                  (push (bos.web::dequeue border-queue) connected)
+                  (push (dequeue border-queue) connected)
                   (go retry))))))))))
 
 (defun allocate-in-area (area n)

Modified: trunk/projects/bos/m2/packages.lisp
===================================================================
--- trunk/projects/bos/m2/packages.lisp	2008-07-23 16:19:59 UTC (rev 3592)
+++ trunk/projects/bos/m2/packages.lisp	2008-07-23 17:53:36 UTC (rev 3593)
@@ -260,6 +260,13 @@
 	   #:mail-print-pdf
 
 	   #:*cert-download-directory*
+
+           #:make-queue
+           #:queue-empty-p
+           #:enqueue
+           #:dequeue
+           #:queue-elements
+           #:peek-queue           
            ))
 
 (defpackage :bos.m2.cert-generator

Modified: trunk/projects/bos/m2/utils.lisp
===================================================================
--- trunk/projects/bos/m2/utils.lisp	2008-07-23 16:19:59 UTC (rev 3592)
+++ trunk/projects/bos/m2/utils.lisp	2008-07-23 17:53:36 UTC (rev 3593)
@@ -54,4 +54,28 @@
                (t
                 (let ((obj (funcall tie-breaker free-objs result)))
                   (setf free-objs (remove obj free-objs))
-                  (next-result obj))))))))
\ No newline at end of file
+                  (next-result obj))))))))
+
+;;; simple queue
+(defun make-queue ()
+  (cons nil nil))
+
+(defun queue-empty-p (queue)
+  (null (car queue)))
+
+(defun enqueue (x queue)
+  (if (null (car queue))
+      (setf (cdr queue) (setf (car queue) (list x)))
+    (setf (cdr (cdr queue)) (list x)
+          (cdr queue) (cdr (cdr queue))))
+  (caar queue))
+
+(defun dequeue (queue)
+  (pop (car queue)))
+
+(defun queue-elements (queue)
+  (car queue))
+
+(defun peek-queue (queue)
+  (caar queue))
+

Modified: trunk/projects/bos/web/quad-tree.lisp
===================================================================
--- trunk/projects/bos/web/quad-tree.lisp	2008-07-23 16:19:59 UTC (rev 3592)
+++ trunk/projects/bos/web/quad-tree.lisp	2008-07-23 17:53:36 UTC (rev 3593)
@@ -118,29 +118,6 @@
 (defvar *m2-geo-box* (make-geo-box 116.92538417241805d0 -0.9942953097298868d0
                                    117.02245623511905d0 -1.0920067364569994d0))
 
-;;; simple queue
-(defun make-queue ()
-  (cons nil nil))
-
-(defun queue-empty-p (queue)
-  (null (car queue)))
-
-(defun enqueue (x queue)
-  (if (null (car queue))
-      (setf (cdr queue) (setf (car queue) (list x)))
-    (setf (cdr (cdr queue)) (list x)
-          (cdr queue) (cdr (cdr queue))))
-  (caar queue))
-
-(defun dequeue (queue)
-  (pop (car queue)))
-
-(defun queue-elements (queue)
-  (car queue))
-
-(defun peek-queue (queue)
-  (caar queue))
-
 ;;; quad-node
 (defclass quad-node ()
   ((geo-box :reader geo-box :initarg :geo-box :type geo-box)