Browse Source

First commit.

main
Michael Fiano 2 months ago
commit
5718ccd78e
Signed by: mfiano
GPG Key ID: F87DF4666D70FC63
  1. 21
      LICENSE
  2. 15
      README.md
  3. 20
      grid-formation.asd
  4. 82
      src/grid.lisp
  5. 23
      src/hex-columns.lisp
  6. 23
      src/hex-rows.lisp
  7. 92
      src/hex.lisp
  8. 11
      src/package.lisp
  9. 16
      src/quad-4-way.lisp
  10. 21
      src/quad-8-way.lisp
  11. 49
      src/quad.lisp

21
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.

15
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.

20
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")))

82
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))

23
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))))

23
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))))

92
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))))

11
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))

16
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))))

21
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))))

49
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))))
Loading…
Cancel
Save