From 7c3a719b314c8d56cec03a6204e33fe848aa47d9 Mon Sep 17 00:00:00 2001 From: Helmut Merz Date: Sun, 27 Sep 2026 17:05:31 +0200 Subject: [PATCH] csys/space:neighbors basically working --- csys/space.lisp | 34 ++++++++++++++++++---------------- test/test-csys.lisp | 18 +++++++++--------- util/util.lisp | 6 +++++- 3 files changed, 32 insertions(+), 26 deletions(-) diff --git a/csys/space.lisp b/csys/space.lisp index a5df309..c5fa682 100644 --- a/csys/space.lisp +++ b/csys/space.lisp @@ -31,36 +31,38 @@ nil) (defun neighbors (spc loc &key (dist 2)) - (let* ((from (floor (sqrt dist))) - (to (- from))) - ) - ) + (let* ((to (floor (sqrt dist))) + (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) - (let (v) - (loop - (setf v (funcall it)) - (if v - (funcall fn v) - (return))))) - -(defun loc-iterator (from to &key (dims 2)) +(defun loc-iterator (from to &key (dim 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)) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index 3aca591..4c33e9a 100644 --- a/test/test-csys.lisp +++ b/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)) - loc all) - (loop - (setf loc (funcall it)) - (if loc - (push loc all) - (return))) - (print all)) + (util:with-iterator (space:loc-iterator -1 1) + (lambda (loc) + (push loc locs))) + (== (length locs) 9) + (== (car locs) #(1 1)) + (== (car (last locs)) #(-1 -1)) + (== (car (space:neighbors spc #(1 1))) 46) )) (deftest test-basic-0 () diff --git a/util/util.lisp b/util/util.lisp index 6a080e5..fb30dc7 100644 --- a/util/util.lisp +++ b/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 " "))