First commit.

LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) Michael Fiano
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

README.md

@@ -0,0 +1,15 @@
+# grid-formation
+
+Simple cellular grid formations and algorithms.
+
+## Install
+
+```lisp
+(ql:quickload :grid-formation)
+```
+
+## License
+
+Copyright © 2020-2022 Michael Fiano <mail@mfiano.net>.
+
+Licensed under the MIT License.

grid-formation.asd

@@ -0,0 +1,20 @@
+(asdf:defsystem #:grid-formation
+  :description "Simple cellular grid formations and algorithms."
+  :author "Michael Fiano <mail@mfiano.net>"
+  :license "MIT"
+  :homepage "https://github.com/mfiano/grid-formation"
+  :version "0.1.0"
+  :encoding :utf-8
+  :depends-on (#:mfiano-utils
+               #:origin)
+  :pathname "src"
+  :serial t
+  :components
+  ((:file "package")
+   (:file "grid")
+   (:file "quad")
+   (:file "quad-4-way")
+   (:file "quad-8-way")
+   (:file "hex")
+   (:file "hex-rows")
+   (:file "hex-columns")))

src/grid.lisp

@@ -0,0 +1,82 @@
+(in-package #:grid-formation)
+
+(defclass grid ()
+  ((%size :reader size
+          :initarg :size)
+   (%cell-size :reader cell-size
+               :initarg :cell-size
+               :initform nil)
+   (%cell-origin :reader cell-origin
+                 :initarg :cell-origin
+                 :initform nil)
+   (%edge-directions :reader edge-directions)
+   (%corner-directions :reader corner-directions)))
+
+(defmethod initialize-instance :after ((instance grid) &key size)
+  (unless size
+    (error "Grid must have a size."))
+  (with-slots (%cell-size %cell-origin) instance
+    (setf %cell-size (or %cell-size (v2:ones))
+          %cell-origin (or %cell-origin (v2:zero)))))
+
+(defun make-grid (type &rest args)
+  (apply #'make-instance type args))
+
+(defun cell-p (grid cell)
+  (v2:with-components ((g (size grid))
+                       (c cell))
+    (and (>= cx 0)
+         (< cx gx)
+         (>= cy 0)
+         (< cy gy))))
+
+(defun check-cell (grid cell)
+  (unless (cell-p grid cell)
+    (error "Cell ~s is not a member of the grid." cell)))
+
+(defgeneric nudge (grid cell))
+
+(defgeneric neighbor-directions (grid))
+
+(defgeneric neighbor-offsets (grid))
+
+(defgeneric neighbor-by-index (grid cell index)
+  (:method :before (grid cell index)
+    (check-cell grid cell)))
+
+(defgeneric distance (grid cell1 cell2)
+  (:method :before (grid cell1 cell2)
+    (check-cell grid cell1)
+    (check-cell grid cell2)))
+
+(defgeneric to-point (grid cell)
+  (:method :before (grid cell)
+    (check-cell grid cell)))
+
+(defgeneric from-point (grid point))
+
+(defgeneric select-line (grid cell1 cell2)
+  (:method :before (grid cell1 cell2)
+    (check-cell grid cell1)
+    (check-cell grid cell2)))
+
+(defgeneric select-range (grid cell range)
+  (:method :before (grid cell range)
+    (check-cell grid cell)))
+
+(defun neighbors (grid cell)
+  (loop :for direction :in (neighbor-directions grid)
+        :for i :from 0
+        :for neighbor = (neighbor-by-index grid cell i)
+        :when (cell-p grid neighbor)
+          :collect direction
+          :and
+            :collect neighbor))
+
+(defun neighbors-p (grid cell1 cell2)
+  (let ((neighbors (u:plist-values (neighbors grid cell1))))
+    (when (find cell2 neighbors :test #'equalp)
+      t)))
+
+(defun neighbor (grid cell direction)
+  (getf (neighbors grid cell) direction))

src/hex-columns.lisp

@@ -0,0 +1,23 @@
+(in-package #:grid-formation)
+
+(defclass hex-grid/columns (hex-grid) ())
+
+(defmethod initialize-instance :after ((instance hex-grid/columns) &key)
+  (with-slots (%forward %inverse %edge-directions %corner-directions) instance
+    (setf %forward (v4:vec #.(/ 3f0 2f0) 0f0 #.(/ (sqrt 3f0) 2f0) #.(sqrt 3f0))
+          %inverse (v4:vec #.(/ 2f0 3f0) 0f0 #.(/ -1f0 3f0) #.(/ (sqrt 3f0) 3f0))
+          %edge-directions '(:ne :n :nw :sw :s :se)
+          %corner-directions '(:e :ne :nw :w :sw :se))))
+
+(defmethod neighbor-directions ((grid hex-grid/columns))
+  '(:se :ne :n :nw :sw :s))
+
+(defmethod to-cell ((grid hex-grid/columns) hex)
+  (v3:with-components ((h hex))
+    (let ((y (+ hy (/ (+ hx (* (hex-offset grid) (mod hx 2))) 2))))
+      (v2:vec hx y))))
+
+(defmethod from-cell ((grid hex-grid/columns) cell)
+  (v2:with-components ((c cell))
+    (let ((y (- cy (/ (+ cx (* (hex-offset grid) (mod cx 2))) 2))))
+      (make-hex cx y))))

src/hex-rows.lisp

@@ -0,0 +1,23 @@
+(in-package #:grid-formation)
+
+(defclass hex-grid/rows (hex-grid) ())
+
+(defmethod initialize-instance :after ((instance hex-grid/rows) &key)
+  (with-slots (%forward %inverse %edge-directions %corner-directions) instance
+    (setf %forward (v4:vec #.(sqrt 3f0) #.(/ (sqrt 3f0) 2f0) 0f0 #.(/ 3f0 2f0))
+          %inverse (v4:vec #.(/ (sqrt 3f0) 3f0) #.(/ -1f0 3f0) 0f0 #.(/ 2f0 3f0))
+          %edge-directions '(:ne :nw :w :sw :se :e)
+          %corner-directions '(:ne :n :nw :sw :s :se))))
+
+(defmethod neighbor-directions ((grid hex-grid/rows))
+  '(:e :ne :nw :w :sw :se))
+
+(defmethod to-cell ((grid hex-grid/rows) hex)
+  (v3:with-components ((h hex))
+    (let ((x (+ hx (/ (+ hy (* (hex-offset grid) (mod hy 2))) 2))))
+      (v2:vec x hy))))
+
+(defmethod from-cell ((grid hex-grid/rows) cell)
+  (v2:with-components ((c cell))
+    (let ((x (- cx (/ (+ cy (* (hex-offset grid) (mod cy 2))) 2))))
+      (make-hex x cy))))

src/hex.lisp

@@ -0,0 +1,92 @@
+(in-package #:grid-formation)
+
+(defclass hex-grid (grid)
+  ((%forward :reader forward)
+   (%inverse :reader inverse)
+   (%offset :reader offset
+            :initarg :offset
+            :initform :even)))
+
+(defgeneric to-cell (grid hex))
+
+(defgeneric from-cell (grid cell))
+
+(defun hex-offset (grid)
+  (ecase (offset grid)
+    (:even 1)
+    (:odd -1)))
+
+(defun make-hex (x y)
+  (v3:vec x y (- (- x) y)))
+
+(defmethod nudge ((grid hex-grid) hex)
+  (v3:+ hex (make-hex 1f-7 1f-7)))
+
+(defun hex-round (hex)
+  (v3:with-components ((r (v3:round hex))
+                       (d (v3:abs (v3:- r hex))))
+    (cond
+      ((and (> dx dy) (> dx dz))
+       (setf rx (- (- ry) rz)))
+      ((> dy dz)
+       (setf ry (- (- rx) rz))))
+    r))
+
+(defmethod neighbor-offsets ((grid hex-grid))
+  (vector (make-hex 1f0 0f0)
+          (make-hex 1f0 -1f0)
+          (make-hex 0f0 -1f0)
+          (make-hex -1f0 0f0)
+          (make-hex -1f0 1f0)
+          (make-hex 0f0 1f0)))
+
+(defmethod neighbor-by-index ((grid hex-grid) cell index)
+  (let ((hex (v3:+ (from-cell grid cell)
+                   (aref (neighbor-offsets grid) index))))
+    (to-cell grid hex)))
+
+(defmethod distance ((grid hex-grid) cell1 cell2)
+  (v3:with-components ((c (v3:abs (from-cell grid (v2:- cell1 cell2)))))
+    (floor (max cx cy cz))))
+
+(defmethod to-point ((grid hex-grid) cell)
+  (with-slots (%cell-size %cell-origin %forward) grid
+    (v3:with-components ((c (from-cell grid cell))
+                         (s %cell-size))
+      (v4:with-components ((f %forward))
+        (let* ((x (+ (* fw cx) (* fx cy)))
+               (y (+ (* fy cx) (* fz cy)))
+               (px (* x sx))
+               (py (* y sy)))
+          (v2:round (v2:+ (v2:vec px py) %cell-origin)))))))
+
+(defmethod from-point ((grid hex-grid) point)
+  (with-slots (%cell-size %cell-origin %inverse) grid
+    (v2:with-components ((p (v2:/ (v2:- point %cell-origin) %cell-size)))
+      (v4:with-components ((i %inverse))
+        (let* ((x (+ (* iw px) (* ix py)))
+               (y (+ (* iy px) (* iz py))))
+          (to-cell grid (hex-round (make-hex x y))))))))
+
+(defmethod select-line ((grid hex-grid) cell1 cell2)
+  (loop :with distance = (distance grid cell1 cell2)
+        :with step = (/ (max distance 1))
+        :with start = (nudge grid (from-cell grid cell1))
+        :with end = (nudge grid (from-cell grid cell2))
+        :for hex :to distance
+        :for selected = (v3:lerp start end (float (* hex step) 1f0))
+        :for cell = (to-cell grid (hex-round selected))
+        :when (cell-p grid cell)
+          :collect cell))
+
+(defmethod select-range ((grid hex-grid) cell range)
+  (loop :with cells
+        :for x :from (- range) :to range
+        :for min = (max (- range) (- (- x) range))
+        :for max = (min range (+ (- x) range))
+        :do (loop :for y :from min :to max
+                  :for hex = (v3:+ (from-cell grid cell) (v3:vec (float x 1f0) (float y 1f0) 0f0))
+                  :for selected = (to-cell grid hex)
+                  :when (cell-p grid selected)
+                    :do (push selected cells))
+        :finally (return (nreverse cells))))

src/package.lisp

@@ -0,0 +1,11 @@
+(in-package #:cl-user)
+
+(defpackage #:grid-formation
+  (:local-nicknames
+   (#:v2 #:origin.vec2)
+   (#:v3 #:origin.vec3)
+   (#:v4 #:origin.vec4)
+   (#:u #:mfiano-utils))
+  (:use #:cl)
+  ;; TODO: Finalize API/export symbols
+  (:export))

src/quad-4-way.lisp

@@ -0,0 +1,16 @@
+(in-package #:grid-formation)
+
+(defclass quad-grid/4-way (quad-grid) ())
+
+(defmethod neighbor-directions ((grid quad-grid/4-way))
+  (edge-directions grid))
+
+(defmethod neighbor-offsets ((grid quad-grid/4-way))
+  (vector (v2:vec 1f0 0f0)
+          (v2:vec 0f0 -1f0)
+          (v2:vec -1f0 0f0)
+          (v2:vec 0f0 1f0)))
+
+(defmethod distance ((grid quad-grid/4-way) cell1 cell2)
+  (v2:with-components ((c (v2:abs (v2:- cell1 cell2))))
+    (floor (+ cx cy))))

src/quad-8-way.lisp

@@ -0,0 +1,21 @@
+(in-package #:grid-formation)
+
+(defclass quad-grid/8-way (quad-grid) ())
+
+(defmethod neighbor-directions ((grid quad-grid/8-way))
+  (u:interleave (edge-directions grid)
+                (corner-directions grid)))
+
+(defmethod neighbor-offsets ((grid quad-grid/8-way))
+  (vector (v2:vec 1f0 0f0)
+          (v2:vec 1f0 -1f0)
+          (v2:vec 0f0 -1f0)
+          (v2:vec -1f0 -1f0)
+          (v2:vec -1f0 0f0)
+          (v2:vec -1f0 1f0)
+          (v2:vec 0f0 1f0)
+          (v2:vec 1f0 1f0)))
+
+(defmethod distance ((grid quad-grid/8-way) cell1 cell2)
+  (v2:with-components ((c (v2:abs (v2:- cell1 cell2))))
+    (floor (max cx cy))))

src/quad.lisp

@@ -0,0 +1,49 @@
+(in-package #:grid-formation)
+
+(defclass quad-grid (grid) ())
+
+(defmethod initialize-instance :after ((instance quad-grid) &key)
+  (with-slots (%edge-directions %corner-directions) instance
+    (setf %edge-directions '(:e :n :w :s)
+          %corner-directions '(:ne :nw :sw :se))))
+
+(defmethod nudge ((grid quad-grid) cell)
+  (v2:+ cell (v2:uniform 1f-7)))
+
+(defmethod neighbor-by-index ((grid quad-grid) cell index)
+  (v2:+ cell (aref (neighbor-offsets grid) index)))
+
+(defmethod to-point ((grid quad-grid) cell)
+  (with-slots (%cell-size %cell-origin) grid
+    (v2:with-components ((c cell)
+                         (s %cell-size))
+      (let ((px (* cx sx))
+            (py (* cy sy)))
+        (v2:round (v2:+ (v2:vec px py) %cell-origin))))))
+
+(defmethod from-point ((grid quad-grid) point)
+  (with-slots (%cell-size %cell-origin) grid
+    (v2:with-components ((p (v2:- point %cell-origin))
+                         (s %cell-size))
+      (let ((px (/ px sx))
+            (py (/ py sy)))
+        (v2:round (v2:vec px py))))))
+
+(defmethod select-line ((grid quad-grid) cell1 cell2)
+  (loop :with distance = (distance grid cell1 cell2)
+        :with step = (/ (max distance 1))
+        :with start = (nudge grid cell1)
+        :with end = (nudge grid cell2)
+        :for cell :to distance
+        :for selected = (v2:round (v2:lerp start end (float (* cell step) 1f0)))
+        :when (cell-p grid selected)
+          :collect selected))
+
+(defmethod select-range ((grid quad-grid) cell range)
+  (loop :with cells
+        :for x :from (- range) :to range
+        :do (loop :for y :from (- range) :to range
+                  :for selected = (v2:+ cell (v2:vec x y))
+                  :when (cell-p grid selected)
+                    :do (push selected cells))
+        :finally (return (nreverse cells))))