simon/walkmap
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

Whoops! Failed to add new file versions in last commit!

Browse source
This commit is contained in:
Simon Brooke 2020-11-15 21:12:34 +00:00
parent cf0b70e816
commit a0cf33ac57
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
25 changed files with 2684 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
.calva/output-window/.clj-kondo/config.edn Normal file
View file

@ -0,0 +1 @@
^:replace {:linters {}}

2
.gitignore vendored
View file

@ -26,3 +26,5 @@ settlement_1.edn
small_hill.edn
small_hill.html
.calva/output-window/output.calva-repl

186
src/cc/journeyman/walkmap/edge.clj Normal file
View file

@ -0,0 +1,186 @@
(ns cc.journeyman.walkmap.edge
"Essentially the specification for things we shall consider to be an edge.
An edge is a line segment having just a start and an end, with no intervening
nodes."
(:require [clojure.math.numeric-tower :as m]
[cc.journeyman.walkmap.utils :as u]
[cc.journeyman.walkmap.vertex :refer [canonicalise check-vertex ensure2d ensure3d vertex vertex= vertex?]]))
(defn edge
"Return an edge between vertices `v1` and `v2`."
[v1 v2]
{:kind :edge
:walkmap.id/id (keyword (gensym "edge"))
:start (check-vertex v1)
:end (check-vertex v2)})
(defn edge?
"True if `o` satisfies the conditions for a edge. An edge shall be a map
having the keys `:start` and `:end`, such that the values of each of those
keys shall be a vertex."
[o]
(and
(map? o)
(vertex? (:start o))
(vertex? (:end o))))
(defn length
"Return the length of the edge `e`."
[e]
(let [start (ensure3d (:start e))
end (ensure3d (:end e))]
(m/sqrt
(reduce
+
(map
#(m/expt (- (% end) (% start)) 2)
[:x :y :z])))))
(defn centre
"Return the vertex that represents the centre of this `edge`."
[edge]
(let [s (ensure3d (:start edge))
e (ensure3d (:end edge))]
(vertex
(+ (:x s) (/ (- (:x e) (:x s)) 2))
(+ (:y s) (/ (- (:y e) (:y s)) 2))
(+ (:z s) (/ (- (:z e) (:z s)) 2)))))
(defn unit-vector
"Return an vertex parallel to `e` starting from the coordinate origin. Two
edges which are parallel will have the same unit vector."
[e]
(let [e' {:start (ensure3d (:start e)) :end (ensure3d (:end e))}
l (length e')]
(canonicalise
(reduce
merge
{}
(map
(fn [k]
{k (/ (- (k (:end e')) (k (:start e'))) l)})
[:x :y :z])))))
(defn parallel?
"True if all `edges` passed are parallel with one another."
[& edges]
(let [uvs (map unit-vector edges)]
(every?
#(vertex= % (first uvs))
(rest uvs))))
(defn collinear?
"True if edges `e1` and `e2` are collinear with one another."
[e1 e2]
(parallel?
e1
e2
(if (vertex= (:start e1) (:start e2))
{:start (:start e1) :end (:end e2)}
{:start (:start e1) :end (:start e2)})))
(defn collinear2d?
"True if the projections of edges `e1`, `e2` onto the x, y plane are
collinear."
[e1 e2]
(collinear? {:start (ensure2d (:start e1)) :end (ensure2d (:end e1))}
{:start (ensure2d (:start e2)) :end (ensure2d (:end e2))}))
(defn minimaxd
"Apply function `f` to `coord` of the vertices at start and end of `edge`
and return the result. Intended use case is `f` = `min` or `max`, `coord`
is `:x`, `:y` or `:z`. No checks are made for sane arguments."
[edge coord f]
(apply f (list (coord (:start edge)) (coord (:end edge)))))
(defn on?
"True if the vertex `v` is on the edge `e`."
[e v]
(let [p (ensure3d (:start e))
q (ensure3d v)
r (ensure3d (:end e))]
(and
(collinear? (edge p q) (edge q r))
(<= (:x q) (max (:x p) (:x r)))
(>= (:x q) (min (:x p) (:x r)))
(<= (:y q) (max (:y p) (:y r)))
(>= (:y q) (min (:y p) (:y r)))
(<= (:z q) (max (:z p) (:z r)))
(>= (:z q) (min (:z p) (:z r))))))
(defn on2d?
"True if vertex `v` is on edge `e` when projected onto the x, y plane."
[e v]
(on? (edge (ensure2d (:start e)) (ensure2d (:end e))) v))
(defn overlaps2d?
"True if the recangle in the x,y plane bisected by edge `e1` overlaps that
bisected by edge `e2`. It is an error if either `e1` or `e2` is not an edge.
If `c1` is passed it should be the first coordinate of the plane of
projection on which the overlap is sought (default: `:x`); similarly `c2`
should be the second such coordinate (default: `:y`)."
([e1 e2]
(overlaps2d? e1 e2 :x :y))
([e1 e2 c1 c2]
(when (and (edge? e1) (edge? e2))
(and
(> (minimaxd e1 c1 max) (minimaxd e2 c1 min))
(< (minimaxd e1 c1 min) (minimaxd e2 c1 max))
(> (minimaxd e1 c2 max) (minimaxd e2 c2 min))
(< (minimaxd e1 c2 min) (minimaxd e2 c2 max))))))
(defn intersection2d
"The probability of two lines intersecting in 3d space is low, and actually
that is mostly not something we're interested in. We're interested in
intersection in the `x,y` plane. This function returns a vertex representing
a point vertically over the intersection of edges `e1`, `e2` in the `x,y`
plane, whose `z` coordinate is
* 0 if both edges are 2d (i.e. have missing or zero `z` coordinates);
* if one edge is 2d, then the point on the other edge over the intersection;
* otherwise, the average of the z coordinates of the points on the two
edges over the intersection.
If no such intersection exists, `nil` is returned.
It is an error, and an exception will be thrown, if either `e1` or `e2` is
not an edge."
([e1 e2]
(intersection2d e1 e2 :x :y :z))
([e1 e2 c1 c2 c3]
(if (and (edge? e1) (edge? e2))
(when
(overlaps2d? e1 e2) ;; relatively cheap check
(if
(collinear2d? e1 e2)
;; any point within the overlap will do, but we'll pick the end of e1
;; which is on e2
(if (on2d? e2 (:start e1)) (:start e1) (:end e1))
;; blatantly stolen from
;; https://gist.github.com/cassiel/3e725b49670356a9b936
(let [x1 (c1 (:start e1))
x2 (c1 (:end e1))
x3 (c1 (:start e2))
x4 (c1 (:end e2))
y1 (c2 (:start e1))
y2 (c2 (:end e1))
y3 (c2 (:start e2))
y4 (c2 (:end e2))
denom (- (* (- x1 x2) (- y3 y4))
(* (- y1 y2) (- x3 x4)))
x1y2-y1x2 (- (* x1 y2) (* y1 x2))
x3y4-y3x4 (- (* x3 y4) (* y3 x4))
px-num (- (* x1y2-y1x2 (- x3 x4))
(* (- x1 x2) x3y4-y3x4))
py-num (- (* x1y2-y1x2 (- y3 y4))
(* (- y1 y2) x3y4-y3x4))
result (when-not (zero? denom)
(vertex (/ px-num denom) (/ py-num denom)))]
(when (and result (on2d? e1 result) (on2d? e2 result)) result))))
(throw (IllegalArgumentException.
(str
"Both `e1` and `e2` must be edges."
(map #(or (:kind %) (type %)) [e1 e2])))))))

8
src/cc/journeyman/walkmap/id.clj Normal file
View file

@ -0,0 +1,8 @@
(ns cc.journeyman.walkmap.id
"The namespace within which the privileged keyword `:walkmap.id/id` is defined.")
(def ^:const id
"The magic id key walkmap uses, to distinguish it from all other uses of
the unprotected keyword."
::id)

75
src/cc/journeyman/walkmap/microworld.clj Normal file
View file

@ -0,0 +1,75 @@
(ns cc.journeyman.walkmap.microworld
"An interface between walkmap and microworld, to allow use of microworld
functionality to model things like rainfall, soil fertility, settlement
and so on."
(:require [clojure.edn :as edn :only [read]]
[clojure.java.io :as io]
[clojure.string :as s]
[taoensso.timbre :as l]
[cc.journeyman.walkmap.edge :as e]
[cc.journeyman.walkmap.polygon :as p :only [rectangle]]
[cc.journeyman.walkmap.superstructure :refer [store]]
[cc.journeyman.walkmap.tag :as t :only [tag]]
[cc.journeyman.walkmap.vertex :as v :only [check-vertex vertex vertex?]]
[cc.journeyman.walkmap.utils :as u :only [truncate]]))
(defn cell->polygon
"From this MicroWorld `cell`, construct a walkmap polygon (specifically,
a rectangle. If `scale-vector` passed and is a vertex, scale all the vertices
in the cell by that vector."
([cell]
(cell->polygon cell (v/vertex 1 1 1)))
([cell scale-vector]
(t/tag
(assoc
(merge
cell
(let [w (* (:x cell) (:x (v/check-vertex scale-vector)))
s (* (:y cell) (:y scale-vector))
e (+ w (:x scale-vector))
n (+ s (:y scale-vector))
z (* (:altitude cell) (:z scale-vector))]
(p/rectangle
(v/vertex s w z)
(v/vertex n e z))))
:walkmap.id/id
(keyword (gensym "mw-cell")))
(:state cell))))
(defn load-microworld-edn
"While it would be possible to call MicroWorld functions directly from
Walkmap, the fact is that running MicroWorld is so phenomenally
compute-heavy that it's much more sensible to do it in batch mode. So the
better plan is to be able to pull the output from MicroWorld - as an EDN
structure - into a walkmap superstructure."
([filename]
(load-microworld-edn filename :mw))
([filename map-kind]
(when-not
(keyword? map-kind)
(throw (IllegalArgumentException.
(u/truncate
(str "Must be a keyword: " (or map-kind "nil")) 80))))
(load-microworld-edn filename map-kind nil))
([filename mapkind superstucture]
(load-microworld-edn filename mapkind superstucture (v/vertex 1 1 1)))
([filename map-kind superstructure scale-vertex]
(let [mw (try
(with-open [r (io/reader filename)]
(edn/read (java.io.PushbackReader. r)))
(catch RuntimeException e
(l/error "Error parsing edn file '%s': %s\n"
filename (.getMessage e))))
polys (reduce
concat
(map (fn [row] (map cell->polygon row)) mw))]
(if (map? superstructure)
(reduce
#(store %2 %1)
superstructure
polys)
polys))))

25
src/cc/journeyman/walkmap/ocean.clj Normal file
View file

@ -0,0 +1,25 @@
(ns cc.journeyman.walkmap.ocean
"Deal with (specifically, at this stage, cull) ocean areas"
(:require [cc.journeyman.walkmap.utils :refer [=ish]]))
(def ^:dynamic *sea-level*
"The sea level on heightmaps we're currently handling. If characters are to
be able to swin in the sea, we must model the sea bottom, so we need
heightmaps which cover at least the continental shelf. However, the sea
bottom is not walkable territory and can be culled from walkmaps.
**Note** must be a floating point number. `(= 0 0.0)` returns `false`!"
0.0)
(defn ocean?
"Of a `facet`, is the altitude of every vertice equal to `*sea-level*`?"
[facet]
(every?
#(=ish % *sea-level*)
(map :z (:vertices facet))))
(defn cull-ocean-facets
"Ye cannae walk on water. Remove all facets from this `stl` structure which
are at sea level."
[stl]
(assoc stl :facets (remove ocean? (:facets stl))))

93
src/cc/journeyman/walkmap/path.clj Normal file
View file

@ -0,0 +1,93 @@
(ns cc.journeyman.walkmap.path
"Essentially the specification for things we shall consider to be path.
**Note that** for these purposes `path` means any continuous linear
feature, where such features specifically include watercourses."
(:require [clojure.string :as s]
[cc.journeyman.walkmap.edge :as e]
[cc.journeyman.walkmap.polygon :refer [check-polygon polygon?]]
[cc.journeyman.walkmap.tag :refer [tag tags]]
[cc.journeyman.walkmap.utils :refer [check-kind-type check-kind-type-seq kind-type]]
[cc.journeyman.walkmap.vertex :refer [check-vertices vertex?]]))
(defn path?
"True if `o` satisfies the conditions for a path. A path shall be a map
having the key `:vertices`, whose value shall be a sequence of vertices as
defined in `walkmap.vertex`."
[o]
(let
[v (:vertices o)]
(and
(seq? v)
(> (count v) 1)
(every? vertex? v)
(:walkmap.id/id o)
(or (nil? (:kind o)) (= (:kind o) :path)))))
(defn path
"Return a path constructed from these `vertices`."
[& vertices]
(if
(> (count (check-vertices vertices)) 1)
{:vertices vertices :walkmap.id/id (keyword (gensym "path")) :kind :path}
(throw (IllegalArgumentException. "Path must have more than one vertex."))))
(defmacro check-path
"If `o` is not a path, throw an `IllegalArgumentException` with an
appropriate message; otherwise, returns `o`. Macro, so exception is thrown
from the calling function."
[o]
`(check-kind-type ~o path? :path))
(defmacro check-paths
"If `o` is not a sequence of paths, throw an `IllegalArgumentException` with an
appropriate message; otherwise, returns `o`. Macro, so exception is thrown
from the calling function."
[o]
`(check-kind-type-seq ~o path? :path))
(defn polygon->path
"If `o` is a polygon, return an equivalent path. What's different about
a path is that in polygons there is an implicit edge between the first
vertex and the last. In paths, there isn't, so we need to add that
edge explicitly.
If `o` is not a polygon, will throw an exception."
[o]
;; this is breaking, but I have NO IDEA why!
;; (check-polygon o polygon? :polygon)
(assoc (dissoc o :vertices)
:kind :path
;; `concat` rather than `conj` because order matters.
:vertices (concat (:vertices o) (list (first (:vertices o))))))
(defn path->edges
"if `o` is a path, a polygon, or a sequence of vertices, return a sequence of
edges representing that path, polygon or sequence.
Throws `IllegalArgumentException` if `o` is not a path, a polygon, or
sequence of vertices."
[o]
(cond
(seq? o) (when
(and
(vertex? (first o))
(vertex? (first (rest o))))
(cons
;; TODO: think about: when constructing an edge from a path, should the
;; constructed edge be tagged with the tags of the path?
(e/edge (first o) (first (rest o)))
(path->edges (rest o))))
(path? o) (path->edges (:vertices o))
(polygon? o) (path->edges (polygon->path o))
:else
(throw (IllegalArgumentException.
"Not a path or sequence of vertices!"))))
(defn length
"Return the length of this path, in metres. **Note that**
1. This is not the same as the distance from the start to the end of the
path, which, except for absolutely straight paths, will be shorter;
2. It is not even quite the same as the length of the path *as rendered*,
since paths will generally be rendered as spline curves."
[path]
(reduce + (map e/length (path->edges (check-path path)))))

155
src/cc/journeyman/walkmap/polygon.clj Normal file
View file

@ -0,0 +1,155 @@
(ns cc.journeyman.walkmap.polygon
"Essentially the specification for things we shall consider to be polygons."
(:require [clojure.string :as s]
[cc.journeyman.walkmap.edge :as e]
[cc.journeyman.walkmap.tag :as t]
[cc.journeyman.walkmap.utils :refer [check-kind-type
check-kind-type-seq
kind-type
not-yet-implemented]]
[cc.journeyman.walkmap.vertex :refer [check-vertex check-vertices vertex vertex?]]))
(defn polygon?
"True if `o` satisfies the conditions for a polygon. A polygon shall be a
map which has a value for the key `:vertices`, where that value is a sequence
of vertices."
[o]
(let
[v (:vertices o)]
(and
(coll? v)
(> (count v) 2)
(every? vertex? v)
(:walkmap.id/id o)
(or (nil? (:kind o)) (= (:kind o) :polygon)))))
(defmacro check-polygon
"If `o` is not a polygon, throw an `IllegalArgumentException` with an
appropriate message; otherwise, returns `o`. Macro, so exception is thrown
from the calling function."
[o]
`(check-kind-type ~o polygon? :polygon))
(defmacro check-polygons
"If `o` is not a sequence of polygons, throw an `IllegalArgumentException` with an
appropriate message; otherwise, returns `o`. Macro, so exception is thrown
from the calling function."
[o]
`(check-kind-type-seq ~o polygon? :polygon))
(defn triangle?
"True if `o` satisfies the conditions for a triangle. A triangle shall be a
polygon with exactly three vertices."
[o]
(and
(coll? o)
(= (count (:vertices o)) 3)))
(defmacro check-triangle
"If `o` is not a triangle, throw an `IllegalArgumentException` with an
appropriate message; otherwise, returns `o`. Macro, so exception is thrown
from the calling function."
[o]
`(check-kind-type ~o triangle? :triangle))
(defn polygon
"Return a polygon constructed from these `vertices`."
[& vertices]
(if
(> (count vertices) 2)
{:vertices (check-vertices vertices)
:walkmap.id/id (keyword (gensym "poly"))
:kind :polygon}
(throw (IllegalArgumentException.
"A polygon must have at least 3 vertices."))))
(defn rectangle
"Return a rectangle, with edges aligned east-west and north-south, whose
south-west corner is the vertex `vsw` and whose north-east corner is the
vertex `vne`."
[vsw vne]
;; we can actually create any rectangle in the xy plane based on two opposite
;; corners, but the maths are a bit to advanced for me today. TODO: do it!
(let [vnw (vertex (:x (check-vertex vsw))
(:y (check-vertex vne))
(/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2))
vse (vertex (:x vne)
(:y vsw)
(/ (reduce + (map #(or (:z %) 0) [vsw vne])) 2))
height-order (sort-by :z [vsw vne])]
(t/tag
(assoc
(polygon vsw vnw vne vse)
:gradient
(e/unit-vector (e/edge (first height-order) (last height-order)))
:centre
(vertex (+ (:x vsw) (/ (- (:x vne) (:x vsw)) 2))
(+ (:x vsw) (/ (- (:y vne) (:y vsw)) 2))
(:z vse)))
:rectangle)))
;; (rectangle (vertex 1 2 3) (vertex 7 9 4))
(defn gradient
"Return a polygon like `triangle` but with a key `:gradient` whose value is a
unit vector representing the gradient across `triangle`."
[triangle]
(let [order (sort #(max (:z %1) (:z %2))
(:vertices (check-triangle triangle)))
highest (first order)
lowest (last order)]
(assoc triangle :gradient (e/unit-vector (e/edge lowest highest)))))
(defn triangle-centre
"Return a canonicalised `facet` (i.e. a triangular polygon) with an added
key `:centre` whose value represents the centre of this facet in 3
dimensions. This only works for triangles, so is here not in
`walkmap.polygon`. It is an error (although no exception is currently
thrown) if the object past is not a triangular polygon."
[facet]
(let [vs (:vertices (check-triangle facet))
v1 (first vs)
opposite (e/edge (nth vs 1) (nth vs 2))
oc (e/centre opposite)]
(assoc
facet
:centre
(vertex
(+ (:x v1) (* (- (:x oc) (:x v1)) 2/3))
(+ (:y v1) (* (- (:y oc) (:y v1)) 2/3))
(+ (:z v1) (* (- (:z oc) (:z v1)) 2/3))))))
(defn centre
[poly]
(case (count (:vertices (check-polygon poly)))
3 (triangle-centre poly)
;; else
(throw
(UnsupportedOperationException.
"The general case of centre for polygons is not yet implemented."))))
(defmacro on2dtriangle?
"Is the projection of this `vertex` on the x, y plane within the
projection of this triangle on that plane?"
[vertex poly]
`(not-yet-implemented "on2d? for triangles."))
(defn on2drectangle?
"Is the projection of this `vertex` on the x, y plane within the
projection of this rectangle on that plane?"
[vertex rectangle]
(let [xo (sort-by :x (:vertices rectangle))
yo (sort-by :x (:vertices rectangle))]
(and
(< (:x (first xo)) (:x vertex) (:x (last xo)))
(< (:y (first yo)) (:y vertex) (:y (last yo))))))
(defmacro on2d?
"Is the projection of this `vertex` on the x, y plane within the
projection of this polygon `poly` on that plane?"
[vertex poly]
`(cond
(rectangle? ~poly) (on2drectangle? ~vertex ~poly)
(triangle? ~poly) (on2dtriangle? ~vertex ~poly)
:else
(not-yet-implemented "general case of on2d? for polygons.")))

100
src/cc/journeyman/walkmap/read_svg.clj Normal file
View file

@ -0,0 +1,100 @@
(ns cc.journeyman.walkmap.read-svg
"Utility functions for scalable vector graphics (SVG) into walkmap
structures."
(:require [clojure.data.zip :as dz]
[clojure.data.zip.xml :as zx]
[clojure.java.io :as io]
[clojure.string :as s]
[clojure.xml :as x]
[clojure.zip :as z]
[taoensso.timbre :as l]
[cc.journeyman.walkmap.path :refer [path]]
[cc.journeyman.walkmap.tag :refer [tag]]
[cc.journeyman.walkmap.utils :refer [kind-type truncate]]
[cc.journeyman.walkmap.vertex :refer [vertex vertex?]]))
(defn upper-case?
[s]
(every? #(Character/isUpperCase %) s))
(defn match->vertex
[match-vector x y]
(when-not (empty? match-vector)
(let [command (nth match-vector 1)
xcoord (read-string (nth match-vector 2))
ycoord (read-string (nth match-vector 3))
;; upper case command letters mean the coordinates that follow are
;; absolute; lower case, relative.
x' (if (upper-case? command) xcoord (+ x xcoord))
y' (if (upper-case? command) ycoord (+ y ycoord))]
(case (s/lower-case command)
("m" "l") {:vertex (vertex x' y') :x x' :y y'}
nil))))
(defn command-string->vertices
"Return the destination of each successive line (`l`, `L`) and move (`m`, `M`)
command in this string `s`, expected to be an SVG path command string."
[s]
(let [cmd-matcher ;; matches a 'command' in the string: a letter followed by
;;spaces and numbers
(re-matcher #"[a-zA-Z][^a-zA-Z]*" s)
seg-pattern ;; matches a command which initiates a move of the current
;; position.
#"([a-zA-Z]) +([-+]?[0-9]*\.?[0-9]+) +([-+]?[0-9]*\.?[0-9]+) +"]
(loop [match (re-find cmd-matcher)
result []
x 0
y 0]
(if-not match
(filter vertex? result)
(let [m (match->vertex (re-find seg-pattern match) x y)]
(recur (re-find cmd-matcher) ;loop with 2 new arguments
(conj result (:vertex m))
(or (:x m) x)
(or (:y m) y)))))))
(defn path-elt->path
"Given the SVG path element `elt`, return a walkmap path structure
representing the line (`l`, `L`) and move (`m`, `M`) commands in
that path."
[elt]
(if (= (:tag elt) :path)
(let [vs (command-string->vertices (-> elt :attrs :d))
p (when-not (empty? vs) (apply path vs))]
(if (and p (-> elt :attrs :class))
(tag p (map keyword (s/split (-> elt :attrs :class) #" ")))
p))
(throw (IllegalArgumentException.
(str "Must be an SVG `path` element: " elt)))))
(defn progeny
"Return all the nodes in the XML structure below this `elt` which match
this `predicate`."
;; the name `descendants` is bound in `clojure.core` for something quite
;; different, and I chose not to rebind it.
[elt predicate]
(if
(apply predicate (list elt))
(list elt)
(reduce
concat
(remove
empty?
(map
#(progeny % predicate)
(:content elt))))))
(defn read-svg
;; I tried to get this working with all the clever zip stuff in
;; `clojure.zip`, `clojure.data.zip`, and so on. It would probably have
;; been more elegant, but it kept crashing out of heap space on even
;; quite small XML files. So I've implemented my own solution.
([file-name]
(read-svg file-name nil))
([file-name map-kind]
(let [xml (x/parse (io/file file-name))
paths (progeny xml #(= (:tag %) :path))]
(remove nil? (map path-elt->path paths)))))
;; (read-svg "resources/iom/manual_roads.svg")

205
src/cc/journeyman/walkmap/routing.clj Normal file
View file

@ -0,0 +1,205 @@
(ns cc.journeyman.walkmap.routing
"Finding optimal routes to traverse a map."
(:require [clojure.math.numeric-tower :as m :only [expt]]
[clojure.set :refer [intersection]]
[clojure.string :as cs :only [join]]
[search.core :refer [a*]]
[cc.journeyman.walkmap.edge :as e]
[cc.journeyman.walkmap.path :as p]
[cc.journeyman.walkmap.polygon :as q]
[cc.journeyman.walkmap.superstructure :as s]
[cc.journeyman.walkmap.tag :as t]
[cc.journeyman.walkmap.utils :as u]
[cc.journeyman.walkmap.vertex :as v]))
;; Breadth first search is a good algorithm for terrain in which all steps have
;; equal, but in our world (like the real world), they don't.
;; Reading list:
;;
;; https://en.wikipedia.org/wiki/A*_search_algorithm
;; https://www.redblobgames.com/pathfinding/a-star/introduction.html
;; https://faculty.nps.edu/ncrowe/opmpaper2.htm
;;
;; See https://simon-brooke.github.io/the-great-game/codox/Pathmaking.html
(def ^:dynamic *gradient-exponent*
"The exponent to be applied to `(inc (:z (unit-vector from to)))`
of a path segment to calculate the gradient-related part of the
cost of traversal. Dynamic, because we will want to tune this."
2)
(def ^:dynamic *traversals-exponent*
"The (expected to be negative) exponent to be applied to the number
of traversals of a path to compute the road bonus. Paths more travelled by
should have larger bonuses, but not dramatically so - so the increase in
bonus needs to scale significantly less than linearly with the number
of traversals. Dynamic, because we will want to tune this."
-2)
(defn traversable?
"True if this `object` is a polygon which can be considered as part of
the walkmap."
[object]
(and
(q/polygon? object)
(:centre object)
(not (t/tagged? object :no-traversal))))
(declare traversal-cost)
(defn vertices-traversal-cost
[vertices s]
(reduce
+
(map
#(traversal-cost %1 %2 s)
(v/check-vertices vertices)
(rest vertices))))
(defn path-traversal-cost
[path s]
(vertices-traversal-cost (:vertices (p/check-path path)) s))
(defn barriers-crossed
"Search superstructure `s` and return a sequence of barriers, if any, which
obstruct traversal from vertex `from` to vertex `to`."
[from to s]
;; TODO: implement
'())
(defn crossing-penalty
"TODO: should return the cost of crossing this `barrier`, initially mainly
a watercourse, on the axis from vertex `from` to vertex `to`. in the context
of superstructure `s`. If there's a bridge, ferry or other crossing mechanism
in `s` at the intersection of the vertex and the barrier, then the penalty
should be substantially less than it would otherwise be."
[barrier from to s]
;; TODO: implement
0)
(defn gradient-cost
"Compute the per-unit-distance cost of traversing this `edge`."
[edge]
(let [g (:z (e/unit-vector edge))]
(if (pos? g)
(m/expt (inc g) *gradient-exponent*)
1)))
;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 0)))
;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 2 0)))
;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 1)))
;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 2 1)))
;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 0.0001)))
(defn best-road
"Find the best traversable path which links the vertices `from` and `to`
in this superstructure `s`, or nil if there are none."
[from to s]
(let [f (fn [v] (set (s/touching v p/path? s)))]
(first
(sort-by
;;; I... chose the path more travelled by.
#(or (:traversals %) 0)
(filter traversable? (intersection (f from) (f to)))))))
(defn road-bonus
"Calculate the road bonus of the edge represented by the vertices `from`,
`to`, in the context of the superstructure `s`. Obviously there only is
such a bonus if there actually is an existing thoroughfare to use. Road
bonuses scale with some fractional exponent of the number of traversals
which have been made of the road segment in question."
[from to s]
(let [best (best-road from to s)]
(when (:traversals best)
(m/expt (:traversals best) *traversals-exponent*))))
(defn traversal-cost
"Return the traversal cost of the edge represented by the vertices `from`,
`to`, in the context of the superstructure `s`. It is legitimate to pass
`nil` as the `to` argument, in which case the result will be zero, in order
to allow `reduce` to be used to compute total path costs."
[from to s]
(if (nil? to)
0
(let [edge (e/edge from to)
distance (e/length edge)]
(/
(+
(* distance
(gradient-cost edge))
(reduce +
(map
#(crossing-penalty [% from to s])
(barriers-crossed from to s))))
(or (road-bonus from to s) 1)))))
;; (def p '({:x 1.40625, :y 0, :kind :vertex, :walkmap.id/id :vert_1-40625_0}
;; {:x 1.40625, :y -10.703125, :kind :vertex, :walkmap.id/id :vert_1-40625_-10-703125}
;; {:x 7.578125, :y -10.703125, :kind :vertex, :walkmap.id/id :vert_7-578125_-10-703125}
;; {:x 7.578125, :y 0, :kind :vertex, :walkmap.id/id :vert_7-578125_0}
;; {:x 2.171875, :y -0.765625, :kind :vertex, :walkmap.id/id :vert_2-171875_-0-765625}
;; {:x 6.8125, :y -0.765625, :kind :vertex, :walkmap.id/id :vert_6-8125_-0-765625}))
;; (v/check-vertices p)
;; (def p' (p/path p))
;; (traversal-cost (first p) (nth p 1) {})
;; (vertices-traversal-cost p {})
;; (path-traversal-cost (p/path p))
(defn extend-frontier
"Return a sequence like `frontier` with all of these `candidates` which are
not already members either of `frontier` or of `rejects` appended. Assumes
candidates are traversable."
([frontier candidates]
(extend-frontier frontier candidates nil))
([frontier candidates rejects]
(if
(empty? frontier)
candidates
(let [fs (set (concat frontier rejects))]
(concat frontier (remove fs candidates))))))
;; (extend-frontier '(1 2 3 4 5) '(7 3 6 2 9 8) '(6 8))
;; (extend-frontier '(1 2 3 4 5) '(7 3 6 2 9 8))
;; (extend-frontier '(1 2 3 4 5) '())
;; (extend-frontier '(1 2 3 4 5) nil)
;; (extend-frontier nil '(1 2 3 4 5))
(def ^:dynamic *route-goal*
"The goal of the route currently sought."
nil)
(defn find-traversable-facet
"Return the nearest traversable walkmap facet within `search-radius` of
`target`, or throw an exception if none is found."
[target search-radius s]
(let [r (s/nearest s target traversable? search-radius)]
(when-not r (throw
(Exception.
(cs/join " " ["Unable to find walkable facet within"
search-radius
"of"
target]))))
r))
(defn route
;; architectural problem: needs to return not the route, but a modified
;; superstructure with the new route stored in it.
([from to s]
(route from to s traversal-cost 5))
([from to s cost-fn search-radius]
(let [from' (find-traversable-facet from search-radius s)
to' (find-traversable-facet to search-radius s)]
(a* from'
#(v/vertex= % (:centre to')) ;; goal?-fn - 'have we got there yet?'
#(cost-fn %1 %2 s) ;; distance-fn - what is the distance/cost
;; between these vertices?
#(e/length (e/edge (:centre %) to))
;; heuristic: how far to the end goal
#(s/neighbours % traversable? s)
;; neighbours-fn - return the traversable
;; neighbours of the current facet
(int (* search-radius (e/length (e/edge from to))))
;; how long a path we'll accept
))))

206
src/cc/journeyman/walkmap/stl.clj Normal file
View file

@ -0,0 +1,206 @@
(ns cc.journeyman.walkmap.stl
"Utility functions dealing with stereolithography (STL) files. Not a stable API yet!"
(:require [clojure.java.io :as io :refer [file output-stream input-stream]]
[clojure.string :as s]
[me.raynes.fs :as fs]
[org.clojars.smee.binary.core :as b]
[taoensso.timbre :as l]
[cc.journeyman.walkmap.edge :as e]
[cc.journeyman.walkmap.ocean :as o]
[cc.journeyman.walkmap.polygon :refer [centre gradient polygon?]]
[cc.journeyman.walkmap.superstructure :refer [store]]
[cc.journeyman.walkmap.tag :refer [tag]]
[cc.journeyman.walkmap.utils :as u]
[cc.journeyman.walkmap.vertex :as v])
(:import org.clojars.smee.binary.core.BinaryIO
java.io.DataInput))
(defn stl?
"True if `o` is recogniseable as an STL structure. An STL structure must
have a key `:facets`, whose value must be a sequence of polygons; and
may have a key `:header` whose value should be a string, and/or a key
`:count`, whose value should be a positive integer.
If `verify-count?` is passed and is not `false`, verify that the value of
the `:count` header is equal to the number of facets."
([o]
(stl? o false))
([o verify-count?]
(and
(map? o)
(:facets o)
(every? polygon? (:facets o))
(if (:header o) (string? (:header o)) true)
(if (:count o) (integer? (:count o)) true)
(or (nil? (:kind o)) (= (:kind o) :stl))
(if verify-count? (= (:count o) (count (:facets o))) true))))
(def vect
"A codec for vectors within a binary STL file."
(b/ordered-map
:x :float-le
:y :float-le
:z :float-le))
(def facet
"A codec for a facet (triangle) within a binary STL file."
(b/ordered-map
:normal vect
:vertices [vect vect vect]
:abc :ushort-le))
(def binary-stl
"A codec for binary STL files"
(b/ordered-map
:header (b/string "ISO-8859-1" :length 80) ;; for the time being we neither know nor care what's in this.
:count :uint-le
:facets (b/repeated facet)))
(defn canonicalise
"Objects read in from STL won't have all the keys/values we need them to have.
`o` may be a map (representing a facet or a vertex), or a sequence of such maps;
if it isn't recognised it is at present just returned unchanged. `map-kind`, if
passed, must be a keyword indicating the value represented by the `z` axis
(defaults to `:height`). It is an error, and an exception will be thrown, if
`map-kind` is not a keyword."
([o] (canonicalise o :height))
([o map-kind]
(canonicalise o map-kind (v/vertex 1 1 1)))
([o map-kind scale-vertex]
(when-not
(keyword? map-kind)
(throw (IllegalArgumentException.
(u/truncate (str "Must be a keyword: " (or map-kind "nil")) 80))))
(cond
(and (coll? o) (not (map? o))) (map #(canonicalise % map-kind) o)
;; if it has :facets it's an STL structure, but it doesn't yet conform to `stl?`
(:facets o) (assoc o
:kind :stl
:walkmap.id/id (or (:walkmap.id/id o) (keyword (gensym "stl")))
:facets (canonicalise (:facets o) map-kind))
;; if it has :vertices it's a polygon, but it may not yet conform to
;; `polygon?`
(:vertices o) (let [f (gradient
(centre
(tag
(assoc o
:walkmap.id/id (or
(:walkmap.id/id o)
(keyword (gensym "poly")))
:kind :polygon
:vertices (canonicalise
(:vertices o)
map-kind))
:facet map-kind)))]
(if (o/ocean? f)
(tag f :ocean :no-traversal)
f))
;; if it has a value for :x it's a vertex, but it may not yet conform
;; to `vertex?`; it should also be scaled using the scale-vertex, if any.
(:x o) (let [c (v/canonicalise o)]
(if scale-vertex
(v/vertex* c scale-vertex)
c))
;; shouldn't happen
:else o)))
(defn decode-binary-stl
"Parse a binary STL file from this `filename` and return an STL structure
representing its contents. `map-kind`, if passed, must be a keyword
or sequence of keywords indicating the semantic value represented by the `z`
axis (defaults to `:height`).
If `superstructure` is supplied and is a map, the generated STL structure
will be stored in that superstructure, which will be returned.
If `scale-vertex` is supplied, it must be a three dimensional vertex (i.e.
the `:z` key must have a numeric value) representing the amount by which
each of the vertices read from the STL will be scaled.
It is an error, and an exception will be thrown, if `map-kind` is not a
keyword or sequence of keywords.
**NOTE** that we've no way of verifying that the input file is binary STL
data, if it is not this will run but will return garbage."
([filename]
(decode-binary-stl filename :height))
([filename map-kind]
(when-not
(keyword? map-kind)
(throw (IllegalArgumentException.
(u/truncate (str "Must be a keyword: " (or map-kind "nil")) 80))))
(decode-binary-stl filename map-kind nil))
([filename mapkind superstucture]
(decode-binary-stl filename mapkind superstucture (v/vertex 1 1 1)))
([filename map-kind superstructure scale-vertex]
(let [in (io/input-stream filename)
stl (canonicalise (b/decode binary-stl in) map-kind scale-vertex)]
(if
(map? superstructure)
(store stl superstructure)
stl))))
(defn- vect->str [prefix v]
(str prefix " " (:x v) " " (:y v) " " (:z v) "\n"))
(defn- facet2str [tri]
(str
(vect->str "facet normal" (:normal tri))
"outer loop\n"
(s/join
(map
#(vect->str "vertex" %)
(:vertices tri)))
"endloop\nendfacet\n"))
(defn stl->ascii
"Return as a string an ASCII rendering of the `stl` structure."
([stl]
(stl->ascii stl "unknown"))
([stl solidname]
(str
"solid "
solidname
(s/trim (:header stl))
"\n"
(s/join
(map
facet2str
(:facets stl)))
"endsolid "
solidname
"\n")))
(defn write-ascii-stl
"Write an `stl` structure as read by `decode-binary-stl` to this
`filename` as ASCII encoded STL."
([filename stl]
(let [b (fs/base-name filename true)]
(write-ascii-stl
filename stl
(subs b 0 (or (s/index-of b ".") (count b))))))
([filename stl solidname]
(l/debug "Solid name is " solidname)
(spit
filename
(stl->ascii stl solidname))))
(defn binary-stl-to-ascii
"Convert the binary STL file indicated by `in-filename`, and write it to
`out-filename`, if specified; otherwise, to a file with the same basename
as `in-filename` but the extension `.ascii.stl`."
([in-filename]
(let [[_ ext] (fs/split-ext in-filename)]
(binary-stl-to-ascii
in-filename
(str
(subs
in-filename
0
(or
(s/last-index-of in-filename ".")
(count in-filename)))
".ascii"
ext))))
([in-filename out-filename]
(write-ascii-stl out-filename (decode-binary-stl in-filename))))

272
src/cc/journeyman/walkmap/superstructure.clj Normal file
View file

@ -0,0 +1,272 @@
(ns cc.journeyman.walkmap.superstructure
"single indexing structure for walkmap objects"
(:require [clojure.walk :refer [postwalk]]
[taoensso.timbre :as l]
[cc.journeyman.walkmap.edge :refer [edge length]]
[cc.journeyman.walkmap.path :as p]
[cc.journeyman.walkmap.polygon :as q]
[cc.journeyman.walkmap.utils :as u]
[cc.journeyman.walkmap.vertex :as v]))
;; TODO: Think about reification/dereification. How can we cull a polygon, if
;; some vertices still index it? I *think* that what's needed is that when
;; we store something in the superstructure, we replace all its vertices (and
;; other dependent structures, if any with their ids - as well as, obviously,
;; adding/merging those vertices/dependent structures into the superstructure
;; as first class objects in themselves. That means, for each identified thing,
;; the superstructure only contains one copy of it.
;;
;; The question then is, when we want to do things with those objects, do we
;; exteract a copy with its dependent structures fixed back up (reification),
;; or do we indirect through the superstructure every time we want to access
;; them? In a sense, the copy in the superstructure is the 'one true copy',
;; but it may become very difficult then to have one true copy of the
;; superstructure - unless we replace the superstructure altogether with a
;; database, which may be the Right Thing To Do.
(def vertex-index ::vertex-index)
(defn vertices
"If `o` is an object with vertices, return those vertices, else nil."
[o]
(when (map? o)
(reduce
concat
(remove
nil?
(map
#(cond
(v/vertex? %) (list %)
(and (coll? %) (every? v/vertex? %)) %)
(vals o))))))
;; (cond
;; (v/vertex? o) (list o)
;; (q/polygon? o) (:vertices o)
;; (p/path? o) (:vertices o))
;; )
(defn index-vertex
"Return a superstructure like `s` in which object `o` is indexed by vertex
`v`. It is an error (and an exception may be thrown) if
1. `s` is not a map;
2. `o` is not a map;
3. `o` does not have a value for the key `:walkmap.id/id`;
4. `v` is not a vertex."
[s o v]
(if-not (v/vertex? o)
(if (:walkmap.id/id o)
(if (v/vertex? v)
(let [vi (or (::vertex-index s) {})
current (or (vi (:walkmap.id/id v)) {})]
;; deep-merge doesn't merge sets, only maps; so at this
;; stage we need to build a map.
(assoc vi (:walkmap.id/id v) (assoc current (:walkmap.id/id o) (:walkmap.id/id v))))
(throw (IllegalArgumentException. "Not a vertex: " v)))
(throw (IllegalArgumentException. (u/truncate (str "No `:walkmap.id/id` value: " o) 80))))
;; it shouldn't actually be an error to try to index a vertex, but it
;; also isn't useful to do so, so I'd be inclined to ignore it.
(::vertex-index s)))
(defn index-vertices
"Return a superstructure like `s` in which object `o` is indexed by its
vertices. It is an error (and an exception may be thrown) if
1. `s` is not a map;
2. `o` is not a map;
3. `o` does not have a value for the key `:walkmap.id/id`."
[s o]
(u/deep-merge
s
{::vertex-index
(reduce
u/deep-merge
{}
(map
#(index-vertex s o %)
(:vertices o)))}))
(defn in-retrieve
"Internal guts of `retrieve`, q.v. `x` can be anything; `s` must be a
walkmap superstructure. TODO: recursive, quite likely to blow the fragile
Clojure stack. Probably better to do this with `walk`, but I don't yet
understand that."
[x s]
(cond
;; if it's a keyword identifying something in s, retrieve that something.
(keyword? x) (if (s x)
(in-retrieve (s x) s)
x)
;; if it's a map, for every key which is not `:walkmap.id/id`, recurse.
(map? x) (let [v (reduce
(fn [m k]
(assoc m k (in-retrieve (x k) s)))
{}
(keys (dissoc x :walkmap.id/id)))
id (:walkmap.id/id x)]
;; if it has an id, bind it to that id in the returned value.
(if id
(assoc
v
:walkmap.id/id
(:walkmap.id/id x))
v))
(set? x) x ;; TODO: should I search in sets for objects when storing?
(coll? x) (map #(in-retrieve % s) x)
:else x))
(defn retrieve
"Retrieve the canonical representation of the object with this `id` from the
superstructure `s`."
[id s]
(in-retrieve (id s) s))
(defn in-store-find-objects
"Return an id -> object map of every object within `o`. Internal to
`in-store`, q.v. Use at your own peril."
([o]
(in-store-find-objects o {}))
([o s]
(l/debug "Finding objects in:" o)
(cond
(set? o) s ;; TODO: should I search in sets for objects when storing?
(map? o) (if (:walkmap.id/id o)
(assoc
(in-store-find-objects (vals o) s)
(:walkmap.id/id o)
o)
(in-store-find-objects (vals o) s))
(coll? o) (reduce merge s (map #(in-store-find-objects % s) o))
:else s)))
(defn in-store-replace-with-keys
"Return a copy of `o` in which each reified walkmap object within `o` has
been replaced with the `:walkmap.id/id` of that object. Internal to
`in-store`, q.v. Use at your own peril."
[o]
(assoc
(postwalk #(or (:walkmap.id/id %) %) (dissoc o :walkmap.id/id))
:walkmap.id/id
(:walkmap.id/id o)))
;; (in-store-replace-with-keys (p/path (v/vertex 0 0 0) (v/vertex 0 1 2) (v/vertex 3 3 3)))
;; (in-store-find-objects (p/path (v/vertex 0 0 0) (v/vertex 0 1 2) (v/vertex 3 3 3)))
(defn store
"Return a superstructure like `s` with object `o` added. If only one
argument is supplied it will be assumed to represent `o` and a new
superstructure will be returned.
It is an error (and an exception may be thrown) if
1. `s` is not a map;
2. `o` is not a recognisable walkmap object"
([o]
(store o {}))
([o s]
(when-not (:walkmap.id/id o)
(throw
(IllegalArgumentException.
(str "Not a walkmap object: no value for `:walkmap.id/id`: "
(u/kind-type o)))))
(when-not (map? s)
(throw
(IllegalArgumentException.
(str "Superstructure must be a map: " (u/kind-type s)))))
(assoc
(u/deep-merge s (in-store-find-objects o) (index-vertices s o))
(:walkmap.id/id o)
(in-store-replace-with-keys o))))
(defn search-vertices
"Search superstructure `s` for vertices within the box defined by vertices
`minv` and `maxv`. Every coordinate in `minv` must have a lower value than
the equivalent coordinate in `maxv`. If `d2?` is supplied and not false,
search only in the x,y projection.
**NOTE THAT** this depends on the fact that vertices do not currently
have properties which will be denormalised by `store`, and therefore do not
have to restored with `retrieve`. If properties are added to vertices
whose values are objects, then this will have to be rewritten."
([s minv maxv]
(search-vertices s minv maxv false))
([s minv maxv d2?]
(let [minv' (if d2? (assoc minv :z Double/NEGATIVE_INFINITY) minv)
maxv' (if d2? (assoc maxv :z Double/POSITIVE_INFINITY) maxv)]
(filter
#(v/within-box? % minv maxv)
(filter #(= (:kind %) :vertex) (vals s))))))
(defn nearest
"Search superstructure `s` for the nearest object matching `filter-fn` to
the `target` vertex. Searches only with `radius` (slight misnomer, area
actually searched is a cube). Returns one object, or `nil` if no matching
object found.
WARNING: currently only returns objects which have a defined `:centre`
(but most of the significant objects we have do)."
[s target filter-fn radius]
(let [minv (v/vertex
(- (:x (v/check-vertex target)) radius)
(- (:y target) radius) (- (or (:z target) 0) radius))
maxv (v/vertex
(+ (:x target) 0.5) (+ (:y target) 0.5)
(+ (or (:z target) 0) 0.5))]
;; filter those objects with the filter function, then sort that list
;; by the edge distance from the target to the `:centre` of the object
;; and take the first
(first
(sort-by
#(length (edge target (:centre %)))
(filter
:centre
(map #(retrieve % s)
;; for each vertex id in vids, get the objects associated with that id
;; in the vertex index as a single flat list
(reduce
concat
(remove
nil?
(map
#(-> s ::vertex-index % keys)
;; get all the vertex ids within radius of the target
(set
(map
:walkmap.id/id
(search-vertices s minv maxv))))))))))))
(defn touching
"Return a sequence of all objects in superstructure `s` which are
indexed as touching the vertex `v`."
([vertex s]
(map
#(retrieve % s)
(set (-> s :vertex-index (:walkmap.id/id (v/check-vertex vertex)) keys))))
([vertex filter-fn s]
(filter
filter-fn
(touching vertex s))))
(defn neighbours
"Return a sequence of all those objects in superstructure `s` which share
at least one vertex with `target`, and which are matched by `filter-fn`
if supplied."
([target s]
(neighbours identity s))
([target filter-fn s]
(remove
#(= target %)
(reduce
concat
(remove
nil?
(map #(touching % filter-fn s) (vertices target)))))))
(defn neighbour-ids
"Return a sequence of the ids all those objects in superstructure `s` which
share at least one vertex with `target`, and which are matched by
`filter-fn` if supplied."
([target s]
(neighbour-ids target identity s))
([target filter-fn s]
(map :walkmap.id/id (neighbours target filter-fn s))))

110
src/cc/journeyman/walkmap/svg.clj Normal file
View file

@ -0,0 +1,110 @@
(ns cc.journeyman.walkmap.svg
"Utility functions for writing stereolithography (STL) files (and possibly,
later, other geometry files of interest to us) as scalable vector graphics
(SVG)."
(:require [clojure.java.io :as io]
[clojure.string :as s]
[clojure.xml :as x]
[dali.io :as neatly-folded-clock]
[hiccup.core :refer [html]]
[taoensso.timbre :as l :refer [info error spy]]
[cc.journeyman.walkmap.ocean :refer [cull-ocean-facets]]
[cc.journeyman.walkmap.polygon :refer [polygon?]]
[cc.journeyman.walkmap.stl :refer [decode-binary-stl]]
[cc.journeyman.walkmap.vertex :refer [vertex?]]))
(def ^:dynamic *preferred-svg-render*
"Mainly for debugging dali; switch SVG renderer to use. Expected values:
`:dali`, `:hiccup`."
:dali)
(defn- facet->svg-poly
[facet]
[:polygon
{:points (s/join " " (map #(str (:x %) "," (:y %)) (:vertices facet)))}])
(defn- dali-facet->svg-poly
[facet]
(vec
(cons
:polygon
(map #(vec (list (:x %) (:y %))) (:vertices facet)))))
(defn dali-stl->svg
"Format this `stl` as SVG for the `dali` renderer on a page with these
bounds."
[stl minx maxx miny maxy]
[:dali/page
{:xmlns "http://www.w3.org/2000/svg"
:version "1.2"
:width (- maxx minx)
:height (- maxy miny)
:viewBox (s/join " " (map str [minx miny maxx maxy]))}
(vec
(cons
:g
(map
dali-facet->svg-poly
(:facets stl))))])
(defn hiccup-stl->svg
"Format this `stl` as SVG for the `hiccup` renderer on a page with these
bounds."
[stl minx maxx miny maxy]
[:svg
{:xmlns "http://www.w3.org/2000/svg"
:version "1.2"
:width (- maxx minx)
:height (- maxy miny)
:viewBox (s/join " " (map str [minx miny maxx maxy]))}
(vec
(cons
:g
(map
facet->svg-poly
(:facets stl))))])
(defn stl->svg
"Convert this in-memory `stl` structure, as read by `decode-binary-stl`, into
an in-memory hiccup representation of SVG structure, and return it."
[stl]
(let [minx (reduce
min
(map
#(reduce min (map :x (:vertices %)))
(:facets stl)))
maxx (reduce
max
(map
#(reduce max (map :x (:vertices %)))
(:facets stl)))
miny (reduce
min
(map
#(reduce min (map :y (:vertices %)))
(:facets stl)))
maxy (reduce
max
(map
#(reduce max (map :y (:vertices %)))
(:facets stl)))]
(l/info "Generating SVG for " *preferred-svg-render* " renderer")
(case *preferred-svg-render*
:hiccup (hiccup-stl->svg stl minx maxx miny maxy)
:dali (dali-stl->svg stl minx maxx miny maxy)
(throw (Exception. "Unexpected renderer value: " *preferred-svg-render*)))))
(defn binary-stl-file->svg
"Given only an `in-filename`, parse the indicated file, expected to be
binary STL, and return an equivalent SVG structure. Given both `in-filename`
and `out-filename`, as side-effect write the SVG to the indicated output file."
([in-filename]
(stl->svg (cull-ocean-facets (decode-binary-stl in-filename))))
([in-filename out-filename]
(let [s (binary-stl-file->svg in-filename)]
(l/info "Emitting SVG with " *preferred-svg-render* " renderer")
(case *preferred-svg-render*
:dali (neatly-folded-clock/render-svg s out-filename)
:hiccup (spit out-filename (html s))
(throw (Exception. "Unexpected renderer value: " *preferred-svg-render*)))
s)))

68
src/cc/journeyman/walkmap/tag.clj Normal file
View file

@ -0,0 +1,68 @@
(ns cc.journeyman.walkmap.tag
"Code for tagging, untagging, and finding tags on objects. Note the use of
the namespaced keyword, `:walkmap.tag/tags`, denoted in this file `::tags`.
This is in an attempt to avoid name clashes with other uses of this key."
(:require [clojure.set :refer [difference union]]
[taoensso.timbre :as l]
[cc.journeyman.walkmap.utils :refer [kind-type]]))
(defn tagged?
"True if this `object` is tagged with each of these `tags`. It is an error
(and an exception will be thrown) if
1. `object` is not a map;
2. any of `tags` is not a keyword."
[object & tags]
(when-not (map? object)
(throw (IllegalArgumentException.
(str "Must be a map: " (kind-type object)))))
(let [tags' (flatten tags)]
(when-not (every? keyword? tags')
(throw (IllegalArgumentException.
(str "Must be keywords: " (map kind-type tags')))))
(let [ot (::tags object)]
(and
(set? ot)
(every? ot tags')))))
(defn tag
"Return an object like this `object` but with these `tags` added to its tags,
if they are not already present. It is an error (and an exception will be
thrown) if
1. `object` is not a map;
2. any of `tags` is not a keyword or sequence of keywords.
It's legal to include sequences of keywords in `tags`, so that users can do
useful things like `(tag obj (map keyword some-strings))`."
[object & tags]
(l/debug "Tagging" (kind-type object) "with" tags)
(when-not (map? object)
(throw (IllegalArgumentException.
(str "Must be a map: " (kind-type object)))))
(let [tags' (flatten tags)]
(when-not (every? keyword? tags')
(throw (IllegalArgumentException.
(str "Must be keywords: " (map kind-type tags')))))
(assoc object ::tags (union (set tags') (::tags object)))))
(defmacro tags
"Return the tags of this object, if any."
[object]
`(::tags ~object))
(defn untag
"Return an object like this `object` but with these `tags` removed from its
tags, if present. It is an error (and an exception will be thrown) if
1. `object` is not a map;
2. any of `tags` is not a keyword or sequence of keywords."
[object & tags]
(when-not (map? object)
(throw (IllegalArgumentException.
(str "Must be a map: " (kind-type object)))))
(let [tags' (flatten tags)]
(when-not (every? keyword? tags')
(throw (IllegalArgumentException.
(str "Must be keywords: " (map kind-type tags')))))
(update-in object [:walkmap.tag/tags] difference (set tags'))))

119
src/cc/journeyman/walkmap/utils.clj Normal file
View file

@ -0,0 +1,119 @@
(ns cc.journeyman.walkmap.utils
"Miscellaneous utility functions."
(:require [clojure.edn :as edn :only [read]]
[clojure.java.io :as io]
[clojure.math.numeric-tower :as m]
[clojure.string :as s]))
(defn deep-merge
"Recursively merges maps. If vals are not maps, the last value wins."
;; TODO: not my implementation, not sure I entirely trust it.
;; TODO TODO: if we are to successfully merge walkmap objects, we must
;; return, on each object, the union of its tags if any.
[& vals]
(if (every? map? vals)
(apply merge-with deep-merge vals)
(last vals)))
(defn truncate
"If string `s` is more than `n` characters long, return the first `n`
characters; otherwise, return `s`."
[s n]
(if (and (string? s) (number? n) (> (count s) n))
(subs s 0 n)
s))
(defn kind-type
"Identify the type of an `object`, e.g. for logging. If it has a `:kind` key,
it's one of ours, and that's what we want. Otherwise, we want its type; but
the type of `nil` is `nil`, which doesn't get printed when assembling error
,essages, so return \"nil\"."
[object]
(or (:kind object) (type object) "nil"))
(defn =ish
"True if numbers `n1`, `n2` are roughly equal; that is to say, equal to
within `tolerance` (defaults to one part in one hundred thousand)."
([n1 n2]
(if (and (number? n1) (number? n2))
(let [m (m/abs (min n1 n2))
t (if (zero? m) 0.00001 (* 0.00001 m))]
(=ish n1 n2 t))
(= n1 n2)))
([n1 n2 tolerance]
(if (and (number? n1) (number? n2))
(< (m/abs (- n1 n2)) tolerance)
(= n1 n2))))
(defmacro check-kind-type
"If `object` is not of kind-type `expected`, throws an
IllegalArgumentException with an appropriate message; otherwise, returns
`object`. If `checkfn` is supplied, it should be a function which tests
whether the object is of the expected kind-type.
Macro, so that the exception is thrown from the calling function."
([object expected]
`(if-not (= (kind-type ~object) ~expected)
(throw
(IllegalArgumentException.
(s/join
" "
["Expected" ~expected "but found" (kind-type ~object)])))
~object))
([object checkfn expected]
`(if-not (~checkfn ~object)
(throw
(IllegalArgumentException.
(s/join
" "
["Expected" ~expected "but found" (kind-type ~object)])))
~object)))
(defmacro check-kind-type-seq
"If some item on sequence `s` is not of the `expected` kind-type, throws an
IllegalArgumentException with an appropriate message; otherwise, returns
`object`. If `checkfn` is supplied, it should be a function which tests
whether the object is of the expected kind-type.
Macro, so that the exception is thrown from the calling function."
([s expected]
`(if-not (every? #(= (kind-type %) ~expected) ~s)
(throw
(IllegalArgumentException.
(s/join
" "
["Expected sequence of"
~expected
"but found ("
(s/join ", " (remove #(= ~expected %) (map kind-type ~s)))
")"])))
~s))
([s checkfn expected]
`(if-not (every? #(~checkfn %) ~s)
(throw
(IllegalArgumentException.
(s/join
" "
["Expected sequence of"
~expected
"but found ("
(s/join ", " (remove #(= ~expected %) (map kind-type ~s)))
")"])))
~s)))
(defn load-edn
"Load edn from an io/reader source (filename or io/resource)."
[source]
(try
(with-open [r (io/reader source)]
(edn/read (java.io.PushbackReader. r)))
(catch java.io.IOException e
(printf "Couldn't open '%s': %s\n" source (.getMessage e)))
(catch RuntimeException e
(printf "Error parsing edn file '%s': %s\n" source (.getMessage e)))))
(defn not-yet-implemented
[message]
(throw
(UnsupportedOperationException.
(str "Not yet implemented: " message))))

151
src/cc/journeyman/walkmap/vertex.clj Normal file
View file

@ -0,0 +1,151 @@
(ns cc.journeyman.walkmap.vertex
"Essentially the specification for things we shall consider to be vertices.
Note that there's no `distance` function here; to find the distance between
two vertices, create an edge from them and use `walkmap.edge/length`."
(:require [clojure.math.numeric-tower :as m]
[clojure.string :as s]
[taoensso.timbre :as l]
[cc.journeyman.walkmap.utils :refer [=ish check-kind-type check-kind-type-seq kind-type truncate]]))
(defn vertex-key
"Making sure we get the same key everytime we key a vertex with the same
coordinates. `o` must have numeric values for `:x`, `:y`, and optionally
`:z`; it is an error and an exception will be thrown if `o` does not
conform to this specification.
**Note:** these keys can be quite long. No apology is made: it is required
that the same key can *never* refer to two different locations in space."
[o]
(keyword
(s/replace
(cond
(and (:x o) (:y o) (:z o))
(str "vert_" (:x o) "_" (:y o) "_" (:z o))
(and (:x o) (:y o))
(str "vert_" (:x o) "_" (:y o))
:else
(throw (IllegalArgumentException.
(truncate (str "Not a vertex: " (or o "nil")) 80))))
"."
"-")))
(defn vertex?
"True if `o` satisfies the conditions for a vertex. That is, essentially,
that it must rerpresent a two- or three- dimensional vector. A vertex is
shall be a map having at least the keys `:x` and `:y`, where the value of
those keys is a number. If the key `:z` is also present, its value must also
be a number.
The name `vector?` was not used as that would clash with a function of that
name in `clojure.core` whose semantics are entirely different."
[o]
(and
(map? o)
(:walkmap.id/id o)
(number? (:x o))
(number? (:y o))
(or (nil? (:z o)) (number? (:z o)))
(or (nil? (:kind o)) (= (:kind o) :vertex))))
(defmacro check-vertex
"If `o` is not a vertex, throw an `IllegalArgumentException` with an
appropriate message; otherwise, returns `o`. Macro, so exception is thrown
from the calling function."
[o]
`(check-kind-type ~o vertex? :vertex))
(defmacro check-vertices
"If `o` is not a sequence of vertices, throw an `IllegalArgumentException` with an
appropriate message; otherwise, returns `o`. Macro, so exception is thrown
from the calling function."
[o]
`(check-kind-type-seq ~o vertex? :vertex))
(defn vertex=
"True if vertices `v1`, `v2` represent the same vertex."
[v1 v2]
(check-vertex v1)
(check-vertex v2)
(every?
#(=ish (% v1) (% v2))
[:x :y :z]))
(defn vertex*
"Return a vertex like `v1`, but with each of its coordinates multiplied
by the equivalent vertex in `v2`. It is an error, and an exception will
be thrown, if either `v1` or `v2` is not a vertex."
[v1 v2]
(let [f (fn [v1 v2 coord]
(* (or (coord v1) 0)
;; one here is deliberate!
(or (coord v2) 1)))]
(assoc v1 :x (f (check-vertex v1) (check-vertex v2) :x)
:y (f v1 v2 :y)
:z (f v1 v2 :z))))
(defn vertex
"Make a vertex with this `x`, `y` and (if provided) `z` values. Returns a map
with those values, plus a unique `:walkmap.id/id` value, and `:kind` set to `:vertex`.
It's not necessary to use this function to create a vertex, but the `:walkmap.id/id`
must be present and must be unique."
([x y]
(let [v {:x x :y y :kind :vertex}]
(assoc v :walkmap.id/id (vertex-key v))))
([x y z]
(let [v {:x x :y y :z z :kind :vertex}]
(assoc v :walkmap.id/id (vertex-key v)))))
(defn canonicalise
"If `o` is a map with numeric values for `:x`, `:y` and optionally `:z`,
upgrade it to something we will recognise as a vertex."
[o]
(if
(and
(map? o)
(number? (:x o))
(number? (:y o))
(or (nil? (:z o)) (number? (:z o))))
(assoc o :kind :vertex :walkmap.id/id (vertex-key o))
(throw
(IllegalArgumentException.
(truncate
(str "Not a proto-vertex: must have numeric `:x` and `:y`: "
(or o "nil"))
80)))))
(def ensure3d
"Given a vertex `o`, if `o` has a `:z` value, just return `o`; otherwise
return a vertex like `o` but having this `dflt` value as the value of its
`:z` key, or zero as the value of its `:z` key if `dflt` is not specified.
If `o` is not a vertex, throws an exception."
(memoize
(fn
([o]
(ensure3d o 0.0))
([o dflt]
(if (:z (check-vertex o))
o
(assoc o :z dflt))))))
(def ensure2d
"If `o` is a vertex, set its `:z` value to zero; else throw an exception."
(memoize
(fn [o]
(assoc (check-vertex o) :z 0.0))))
(defn within-box?
"True if `target` is within the box defined by `minv` and `maxv`. All
arguments must be vertices; additionally, both `minv` and `maxv` must
have `:z` coordinates."
[target minv maxv]
(do
(check-vertices [target minv maxv])
(every?
true?
(map
#(if (% target)
(<= (% minv) (% target) (% maxv))
true)
[:x :y :z]))))

124
test/cc/journeyman/walkmap/edge_test.clj Normal file
View file

@ -0,0 +1,124 @@
(ns cc.journeyman.walkmap.edge-test
(:require [clojure.math.numeric-tower :as m]
[clojure.test :refer :all]
[cc.journeyman.walkmap.edge :refer [collinear? collinear2d? edge
edge? intersection2d length
minimaxd parallel? overlaps2d?
unit-vector]]
[cc.journeyman.walkmap.vertex :refer [vertex vertex=]]))
(deftest edge-test
(testing "identification of edges."
(is (edge? {:start (vertex 0.0 0.0 0.0)
:end (vertex 3 4 0.0)}) "It is.")
(is (not (edge? {:start {:y 0.0 :z 0.0 :walkmap.id/id 'foo}
:end {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}})) "Start lacks :x key")
(is (not (edge? {:start {:x nil :y 0.0 :z 0.0 :walkmap.id/id 'foo}
:end {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}})) "Start lacks :x value")
(is (not (edge? {:begin {:x nil :y 0.0 :z 0.0 :walkmap.id/id 'foo}
:end {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}})) "Lacks start key")
(is (not (edge? {:start {:x nil :y 0.0 :z 0.0 :walkmap.id/id 'foo}
:finish {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}})) "Lacks end key")
(is (not (edge? {:start {:x "zero" :y 0.0 :z 0.0 :walkmap.id/id 'foo}
:end {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}})) "Value of x in start is not a number")
(is (false? (edge? "I am not an edge")) "Edge mustbe a map.")))
(deftest collinear-test
(testing "collinearity"
(is (collinear? {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 3.0 :y 4.0 :z 0.0 :walkmap.id/id 'bar}}
{:start {:x 3.0 :y 4.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 9.0 :y 12.0 :z 0.0 :walkmap.id/id 'bar}})
"Should be")
(is (not
(collinear? {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 3 :y 4 :z 0.0 :walkmap.id/id 'bar}}
{:start {:x 1.0 :y 2.0 :z 3.5 :walkmap.id/id 'foo} :end {:x 4.0 :y 6.0 :z 3.5 :walkmap.id/id 'bar}}))
"Should not be!")
(is (collinear? {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 3.0 :y 4.0 :z 0.0 :walkmap.id/id 'bar}}
{:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 9.0 :y 12.0 :z 0.0 :walkmap.id/id 'bar}})
"Edge case: same start location")
(is (collinear? {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 9.0 :y 12.0 :z 0.0 :walkmap.id/id 'bar}}
{:start {:x 3.0 :y 4.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 9.0 :y 12.0 :z 0.0 :walkmap.id/id 'bar}})
"Edge case: same end location")
))
(deftest collinear2d-test
(testing "Collinearity when projected onto the x,y plane."
(is (collinear2d? (edge (vertex 1.0 1.0) (vertex 5.0 5.0))
(edge (vertex 4.0 4.0) (vertex 6.0 6.0)))
"Collinear, overlapping.")
(is (collinear2d? (edge (vertex 1.0 1.0 0.0) (vertex 5.0 5.0 5.0))
(edge (vertex 4.0 4.0 79.3) (vertex 6.0 6.0 0.2)))
"Separated in the z axis, but collinear in x, y.")))
(deftest construction-test
(testing "Construction of edges."
(is (edge? (edge (vertex 1.0 2.0 3.0) (vertex 4.0 8.0 12.0)))
"If both arguments are vertices, we should get an edge")
(is (thrown? IllegalArgumentException (edge "Not a vertex" (vertex 1 2)))
"If first argument is not a vertex, we should get an exception.")
(is (thrown? IllegalArgumentException (edge (vertex 1 2) "Not a vertex"))
"If second argument is not a vertex, we should get an exception.")))
(deftest intersection2d-test
(testing "intersection of two edges projected onto the x,y plane."
(is (thrown? IllegalArgumentException
(intersection2d
(edge (vertex 1.0 1.0) (vertex 5.0 5.0))
"This is not an edge"))
"Not an edge (second arg) -> exception.")
(is (thrown? IllegalArgumentException
(intersection2d
"This is not an edge"
(edge (vertex 1.0 1.0) (vertex 5.0 5.0))))
"Not an edge (first arg) -> exception.")
(is (nil? (intersection2d (edge (vertex 1.0 1.0) (vertex 5.0 5.0))
(edge (vertex 1.0 2.0) (vertex 5.0 6.0))))
"Parallel but not intersecting.")
(is (:x (intersection2d (edge (vertex 1.0 1.0) (vertex 5.0 5.0))
(edge (vertex 4.0 4.0) (vertex 6.0 6.0)))
5.0)
"Collinear, overlapping, should choose the overlapping end of the first edge.")
(is (= (:x (intersection2d (edge (vertex 1.0 1.0) (vertex 5.0 5.0))
(edge (vertex 1.0 5.0) (vertex 5.0 1.0))))
3.0)
"Crossing, should intersect at 3.0, 3.0: x coord.")
(is (= (:y (intersection2d (edge (vertex 1.0 1.0) (vertex 5.0 5.0))
(edge (vertex 1.0 5.0) (vertex 5.0 1.0))))
3.0)
"Crossing, should intersect at 3.0, 3.0: y coord.")
(is (= (:y (intersection2d (edge (vertex 1.0 1.0 0.0) (vertex 5.0 5.0 0.0))
(edge (vertex 1.0 5.0 999) (vertex 5.0 1.0 379))))
3.0)
"Crossing, presence of z coordinate should make no difference")))
(deftest length-test
(testing "length of an edge"
(is (= (length {:start {:x 0.0 :y 0.0 :z 0.0 :walkmap.id/id 'foo} :end {:x 3.0 :y 4.0 :z 0.0 :walkmap.id/id 'bar}}) 5.0))))
(deftest minimaxd-test
(testing "finding minimum and maximum coordinates of edges."
(is (= (minimaxd (edge (vertex 1.0 2.0 3.0) (vertex 4.0 8.0 12.0)) :x min) 1.0))
(is (= (minimaxd (edge (vertex 1.0 2.0 3.0) (vertex 4.0 8.0 12.0)) :y max) 8.0))))
(deftest parallel-test
(testing "parallelism"
(is (parallel? (edge (vertex 0.0 0.0 0.0) (vertex 3 4 0.0))
(edge (vertex 1.0 2.0 3.5) (vertex 4.0 6.0 3.5)))
"Should be")
(is (not
(parallel? (edge (vertex 0.0 0.0 0.0) (vertex 3 4 0.0))
(edge (vertex 1.0 2.0 3.5) (vertex 4.0 6.0 3.49))))
"Should not be!")))
(deftest overlaps2d-test
(testing "whether two edges are in the same area of the x,y plane."
(is (false? (overlaps2d? (edge (vertex 1 1) (vertex 4 4)) (edge (vertex 5 5) (vertex 8 8)))))
(is (overlaps2d? (edge (vertex 1 1) (vertex 4 4)) (edge (vertex 4 4) (vertex 1 1))))))
(deftest unit-vector-test
(testing "deriving the unit vector"
(is (vertex=
(unit-vector (edge (vertex 0.0 0.0 0.0) (vertex 3 4 0.0)))
(vertex 0.6 0.8 0.0)))
(is (vertex=
(unit-vector (edge (vertex 1.0 2.0 3.5) (vertex 4.0 6.0 3.5)))
(vertex 0.6 0.8 0.0)))))

53
test/cc/journeyman/walkmap/ocean_test.clj Normal file
View file

@ -0,0 +1,53 @@
(ns cc.journeyman.walkmap.ocean-test
(:require [clojure.test :refer :all]
[cc.journeyman.walkmap.ocean :refer [*sea-level* cull-ocean-facets ocean?]]
[cc.journeyman.walkmap.polygon :refer [polygon]]
[cc.journeyman.walkmap.vertex :refer [vertex vertex=]]))
(deftest ocean-tests
(testing "Identification of polygons at sea level"
(is (ocean? (polygon (vertex 0 0 0) (vertex 0 1 0) (vertex 1 0 0)))
"All `:z` coordinates are zero, and default binding for `*sea-level*`
=> ocean.")
(is (false? (ocean? (polygon (vertex 0 0 1) (vertex 0 1 0) (vertex 1 0 0))))
"Not all `:z` coordinates are zero, and default binding for `*sea-level*`
=> not ocean.")
(is (false? (ocean? (polygon (vertex 0 0 5) (vertex 0 1 5) (vertex 1 0 5))))
"Not all `:z` coordinates are five, and default binding for `*sea-level*`
=> not ocean.")
(binding [*sea-level* 5]
(is (false? (ocean? (polygon (vertex 0 0 0) (vertex 0 1 0) (vertex 1 0 0))))
"All `:z` coordinates are zero, and `*sea-level*` rebound to five
=> not ocean.")
(is (false? (ocean? (polygon (vertex 0 0 1) (vertex 0 1 0) (vertex 1 0 0))))
"Not all `:z` coordinates are zero, and `*sea-level*` rebound to five
=> not ocean.")
(is (ocean? (polygon (vertex 0 0 5) (vertex 0 1 5) (vertex 1 0 5)))
"Not all `:z` coordinates are five, and `*sea-level*` rebound to five
=> ocean."))))
(deftest cull-ocean-facets-tests
(testing "Culling of ocean facets (not currently used)."
(let [stl {:facets [(polygon (vertex 0 0 0) (vertex 0 1 0) (vertex 1 0 0))
(polygon (vertex 0 0 1) (vertex 0 1 0) (vertex 1 0 0))
(polygon (vertex 0 0 5) (vertex 0 1 5) (vertex 1 0 5))]}
expected {:facets
[(polygon (vertex 0 0 1) (vertex 0 1 0) (vertex 1 0 0))
(polygon (vertex 0 0 5) (vertex 0 1 5) (vertex 1 0 5))]}
actual (cull-ocean-facets stl)]
(map
#(is (vertex= (nth (:facets expected) %) (nth (:facets actual) %))
(str "Facet " % " did not match."))
(range (max (count (:facets expected)) (count (:facets actual))))))
(binding [*sea-level* 5]
(let [stl {:facets [(polygon (vertex 0 0 0) (vertex 0 1 0) (vertex 1 0 0))
(polygon (vertex 0 0 1) (vertex 0 1 0) (vertex 1 0 0))
(polygon (vertex 0 0 5) (vertex 0 1 5) (vertex 1 0 5))]}
expected {:facets
[(polygon (vertex 0 0 0) (vertex 0 1 0) (vertex 1 0 0))
(polygon (vertex 0 0 1) (vertex 0 1 0) (vertex 1 0 0))]}
actual (cull-ocean-facets stl)]
(map
#(is (vertex= (nth (:facets expected) %) (nth (:facets actual) %))
(str "Facet " % " did not match."))
(range (max (count (:facets expected)) (count (:facets actual)))))))))

113
test/cc/journeyman/walkmap/path_test.clj Normal file
View file

@ -0,0 +1,113 @@
(ns cc.journeyman.walkmap.path-test
(:require [clojure.test :refer :all]
[cc.journeyman.walkmap.edge :refer [edge?]]
[cc.journeyman.walkmap.path :refer [check-path check-paths
length path path? path->edges
polygon->path]]
[cc.journeyman.walkmap.polygon :refer [polygon]]
[cc.journeyman.walkmap.utils :refer [kind-type]]
[cc.journeyman.walkmap.vertex :refer [vertex vertex=]]))
(deftest path-tests
(testing "Path instantiation"
(is (= (kind-type (path (vertex 0 0 0) (vertex 1 1 1))) :path)
"Paths should be identified as paths.")
(is (path? (path (vertex 0 0 0) (vertex 1 1 1)))
"Paths should test as paths.")
(is (check-path (path (vertex 0 0 0) (vertex 1 1 1)))
"No exception should be thrown when checking a valid path.")
(is (thrown?
IllegalArgumentException
(check-path
(update-in
(path (vertex 0 0 0) (vertex 1 1 1))
[:vertices]
conj
"Not a vertex")))
"Checking an invalid path should throw an exception.")
(is (thrown?
IllegalArgumentException
(path (vertex 0 0 0)))
"Too short.")
(is (thrown?
IllegalArgumentException
(path (vertex 0 0 0) (vertex 1 1 1) "Not a vertex"))
"Non-vertex included.")
(is (thrown?
IllegalArgumentException
(path (vertex 0 0 0) (vertex 1 1 1) "Not a vertex."))
"Passing something which is not a vertex when constructing a path whould
cause an exception to be thrown.")))
(deftest conversion-tests
(testing "Converting polygons to paths"
(let [poly (polygon (vertex 0 0 0) (vertex 1 0 0) (vertex 1 1 0) (vertex 0 1 0))
p (polygon->path poly)]
(is (path? p) "Should be a path.")
(is (vertex= (first (:vertices p)) (last (:vertices p)))
"First and last vertices of the generated path should be equal to
one another.")
(is (= (count (:vertices p)) (inc (count (:vertices poly))))
"The generated path should have one more vertex than the polygon.")
(map
#(is (vertex= (nth (:vertices poly) %) (nth (:vertices p) %))
(str "Vertex " % " from each set of vertices should be the same."))
(range (count (:vertices poly))))))
(testing "Converting polygons and paths to edges."
(let [poly (polygon (vertex 0 0 0) (vertex 1 0 0) (vertex 1 1 0) (vertex 0 1 0))
edges (path->edges poly)]
(is (every? edge? edges)
"Every returned edge should be an edge.")
(is (= (count (:vertices poly)) (count edges))
"There should be the same number of edges as the vertices of the polygon")
(doall
(map
#(is
(vertex= (nth (:vertices poly) %) (:start (nth edges %)))
(str
"Each edge should start from the same place as the corresponding
vertex: " %))
(range (count (:vertices poly)))))
(doall
(map
#(is
(vertex= (nth (:vertices poly) (mod (inc %) (count (:vertices poly))))
(:end (nth edges %)))
(str
"Each edge should end at the same place as the subsequent
vertex: " %))
(range (count (:vertices poly))))))
(is (thrown? IllegalArgumentException
(path->edges "Not a legal argument.")))))
(deftest check-paths-tests
(testing "Checking multiple paths."
(is (thrown? IllegalArgumentException
(check-paths [(path (vertex 0 0 0)
(vertex 1 0 0)
(vertex 1 1 0)
(vertex 0 1 0)
(vertex 0 0 0))
(path (vertex 0 0 1)
(vertex 1 0 1)
(vertex 1 1 1)
(vertex 0 1 1)
(vertex 0 0 1))
(vertex 0 0 0)]))
"Not all elements are paths")
(is (check-paths [(path (vertex 0 0 0)
(vertex 1 0 0)
(vertex 1 1 0)
(vertex 0 1 0)
(vertex 0 0 0))
(path (vertex 0 0 1)
(vertex 1 0 1)
(vertex 1 1 1)
(vertex 0 1 1)
(vertex 0 0 1))])
"All elements are paths")))
(deftest length-tests
(testing "length of paths"
(let [p (path (vertex 0 0 0) (vertex 1 0 0) (vertex 1 1 0) (vertex 0 1 0) (vertex 0 0 0))]
(is (= (length p) 4) "By inspection."))))

85
test/cc/journeyman/walkmap/polygon_test.clj Normal file
View file

@ -0,0 +1,85 @@
(ns cc.journeyman.walkmap.polygon-test
(:require [clojure.test :refer :all]
;; [clojure.algo.generic.math-functions :as m]
;; [cc.journeyman.walkmap.edge :refer [edge?]]
;; [cc.journeyman.walkmap.path :refer :all]
[cc.journeyman.walkmap.polygon :refer [centre check-polygon
check-polygons
check-triangle gradient
polygon polygon?
triangle?]]
[cc.journeyman.walkmap.utils :refer [kind-type]]
[cc.journeyman.walkmap.vertex :refer [vertex vertex? vertex=]])
)
(deftest polygon-tests
(testing "Constructing polygons"
(let [square (polygon (vertex 0 0 0) (vertex 1 0 0)
(vertex 1 1 0) (vertex 0 1 0))
triangle (polygon (vertex 0 0 0) (vertex 0 3 0)
(vertex 4 0 0))]
(is (= (kind-type square) :polygon)
"Square should have `:kind` = `:polygon`.")
(is (= (kind-type triangle) :polygon)
"Triangle should have `:kind` = `:polygon`.")
(is (polygon? square) "Square should be a polygon.")
(is (polygon? triangle) "Triangle should be a polygon.")
(is (false? (triangle? square)) "Square is not a triangle.")
(is (triangle? triangle) "Triangle is a triangle.")
(is (check-polygon square) "No exception should be thrown.")
(is (check-polygon triangle) "No exception should be thrown.")
(is (check-triangle triangle) "No exception should be thrown.")
(is (check-polygons [square triangle])
"No exception should be thrown.")
(is (thrown?
IllegalArgumentException
(check-polygon "Not a polygon")) "Not a polygon")
(is (thrown?
IllegalArgumentException
(check-polygons [square triangle "Not a polygon"]))
"One value is not a polygon.")
(is (thrown?
IllegalArgumentException (check-triangle square))
"Not a triangle.")
(is (thrown?
IllegalArgumentException (polygon (vertex 0 0 0) (vertex 1 0 0)))
"Too few vertices.")
(is (thrown?
IllegalArgumentException (polygon (vertex 0 0 0) (vertex 1 0 0)
(vertex 1 1 0) "Not a vertex"
(vertex 0 1 0)))
"Non-vertex included.")
)
))
(deftest gradient-tests
(testing "Finding the gradient across a triangle."
(let [tri (polygon (vertex 0 0 1) (vertex 1 0 0) (vertex 1 1 0.5))
gra (gradient tri)]
(is (nil? (:gradient tri)) "Basic trangle should not have a gradient.")
(is (vertex? (:gradient gra))
"After passing through gradient function, it should have a gradient.")
;; TODO: I need to check that the gradient is being computed correclt,
;; but my brain isn't up to the trigonometry just now.
)))
(deftest centre-tests
(testing "Finding the centres of polygons."
(let [square (polygon (vertex 0 0 0) (vertex 1 0 0)
(vertex 1 1 0) (vertex 0 1 0))
triangle (polygon (vertex 0 0 0) (vertex 0 3 0)
(vertex 4 0 0))
centred (centre triangle)]
(is (vertex= (:centre centred) (vertex 1.3333333 1.0 0.0))
"By inspection (check this maths!).")
(is (thrown?
UnsupportedOperationException
(centre square))
"We can't yet find the centre of a quadrilateral, but we should be
able to do so, so it isn't an illegal argument, it just doesn't
work.")
(is (thrown?
IllegalArgumentException
(centre "Not a polygon"))
"Anything else that isn't a polygon, though, is an illegal argument."))))

96
test/cc/journeyman/walkmap/stl_test.clj Normal file
View file

@ -0,0 +1,96 @@
(ns cc.journeyman.walkmap.stl-test
(:require [clojure.test :refer :all]
[cc.journeyman.walkmap.stl :refer [canonicalise stl?]]
[cc.journeyman.walkmap.polygon :refer [polygon?]]
[cc.journeyman.walkmap.vertex :refer [vertex?]]))
(deftest canonicalise-test
(testing "Canonicalisation of objects read from STL: vertices."
(is (vertex? (canonicalise {:x 3.0, :y 1.0, :z 1.0}))
"Vertex: should have an `:walkmap.id/id` and `:kind` = `:vertex`.")
(is (= (:x (canonicalise {:x 3.0, :y 1.0, :z 1.0})) 3.0)
"`:x` value should be unchanged.")
(is (= (:y (canonicalise {:x 3.0, :y 1.0, :z 1.0})) 1.0)
"`:y` value should be unchanged.")
(is (= (:z (canonicalise {:x 3.0, :y 1.0, :z 1.0})) 1.0)
"`:z` value should be unchanged.")
(is (every?
vertex?
(canonicalise [{:x 3.0, :y 1.0, :z 1.0}
{:x 2.0, :y 3.0, :z 1.0}
{:x 0.0, :y 0.0, :z 1.0}]))
"Vertices: should recurse."))
(testing "Canonicalisation of objects read from STL: facets/polygons."
(let [p {:normal {:x -0.0, :y 0.0, :z 1.0},
:vertices [{:x 3.0, :y 1.0, :z 1.0}
{:x 2.0, :y 3.0, :z 1.0}
{:x 0.0, :y 0.0, :z 1.0}],
:abc 0}
p' (canonicalise p)]
(is (polygon? p')
"Polygon: should have an `:walkmap.id/id` and `:kind` = `:polygon`.")
(is (= (count (:vertices p)) (count (:vertices p')))
"Number of vertices should not change")
(map
#(is (= (map % (:vertices p))(map % (:vertices p')))
(str "Order of vertices should not change: " %))
[:x :y :z]))
(is (every?
polygon?
(canonicalise
[{:normal {:x -0.0, :y 0.0, :z 1.0},
:vertices [{:x 3.0, :y 1.0, :z 1.0}
{:x 2.0, :y 3.0, :z 1.0}
{:x 0.0, :y 0.0, :z 1.0}],
:abc 0}
{:normal {:x 0.0, :y 0.0, :z 1.0},
:vertices [{:x 10.0, :y 4.0, :z 1.0}
{:x 22.0, :y 3.0, :z 1.0}
{:x 13.0, :y 5.0, :z 1.0}],
:abc 0}
{:normal {:x 0.0, :y 0.0, :z 1.0},
:vertices [{:x 26.0, :y 46.0, :z 1.0}
{:x 29.0, :y 49.0, :z 1.0}
{:x 31.0, :y 61.0, :z 1.0}],
:abc 0}
{:normal {:x -0.0, :y 0.0, :z 1.0},
:vertices [{:x 16.0, :y 33.0, :z 1.0}
{:x 15.0, :y 35.0, :z 1.0}
{:x 13.0, :y 32.0, :z 1.0}],
:abc 0}
{:normal {:x 0.0, :y 0.0, :z 1.0},
:vertices [{:x 81.0, :y 0.0, :z 1.0}
{:x 54.0, :y 27.0, :z 1.0}
{:x 51.0, :y 20.0, :z 1.0}],
:abc 0}]))
"Facets/polygons: should recurse."))
(testing "Canonicalisation of entire STL structure."
(let [stl {:header "Dummy test STL",
:count 5,
:facets [{:normal {:x -0.0, :y 0.0, :z 1.0},
:vertices [{:x 3.0, :y 1.0, :z 1.0}
{:x 2.0, :y 3.0, :z 1.0}
{:x 0.0, :y 0.0, :z 1.0}],
:abc 0}
{:normal {:x 0.0, :y 0.0, :z 1.0},
:vertices [{:x 10.0, :y 4.0, :z 1.0}
{:x 22.0, :y 3.0, :z 1.0}
{:x 13.0, :y 5.0, :z 1.0}],
:abc 0}
{:normal {:x 0.0, :y 0.0, :z 1.0},
:vertices [{:x 26.0, :y 46.0, :z 1.0}
{:x 29.0, :y 49.0, :z 1.0}
{:x 31.0, :y 61.0, :z 1.0}],
:abc 0}
{:normal {:x -0.0, :y 0.0, :z 1.0},
:vertices [{:x 16.0, :y 33.0, :z 1.0}
{:x 15.0, :y 35.0, :z 1.0}
{:x 13.0, :y 32.0, :z 1.0}],
:abc 0}
{:normal {:x 0.0, :y 0.0, :z 1.0},
:vertices [{:x 81.0, :y 0.0, :z 1.0}
{:x 54.0, :y 27.0, :z 1.0}
{:x 51.0, :y 20.0, :z 1.0}],
:abc 0}]}
stl' (canonicalise stl)]
(is (stl? stl') "Stl: should have an `:walkmap.id/id` and `:kind` = `:stl`."))))

135
test/cc/journeyman/walkmap/superstructure_test.clj Normal file
View file

@ -0,0 +1,135 @@
(ns cc.journeyman.walkmap.superstructure-test
(:require [clojure.set :refer [subset?]]
[clojure.test :refer :all]
[cc.journeyman.walkmap.path :as p]
[cc.journeyman.walkmap.polygon :as q]
[cc.journeyman.walkmap.superstructure :refer [retrieve store vertex-index]]
[cc.journeyman.walkmap.tag :as t]
[cc.journeyman.walkmap.utils :as u]
[cc.journeyman.walkmap.vertex :as v]))
(deftest store-test
(testing "Object storage"
(let [p (p/path
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand)))
id (:walkmap.id/id p)
s (store p)
r (id s)]
(is (= (:walkmap.id/id r) id)
"A representation should be stored in `s` keyed by `id`, and the id of that representation should be `id`.")
(is (= (:kind r) (:kind p))
"The representation should have the same value for `:kind`.")
(is (= (count (:vertices p)) (count (:vertices r)))
"The representation of `p` in `s` should have the same number of vertices as `p`.")
(is (every? v/vertex? (:vertices p))
"Every vertex of `p` should be a vertex.")
(is (every? keyword? (:vertices r))
"Every vertex of the representation of `p` in `s` should be a keyword.")
(is (every? v/vertex? (map #(s %) (:vertices r)))
"The value in `s` of every vertex of the representation of `p` in `s`
should be a vertex.")
(is (subset? (set (:vertices r)) (set (keys (vertex-index s))))
"All the keys which are vertices of the representation of `p` in `s`
should be present as keys in the vertex-index of `s`.")
(is (every?
#(s (% id))
(map #(set (keys (% (vertex-index s)))) (:vertices r)))
"The value in the vertex-index in `s` for each keyword in the
vertexes of the representation of `p` in `s` should include,
as a key, the `id` of `p`."))))
(deftest retrieve-test
(testing "Object retrieval"
;; the value of `s` here is hand-typed; think of it as a specification
(let [s {:path1 {:walkmap.id/id :path1
:kind :path
:vertices '(:vert_0_0_0
:vert_0_0_1
:vert_1_0_0)}
:vert_0_0_0 {:walkmap.id/id :vert_0_0_0
:kind :vertex
:x 0
:y 0
:z 0}
:vert_0_0_1 {:walkmap.id/id :vert_0_0_1
:kind :vertex
:x 0
:y 0
:z 1}
:vert_1_0_0 {:walkmap.id/id :vert_1_0_0
:kind :vertex
:x 1
:y 0
:z 0}
:walkmap.superstructure/vertex-index {:vert_0_0_0 {:path1 :vert_0_0_0}
:vert_0_0_1 {:path1 :vert_0_0_1}
:vert_1_0_0 {:path1 :vert_1_0_0}}}
expected {:kind :path,
:vertices
'({:kind :vertex, :x 0, :y 0, :z 0, :walkmap.id/id :vert_0_0_0}
{:kind :vertex, :x 0, :y 0, :z 1, :walkmap.id/id :vert_0_0_1}
{:kind :vertex, :x 1, :y 0, :z 0, :walkmap.id/id :vert_1_0_0}),
:walkmap.id/id :path1}]
(is (= (retrieve :path1 s) expected)
"The object reconstructed from the superstructure."))))
(deftest round-trip-test
(testing "Roundtripping an object through the superstructure."
(let [p (p/path
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand)))
id (:walkmap.id/id p)
s (store p)
r (retrieve id s)]
(is (= p r) "As it was, so it shall be."))))
(deftest multi-object-round-trip-test
(testing "Roundtripping two different objects through a superstructure."
(let [p (p/path
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand)))
q (p/path
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand)))
pid (:walkmap.id/id p)
qid (:walkmap.id/id q)
s (store q (store p))
rp (retrieve pid s)
rq (retrieve qid s)]
(is (= p rp) "As `p` was, so it shall be.")
(is (= q rq) "As `q` was, so it shall be.")
(is (not= pid qid)
"It is not possible that the ids should be equal, since they are
gensymmed")
(is (not= rp rq)
"It is not possible that the paths should be equal, since at
minimum, their ids are gensymmed."))))
(deftest store-retrieve-edit-store-test
(testing "After editing a retrieved object and storing it again, a further
retrieve should return the new version."
(let [p (p/path
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand))
(v/vertex (rand) (rand) (rand)))
id (:walkmap.id/id p)
o (store p)
r (retrieve id o)
p' (t/tag
(assoc r :vertices
(conj (:vertices id) (v/vertex (rand) (rand) (rand))))
:edited)
o' (store p' o)
r' (retrieve id o')]
(is (not= r r') "The value referenced by `id` should have changed.")
(is (= r' p') "The value referenced by `id` in `o'` should be equal to `p'`."))))

54
test/cc/journeyman/walkmap/tag_test.clj Normal file
View file

@ -0,0 +1,54 @@
(ns cc.journeyman.walkmap.tag-test
(:require [clojure.test :refer :all]
[cc.journeyman.walkmap.tag :refer [tag tagged? tags untag]]))
(deftest tag-tests
(testing "Tagging"
(is (set? (:walkmap.tag/tags (tag {:kind :test-obj} :foo :bar :ban :froboz)))
"The value of `:walkmap.tag/tags` should be a set.")
(is (= (count (:walkmap.tag/tags (tag {:kind :test-obj} :foo :bar :ban :froboz))) 4)
"All the tags passed should be added.")
(is (:walkmap.tag/tags (tag {:kind :test-obj} :foo :bar :ban :froboz) :ban)
"`:ban` should be present in the set, and, as it is a set, it
should be valid to apply it to a keyword.")
(is (not ((:walkmap.tag/tags (tag {:kind :test-obj} :foo :bar :ban :froboz)) :cornflakes))
"`:cornflakes should not be present.")
(is (true? (tagged? (tag {:kind :test-obj} :foo :bar :ban :froboz) :bar))
"`tagged?` should return an explicit `true`, not any other value.")
(is (tagged? (tag {:kind :test-obj} :foo :bar :ban :froboz) :bar :froboz)
"We should be able to test for the presence of more than one tag")
(is (false? (tagged? {:kind :test-obj} :foo))
"A missing `:walkmap.tag/tags` should not cause an error.")
(is (= (tagged? (tag {:kind :test-obj} :foo :bar :ban :froboz) :bar :cornflakes) false)
"If any of the queried tags is missing, false should be returned")
(is (tagged? (tag (tag {:kind :test-obj} :foo) :bar) :foo :bar)
"We should be able to add tags to an already tagged object")
(is (false? (tagged? (tag {:kind :test-obj} :foo :bar) :cornflakes))
"`tagged?` should return an explicit `false` if a queried tag is missing.")
(is (= (tags (tag {:kind :test-obj} :foo)) #{:foo})
"`tags` should return the tags on the object, if any.")
(is (every? nil? (map #(tags %) [1 :one "one" [:one] {:one 1}]))
"Things which don't have tags don't have tags, and that's not a problem.")
(let [object (tag {:kind :test-obj} :foo :bar :ban :froboz)]
(is (= (untag object :cornflakes) object)
"Removing a missing tag should have no effect.")
(is (tagged? (untag object :foo) :bar :ban :froboz)
"All tags not explicitly removed should still be present.")
(is (false? (tagged? (untag object :bar) :bar))
"But the tag which has been removed should be removed."))
(is (thrown? IllegalArgumentException (tag [] :foo))
"An exception should be thrown if `object` is not a map: `tag`.")
(is (thrown? IllegalArgumentException (tagged? [] :foo))
"An exception should be thrown if `object` is not a map: `tagged?`.")
(is (thrown? IllegalArgumentException (untag [] :foo))
"An exception should be thrown if `object` is not a map: `untag`.")
(is (thrown? IllegalArgumentException (tag {:kind :test-obj} :foo "bar" :ban))
"An exception should be thrown if any of `tags` is not a keyword: `tag`.")
(is (thrown? IllegalArgumentException (tagged? {:kind :test-obj} :foo "bar" :ban))
"An exception should be thrown if any of `tags` is not a keyword: `tagged?`.")
(is (thrown? IllegalArgumentException (untag {:kind :test-obj} :foo "bar" :ban))
"An exception should be thrown if any of `tags` is not a keywordp: `untag`.")
(let [o (tag {:kind :test-obj} :foo '(:bar :ban) :froboz)]
(is (tagged? o :ban :bar :foo :froboz)
"It's now allowed to include lists of tags in the arg list for `tag`."))))

100
test/cc/journeyman/walkmap/utils_test.clj Normal file
View file

@ -0,0 +1,100 @@
(ns cc.journeyman.walkmap.utils-test
(:require [clojure.test :refer :all]
[cc.journeyman.walkmap.utils :refer [=ish check-kind-type check-kind-type-seq kind-type truncate]]
[cc.journeyman.walkmap.vertex :refer [vertex vertex?]]))
(deftest =ish-tests
(testing "Rough equality"
(is (=ish 5.00000001 5.00000002) "Close enough.")
(is (=ish 5 5) "Perfect.")
(is (not (=ish 5.01 5.02)) "Not close enough.")
(is (=ish 22/7 3.142857) "We hope so!")
(is (=ish 0 0.0) "Tricky conrer case!")
(is (=ish :foo :foo) "Fails over to plain old equals for non-numbers.")
(is (=ish 6 5 10000) "If tolerance is wide enough, anything can be equal.")
(is (not (=ish "hello" "goodbye" 10000)) "Well, except non-numbers, of course.")))
(deftest truncate-tests
(testing "String truncation"
(is (= (truncate "The quick brown fox jumped over the lazy dog" 19)
"The quick brown fox")
"If it's a sting, and longer than the desired length, it should be
truncated.")
(is (= (truncate "The quick brown fox jumped over the lazy dog" 100)
"The quick brown fox jumped over the lazy dog")
"If it's a sting, and shorter than the desired length, it should not be
truncated.")
(is (= (truncate :the-quick-brown-fox 10) :the-quick-brown-fox)
"If it's not a string, it should not be truncated, regardless.")))
(deftest kind-type-tests
(testing "Type identification."
(is (= (kind-type {:kind :test}) :test)
"Maps with a value for `:kind` return that as their kind.")
(is (= (kind-type {:dnik :test}) clojure.lang.PersistentArrayMap)
"Maps with no value for `:kind` are just maps.")
(is (= (kind-type nil) "nil")
"As a special case, the kind of `nil` is the string \"nil\".")
(is (= (kind-type "Fred") java.lang.String)
"The kind-type of anything else is just its Java class.")))
(deftest check-kind-type-tests
(testing "Exception thrown if kind not as expected."
(let [v {:kind :test}]
(is (= (check-kind-type v :test) v)
"If the check passes, the object is returned."))
(let [v "test"]
(is (= (check-kind-type v java.lang.String) v)
"If the check passes, the object is returned."))
(let [v "test"]
(is (= (check-kind-type v string? java.lang.String) v)
"If the check passes, the object is returned."))
(let [v (vertex 1 1 1)]
(is (= (check-kind-type v :vertex) v)
"If the check passes, the object is returned."))
(let [v (vertex 1 1 1)]
(is (= (check-kind-type v vertex? :vertex) v)
"If the check passes, the object is returned."))
(let [v "test"]
(is (thrown? IllegalArgumentException
(check-kind-type v :test))
"If the check doesn't pass, an exception is thrown."))
(let [v {:kind :test}]
(is (thrown? IllegalArgumentException
(check-kind-type v vertex? :vertex))
"If the check doesn't pass, an exception is thrown."))))
(deftest check-kind-type-seq-tests
(testing "Exception thrown if kind not as expected: sequence variant."
(let [v [{:kind :test} {:kind :test}]]
(is (= (check-kind-type-seq v :test) v)
"If the check passes, the object is returned."))
(let [v (list "another" "test")]
(is (= (check-kind-type-seq v java.lang.String) v)
"If the check passes, the object is returned."))
(let [v ["more" "test" "strings"]]
(is (= (check-kind-type-seq v string? java.lang.String) v)
"If the check passes, the object is returned."))
(let [v (list (vertex 1 1 1) (vertex 2 2 2) (vertex 3 3 3))]
(is (= (check-kind-type-seq v :vertex) v)
"If the check passes, the object is returned."))
(let [v (list (vertex 1 1 1))]
(is (= (check-kind-type-seq v vertex? :vertex) v)
"If the check passes, the object is returned."))
(let [v :test]
(is (thrown? IllegalArgumentException
(check-kind-type-seq v :test))
"If the arg isn't a sequence, an exception is thrown."))
(let [v (list (vertex 1 1 1) "test" (vertex 3 3 3))]
(is (thrown? IllegalArgumentException
(check-kind-type-seq v :test))
"If the check doesn't pass for any item, an exception is thrown."))
(let [v (list (vertex 1 1 1) (vertex 2 2 2) "test")]
(is (thrown? IllegalArgumentException
(check-kind-type-seq v vertex? :vertex))
"If the check doesn't pass, an exception is thrown."))))

148
test/cc/journeyman/walkmap/vertex_test.clj Normal file
View file

@ -0,0 +1,148 @@
(ns cc.journeyman.walkmap.vertex-test
(:require [clojure.test :refer :all]
[cc.journeyman.walkmap.utils :refer [=ish kind-type]]
[cc.journeyman.walkmap.vertex :refer [canonicalise ensure3d vertex
vertex= vertex* vertex?
within-box?]]))
(deftest vertex-equal-tests
(testing "Equality of vertices"
(is (vertex= (vertex 0 0 0) (vertex 0 0 0))
"should be equal")
(is (vertex= (vertex 0 0 0) (vertex 0.0000001 0 0))
"differences less than one part in a million should be ignored")
(is (false? (vertex= (vertex 0 0 0) (vertex 0 0 1)))
"should not be equal")
(is (thrown? IllegalArgumentException
(vertex= (vertex 0 0 0) "Not a vertex"))
"Exception should be thrown: not a vertex.")))
(deftest vertex-multiply-tests
(testing "multiplication of vertices"
(let [v (vertex (rand) (rand) (rand))
u (vertex 1 1 1)
v' (vertex* v u)]
(is (vertex= v v')
"Multiplication by {:x 1 :y 1 :z 1} should not change the vertex"))
(let [v (vertex 0.333333 0.25 0.2)
d (vertex 3 4 5)
v' (vertex* v d)
expected (vertex 1 1 1)]
(is (vertex= expected v')
"Multiplication by values other than {:x 1 :y 1 :z 1} should change
the vertex"))
(let [v (vertex 0.3333333 0.25 0.2)
d (vertex 3 4)
v' (vertex* v d)
expected (vertex 1 1 0.2)]
(is (vertex= expected v')
"Multiplication by a 2D vertex should not change `:z`"))
(let [v (vertex 0.3333333 0.25)
d (vertex 3 4)
v' (vertex* v d)
expected (vertex 1 1 0)]
(is (=ish 0 (:z v'))
"Multiplication of a 2D vertex should result in `:z` = zero"))
(is (thrown? IllegalArgumentException
(vertex* 3 (vertex 0 0 0)))
"Exception should be thrown: not a vertex (1st arg).")
(is (thrown? IllegalArgumentException
(vertex* (vertex 0 0 0) "Not a vertex"))
"Exception should be thrown: not a vertex (2nd arg).")))
(deftest canonicalise-tests
(testing "Canonicalisation of vertices."
(is (thrown? IllegalArgumentException
(canonicalise {:x "3" :y 4}))
"Exception should be thrown: not a number (`:x` coord).")
(is (thrown? IllegalArgumentException
(canonicalise {:x 3 :y :Jam}))
"Exception should be thrown: not a number (`:y` coord).")
(is (thrown? IllegalArgumentException
(canonicalise {:x 3 :y :4 :z {:foo "bar"}}))
"Exception should be thrown: not a number (`:z` coord).")
(let [v (canonicalise {:x 3 :y 4})]
(is
(= (:walkmap.id/id v)
(keyword (str "vert_" (:x v) "_" (:y v))))
"Vertex ids should match the expected pattern.")
(is (= (kind-type v) :vertex)
"A canonicalised 2d vertex should have the kind `:vertex`.")
(is (vertex? v)
"A canonicalised 2d vertex should be recognisable as a vertex."))
(let [v (canonicalise {:x 3 :y 4 :z 5})]
(is
(= (:walkmap.id/id v)
(keyword (str "vert_" (:x v) "_" (:y v) "_" (:z v))))
"Vertex ids should match the expected pattern.")
(is (= (kind-type v) :vertex)
"A canonicalised 3d vertex should have the kind `:vertex`.")
(is (vertex? v)
"A canonicalised 3d vertex should be recognisable as a vertex."))))
(deftest ensure3d-tests
(testing "Coercing vertices to three dimensions"
(let [v (vertex 2 3)
v' (ensure3d v)]
(is (zero? (:z v'))
"If not already 3d, and no `dflt` arg specified, `:z` should be zero."))
(let [v (vertex 2 3)
v' (ensure3d v 5)]
(is (= (:z v') 5)
"If not already 3d, and `dflt` arg specified, `:z` should be
equal to `dflt`."))
(let [v (vertex 2 3 4)
v' (ensure3d v 5)]
(is (= v v')
"If already 3d, should be unchanged."))))
(deftest within-box-tests
(testing "Checking whether a vertex is within a specified region: 2d."
(is (within-box? (vertex 2 2) (vertex 1 1) (vertex 3 3)) "Should be.")
(is (within-box? (vertex 1 3) (vertex 1 1) (vertex 3 3)) "Should be.")
(is (false? (within-box? (vertex 0 2) (vertex 1 1) (vertex 3 3)))
"Outside west")
(is (false? (within-box? (vertex 5 2) (vertex 1 1) (vertex 3 3)))
"Outside east")
(is (false? (within-box? (vertex 2 0) (vertex 1 1) (vertex 3 3)))
"Outside south")
(is (false? (within-box? (vertex 2 5) (vertex 1 1) (vertex 3 3)))
"Outside north")
(is (false? (within-box? (vertex 2 3.000001) (vertex 1 1) (vertex 3 3)))
"Very slightly outside north"))
(testing "Checking whether a vertex is within a specified region: 3d."
(is (within-box?
(vertex 2 2 2) (vertex 1 1 1) (vertex 3 3 3)) "Should be.")
(is (within-box?
(vertex 1 3 3) (vertex 1 1 1) (vertex 3 3 3)) "Should be.")
(is (false?
(within-box? (vertex 0 2 2) (vertex 1 1 1) (vertex 3 3 3)))
"Outside west")
(is (false?
(within-box? (vertex 5 2 2) (vertex 1 1 1) (vertex 3 3 3)))
"Outside east")
(is (false?
(within-box? (vertex 2 0 2) (vertex 1 1 1) (vertex 3 3 3)))
"Outside south")
(is (false?
(within-box? (vertex 2 5 2) (vertex 1 1 1) (vertex 3 3 3)))
"Outside north")
(is (false?
(within-box? (vertex 2 0 2) (vertex 1 1 1) (vertex 3 3 3)))
"Outside south")
(is (false?
(within-box? (vertex 2 2 0) (vertex 1 1 1) (vertex 3 3 3)))
"Outside down")
(is (false?
(within-box? (vertex 2 2 5) (vertex 1 1 1) (vertex 3 3 3)))
"Outside up"))
(testing "Bad arguments."
(is (thrown? IllegalArgumentException
(within-box? :fred (vertex 1 1 1) (vertex 3 3 3)))
"Not a vertex: `target`.")
(is (thrown? IllegalArgumentException
(within-box? (vertex 2 2 2) :ginny (vertex 3 3 3)))
"Not a vertex: `minv`.")
(is (thrown? IllegalArgumentException
(within-box? (vertex 2 2 2) (vertex 1 1 1) :henry))
"Not a vertex: `maxv`.")))