66 lines
1.6 KiB
Common Lisp
66 lines
1.6 KiB
Common Lisp
;;;; cl-scopes/csys/space
|
|
;;;; definitions for (spatial) registering and retrieving objects by location
|
|
|
|
(defpackage :scopes/csys/space
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:alx :alexandria)
|
|
(:util :scopes/util))
|
|
(:export #:create #:put #:del #:fetch #:query
|
|
#:neighbors #:free-loc-at #:distance-sq
|
|
#:loc-iterator))
|
|
|
|
(in-package :scopes/csys/space)
|
|
|
|
(defun create ()
|
|
(make-hash-table :test #'equalp))
|
|
|
|
(defun put (spc loc obj)
|
|
(let ((current (gethash loc spc)))
|
|
(if current
|
|
(error "location already occupied! space: ~s, loc: ~s, current: ~s, new: ~s"
|
|
spc loc current obj)
|
|
(setf (gethash loc spc) obj))))
|
|
|
|
(defun del (spc loc)
|
|
(remhash loc spc))
|
|
|
|
(defun fetch (spc loc)
|
|
(gethash loc spc))
|
|
|
|
(defun query (spc pattern)
|
|
nil)
|
|
|
|
(defun neighbors (spc loc &key (dist 2))
|
|
(let* ((from (floor (sqrt dist)))
|
|
(to (- from)))
|
|
)
|
|
)
|
|
|
|
(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))
|
|
(labels (
|
|
(inc (cur idx)
|
|
(when (< idx dims)
|
|
(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)))
|
|
(lambda ()
|
|
(when cur
|
|
(prog1 (make-array dims :initial-contents cur)
|
|
(setf cur (inc cur 0))))))))
|
|
|