csys/space:neighbors basically working

csys/space.lisp

@@ -31,36 +31,38 @@
   nil)
 
 (defun neighbors (spc loc &key (dist 2))
-  (let* ((from (floor (sqrt dist)))
+  (let* ((to (floor (sqrt dist)))
-         (to (- from)))
+         (from (- to))
-    )
+         nbrs)
-  )
+    (util:with-iterator (loc-iterator from to)
+      (lambda (rloc)
+        (let* ((cloc (loc-add rloc loc))
+               (cell (fetch spc cloc)))
+          (when cell (push cell nbrs)))))
+    nbrs))
 
 (defun free-loc-at (spc loc &key (dist 2)))
 
 (defun distance-sq (spc loc1 loc2))
 
-(defun do-it (it fn)
+(defun loc-iterator (from to &key (dim 2))
-  (let (v)
-    (loop
-      (setf v (funcall it))
-      (if v
-        (funcall fn v)
-        (return)))))
-
-(defun loc-iterator (from to &key (dims 2))
   (labels (
     (inc (cur idx)
-      (when (< idx dims)
+      (when (< idx dim)
         (let ((new (1+ (aref cur idx))))
           (setf (aref cur idx) new)
           (when (> new to)
             (setf (aref cur idx) from)
             (setf cur (inc cur (1+ idx))))
           cur))))
-    (let ((cur (make-array dims :initial-element from)))
+    (let ((cur (make-array dim :initial-element from)))
       (lambda ()
         (when cur
-          (prog1 (make-array dims :initial-contents cur)
+          (prog1 (make-array dim :initial-contents cur)
             (setf cur (inc cur 0))))))))
 
+(defun loc-add (l1 l2)
+  (let* ((dim (car (array-dimensions l1)))
+         (loc (make-array dim :initial-contents l1)))
+    (loop for i to (1- dim) do (setf (aref loc i) (+ (aref l1 i) (aref l2 i))))
+    loc))

test/test-csys.lisp

@@ -78,7 +78,8 @@
 ;;;; test definitions
 
  (deftest test-space ()
-  (let ((spc (space:create)))
+  (let ((spc (space:create))
+        locs)
     (space:put spc #(1 1) 42)
     (space:put spc #(1 2) 46)
     (ignore-errors 
@@ -87,14 +88,13 @@
     (== (space:fetch spc #(1 2)) 46)
     (space:del spc #(1 1))
     (== (space:fetch spc #(1 1)) nil)
-    (let ((it (space:loc-iterator -1 1))
+    (util:with-iterator (space:loc-iterator -1 1)
-          loc all)
+      (lambda (loc)
-      (loop 
+        (push loc locs)))
-        (setf loc (funcall it))
+    (== (length locs) 9)
-        (if loc
+    (== (car locs) #(1 1))
-          (push loc all)
+    (== (car (last locs)) #(-1 -1))
-          (return)))
+    (== (car (space:neighbors spc #(1 1))) 46)
-      (print all))
     ))
  
 (deftest test-basic-0 ()

util/util.lisp

@@ -11,7 +11,7 @@
            #:rfill #:rtrim 
            #:loop-plist #:filter-plist #:map-plist 
            #:plist-pairs #:plist-equal #:plist-add #:plist-merge
-           #:mv-bind
+           #:mv-bind #:with-iterator
            #:flatten-str #:from-keyword #:to-keyword #:to-integer #:to-string
            #:from-bytes #:to-bytes #:b64-decode #:b64-encode #:from-b64 #:to-b64
            #:absolute-dir #:check-dir #:ensure-dir #:home-path #:path-from-string
@@ -102,6 +102,10 @@
   `(destructuring-bind ,(cons (car vars) (cons '&optional (cdr vars))) 
        (multiple-value-list ,vform) ,@body))
 
+(defun with-iterator (it fn)
+  (do ((v (funcall it) (funcall it))) ((null v))
+    (funcall fn v)))
+
 ;;;; strings, symbols, keywords, ...
 
 (defun flatten-str (s &key (sep " "))