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

Work on test coverage. Tedious, but useful.

Browse source
This commit is contained in:
Simon Brooke 2020-05-31 17:00:02 +01:00
parent e07dc7098c
commit 5328e89c96
No known key found for this signature in database
GPG key ID: A7A4F18D1D4DF987
39 changed files with 1608 additions and 982 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/walkmap/edge.clj
View file

@ -3,7 +3,8 @@
An edge is a line segment having just a start and an end, with no intervening
nodes."
(:require [clojure.math.numeric-tower :as m]
[walkmap.vertex :refer [ensure2d ensure3d vertex vertex= vertex?]]))
[walkmap.utils :as u]
[walkmap.vertex :refer [canonicalise ensure2d ensure3d vertex vertex= vertex?]]))
(defn edge
"Return an edge between vertices `v1` and `v2`."
@ -51,13 +52,14 @@
[e]
(let [e' {:start (ensure3d (:start e)) :end (ensure3d (:end e))}
l (length e')]
(reduce
merge
{}
(map
(fn [k]
{k (/ (- (k (:end e')) (k (:start e'))) l)})
[:x :y :z]))))
(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."

5
src/walkmap/ocean.clj
View file

@ -1,5 +1,6 @@
(ns walkmap.ocean
"Deal with (specifically, at this stage, cull) ocean areas")
"Deal with (specifically, at this stage, cull) ocean areas"
(:require [walkmap.utils :refer [=ish]]))
(def ^:dynamic *sea-level*
"The sea level on heightmaps we're currently handling. If characters are to
@ -14,7 +15,7 @@
"Of a `facet`, is the altitude of every vertice equal to `*sea-level*`?"
[facet]
(every?
#(= % *sea-level*)
#(=ish % *sea-level*)
(map :z (:vertices facet))))
(defn cull-ocean-facets

64
src/walkmap/path.clj
View file

@ -4,8 +4,9 @@
feature, where such features specifically include watercourses."
(:require [clojure.string :as s]
[walkmap.edge :as e]
[walkmap.polygon :refer [polygon?]]
[walkmap.utils :refer [kind-type]]
[walkmap.polygon :refer [check-polygon polygon?]]
[walkmap.tag :refer [tag tags]]
[walkmap.utils :refer [check-kind-type check-kind-type-seq kind-type]]
[walkmap.vertex :refer [vertex?]]))
(defn path?
@ -17,7 +18,7 @@
[v (:vertices o)]
(and
(seq? v)
(> (count v) 2)
(> (count v) 1)
(every? vertex? v)
(:walkmap.id/id o)
(or (nil? (:kind o)) (= (:kind o) :path)))))
@ -25,12 +26,25 @@
(defn path
"Return a path constructed from these `vertices`."
[& vertices]
(when-not (every? vertex? vertices)
(throw (IllegalArgumentException.
(str
"Each item on path must be a vertex: "
(s/join " " (map kind-type (remove vertex? vertices)))))))
{:vertices vertices :walkmap.id/id (keyword (gensym "path")) :kind :path})
(check-kind-type-seq vertices vertex? :vertex)
(if
(> (count 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
@ -40,8 +54,8 @@
If `o` is not a polygon, will throw an exception."
[o]
(when-not (polygon? o)
(throw (IllegalArgumentException. (str "Not a polygon: " (kind-type 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.
@ -55,18 +69,17 @@
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) (rest o))
(path->edges (rest o))))
(path? o)
(path->edges (:vertices o))
(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!"))))
@ -78,7 +91,4 @@
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]
(if
(path? path)
(reduce + (map e/length (path->edges path)))
(throw (IllegalArgumentException. "Not a path!"))))
(reduce + (map e/length (path->edges (check-path path)))))

52
src/walkmap/polygon.clj
View file

@ -3,8 +3,8 @@
(:require [clojure.string :as s]
[walkmap.edge :as e]
[walkmap.tag :as t]
[walkmap.utils :refer [kind-type]]
[walkmap.vertex :refer [vertex vertex?]]))
[walkmap.utils :refer [check-kind-type check-kind-type-seq kind-type]]
[walkmap.vertex :refer [check-vertices vertex vertex?]]))
(defn polygon?
"True if `o` satisfies the conditions for a polygon. A polygon shall be a
@ -20,6 +20,20 @@
(: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."
@ -28,24 +42,26 @@
(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]
(when-not (every? vertex? vertices)
(throw (IllegalArgumentException.
(str
"Each item on vertices must be a vertex: "
(s/join " " (map kind-type (remove vertex? vertices)))))))
{:vertices vertices :walkmap.id/id (keyword (gensym "poly")) :kind :polygon})
[& vertices]
{:vertices (check-vertices vertices)
:walkmap.id/id (keyword (gensym "poly"))
:kind :polygon})
(defn gradient
"Return a polygon like `triangle` but with a key `:gradient` whose value is a
unit vector representing the gradient across `triangle`."
[triangle]
(when-not (triangle? triangle)
(throw (IllegalArgumentException.
(s/join " " ["Must be a triangle:" (kind-type triangle)]))))
(let [order (sort #(max (:z %1) (:z %2)) (:vertices 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)))))
@ -57,10 +73,7 @@
`walkmap.polygon`. It is an error (although no exception is currently
thrown) if the object past is not a triangular polygon."
[facet]
(when-not (triangle? facet)
(throw (IllegalArgumentException.
(s/join " " ["Must be a triangle:" (kind-type facet)]))))
(let [vs (:vertices facet)
(let [vs (:vertices (check-triangle facet))
v1 (first vs)
opposite (e/edge (nth vs 1) (nth vs 2))
oc (e/centre opposite)]
@ -74,10 +87,7 @@
(defn centre
[poly]
(when-not (polygon? poly)
(throw (IllegalArgumentException.
(s/join " " ["Must be a polygon:" (kind-type poly)]))))
(case (count (:vertices poly))
(case (count (:vertices (check-polygon poly)))
3 (triangle-centre poly)
;; else
(throw

60
src/walkmap/utils.clj
View file

@ -1,6 +1,7 @@
(ns walkmap.utils
"Miscellaneous utility functions."
(:require [clojure.math.numeric-tower :as m]))
(:require [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."
@ -41,3 +42,60 @@
(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)))

69
src/walkmap/vertex.clj
View file

@ -6,7 +6,7 @@
(:require [clojure.math.numeric-tower :as m]
[clojure.string :as s]
[taoensso.timbre :as l]
[walkmap.utils :refer [=ish kind-type truncate]]))
[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
@ -48,31 +48,43 @@
(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`."
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]
(if
(and (vertex? v1) (vertex? v2))
(let [f (fn [v1 v2 coord]
(* (or (coord v1) 0)
;; one here is deliberate!
(or (coord v2) 1)))]
(assoc v1 :x (f v1 v2 :x)
:y (f v1 v2 :y)
:z (f v1 v2 :z)))
(do (l/warn
(s/join
" "
["in `vertex-multiply`, both must be vectors. v1:" v1 "v2:" v2]))
v1)))
(check-vertex v1)
(check-vertex v2)
(let [f (fn [v1 v2 coord]
(* (or (coord v1) 0)
;; one here is deliberate!
(or (coord v2) 1)))]
(assoc v1 :x (f v1 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
@ -83,7 +95,7 @@
(let [v {:x x :y y :kind :vertex}]
(assoc v :walkmap.id/id (vertex-key v))))
([x y z]
(let [v (assoc (vertex x y) :z z)]
(let [v {:x x :y y :z z :kind :vertex}]
(assoc v :walkmap.id/id (vertex-key v)))))
(defn canonicalise
@ -106,7 +118,7 @@
(def ensure3d
"Given a vertex `o`, if `o` has a `:z` value, just return `o`; otherwise
return a vertex like `o` but having thie `dflt` value as the value of its
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."
@ -115,33 +127,22 @@
([o]
(ensure3d o 0.0))
([o dflt]
(cond
(not (vertex? o)) (throw
(IllegalArgumentException.
(truncate (str "Not a vertex: " (or o "nil")) 80)))
(:z o) o
:else (assoc o :z 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]
(if
(vertex? o)
(assoc o :z 0.0)
(throw
(IllegalArgumentException.
(truncate (str "Not a vertex: " (or o "nil")) 80)))))))
(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]
(when-not (and (vertex? target) (vertex? minv) (vertex? maxv))
(throw (IllegalArgumentException.
(s/join " " ["Arguments to `within-box?` must be vertices:"
(map kind-type [target minv maxv])]))))
(check-vertices [target minv maxv])
(every?
(map
#(< (% minv) (or (% target) 0) (% maxv))