Massive code clean-up, all tests still pass.
...but I'm still struggling to understand how it works and how I use it. Memo to self: document your code better.
This commit is contained in:
parent
156775fc79
commit
cb5041e684
|
|
@ -3,7 +3,6 @@
|
|||
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
|
||||
|
|
@ -149,7 +148,7 @@
|
|||
not an edge."
|
||||
([e1 e2]
|
||||
(intersection2d e1 e2 :x :y :z))
|
||||
([e1 e2 c1 c2 c3]
|
||||
([e1 e2 c1 c2 _c3]
|
||||
(if (and (edge? e1) (edge? e2))
|
||||
(when
|
||||
(overlaps2d? e1 e2) ;; relatively cheap check
|
||||
|
|
|
|||
|
|
@ -2,36 +2,36 @@
|
|||
"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]]
|
||||
(:require [cc.journeyman.walkmap.polygon :refer [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]]))
|
||||
[cc.journeyman.walkmap.tag :refer [tag]]
|
||||
[cc.journeyman.walkmap.vertex :refer [check-vertex vertex]]
|
||||
[cc.journeyman.walkmap.utils :refer [truncate]]
|
||||
[clojure.edn :as edn :only [read]]
|
||||
[clojure.java.io :refer [reader]]
|
||||
[taoensso.timbre :refer [error]])
|
||||
(:import [clojure.lang Keyword Map]
|
||||
[java.io PushbackReader]))
|
||||
|
||||
(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
|
||||
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->polygon cell (vertex 1 1 1)))
|
||||
([cell scale-vector]
|
||||
(t/tag
|
||||
(tag
|
||||
(assoc
|
||||
(merge
|
||||
cell
|
||||
(let [w (* (:x cell) (:x (v/check-vertex scale-vector)))
|
||||
(let [w (* (:x cell) (:x (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))))
|
||||
(rectangle
|
||||
(vertex s w z)
|
||||
(vertex n e z))))
|
||||
:walkmap.id/id
|
||||
(keyword (gensym "mw-cell")))
|
||||
(:state cell))))
|
||||
|
|
@ -42,23 +42,23 @@
|
|||
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]
|
||||
([^String filename]
|
||||
(load-microworld-edn filename :mw))
|
||||
([filename map-kind]
|
||||
([^String filename ^Keyword map-kind]
|
||||
(when-not
|
||||
(keyword? map-kind)
|
||||
(throw (IllegalArgumentException.
|
||||
(u/truncate
|
||||
(str "Must be a keyword: " (or map-kind "nil")) 80))))
|
||||
(truncate
|
||||
(format "Must be a keyword: %s." (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]
|
||||
([^String filename ^Keyword mapkind ^Map superstucture]
|
||||
(load-microworld-edn filename mapkind superstucture (vertex 1 1 1)))
|
||||
([^String filename ^Keyword _map-kind ^Map superstructure ^Map _scale-vertex]
|
||||
(let [mw (try
|
||||
(with-open [r (io/reader filename)]
|
||||
(edn/read (java.io.PushbackReader. r)))
|
||||
(with-open [r (reader filename)]
|
||||
(edn/read (PushbackReader. r)))
|
||||
(catch RuntimeException e
|
||||
(l/error "Error parsing edn file '%s': %s\n"
|
||||
(error "Error parsing edn file '%s': %s\n"
|
||||
filename (.getMessage e))))
|
||||
polys (reduce
|
||||
concat
|
||||
|
|
|
|||
|
|
@ -2,11 +2,9 @@
|
|||
"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]]
|
||||
(:require [cc.journeyman.walkmap.edge :as e]
|
||||
[cc.journeyman.walkmap.polygon :refer [polygon?]]
|
||||
[cc.journeyman.walkmap.utils :refer [check-kind-type check-kind-type-seq]]
|
||||
[cc.journeyman.walkmap.vertex :refer [check-vertices vertex?]]))
|
||||
|
||||
(defn path?
|
||||
|
|
|
|||
|
|
@ -139,7 +139,7 @@
|
|||
projection of this rectangle on that plane?"
|
||||
[vertex rectangle]
|
||||
(let [xo (sort-by :x (:vertices rectangle))
|
||||
yo (sort-by :x (:vertices rectangle))]
|
||||
yo (sort-by :y (:vertices rectangle))]
|
||||
(and
|
||||
(< (:x (first xo)) (:x vertex) (:x (last xo)))
|
||||
(< (:y (first yo)) (:y vertex) (:y (last yo))))))
|
||||
|
|
|
|||
|
|
@ -1,16 +1,11 @@
|
|||
(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]
|
||||
(:require [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?
|
||||
|
|
@ -91,7 +86,7 @@
|
|||
;; quite small XML files. So I've implemented my own solution.
|
||||
([file-name]
|
||||
(read-svg file-name nil))
|
||||
([file-name map-kind]
|
||||
([file-name _map-kind]
|
||||
(let [xml (x/parse (io/file file-name))
|
||||
paths (progeny xml #(= (:tag %) :path))]
|
||||
(remove nil? (map path-elt->path paths)))))
|
||||
|
|
|
|||
|
|
@ -1,16 +1,15 @@
|
|||
(ns cc.journeyman.walkmap.routing
|
||||
"Finding optimal routes to traverse a map."
|
||||
(:require [clojure.math.numeric-tower :as m :only [expt]]
|
||||
(:require [clojure.math.numeric-tower :refer [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]))
|
||||
[cc.journeyman.walkmap.tag :refer [tags]]
|
||||
[cc.journeyman.walkmap.vertex :as v]
|
||||
[search.core :refer [a*]]
|
||||
[taoensso.timbre :refer [debug]]))
|
||||
|
||||
;; 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.
|
||||
|
|
@ -37,6 +36,11 @@
|
|||
of traversals. Dynamic, because we will want to tune this."
|
||||
-2)
|
||||
|
||||
(def ^:dynamic *untraversable*
|
||||
"The set of all tags which may indicate that a polygon should not be
|
||||
traversed."
|
||||
#{:no-traversal})
|
||||
|
||||
(defn traversable?
|
||||
"True if this `object` is a polygon which can be considered as part of
|
||||
the walkmap."
|
||||
|
|
@ -44,7 +48,7 @@
|
|||
(and
|
||||
(q/polygon? object)
|
||||
(:centre object)
|
||||
(not (t/tagged? object :no-traversal))))
|
||||
(empty? (intersection (tags object) *untraversable*))))
|
||||
|
||||
(declare traversal-cost)
|
||||
|
||||
|
|
@ -64,7 +68,8 @@
|
|||
(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]
|
||||
[from to _s]
|
||||
(debug (format "barriers-crossed called with vertices\n\tfrom: %s\n\tto: %s" from to))
|
||||
;; TODO: implement
|
||||
'())
|
||||
|
||||
|
|
@ -74,7 +79,8 @@
|
|||
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]
|
||||
[barrier from to _s]
|
||||
(debug (format "crossing-penalty called with arguments\n\tbarrier: %s\n\tfrom: %s\n\tto: %s" barrier from to))
|
||||
;; TODO: implement
|
||||
0)
|
||||
|
||||
|
|
@ -83,7 +89,7 @@
|
|||
[edge]
|
||||
(let [g (:z (e/unit-vector edge))]
|
||||
(if (pos? g)
|
||||
(m/expt (inc g) *gradient-exponent*)
|
||||
(expt (inc g) *gradient-exponent*)
|
||||
1)))
|
||||
|
||||
;; (gradient-cost (e/edge (v/vertex 0 0 0) (v/vertex 0 1 0)))
|
||||
|
|
@ -112,7 +118,7 @@
|
|||
[from to s]
|
||||
(let [best (best-road from to s)]
|
||||
(when (:traversals best)
|
||||
(m/expt (:traversals best) *traversals-exponent*))))
|
||||
(expt (:traversals best) *traversals-exponent*))))
|
||||
|
||||
(defn traversal-cost
|
||||
"Return the traversal cost of the edge represented by the vertices `from`,
|
||||
|
|
@ -130,7 +136,7 @@
|
|||
(gradient-cost edge))
|
||||
(reduce +
|
||||
(map
|
||||
#(crossing-penalty [% from to s])
|
||||
#(crossing-penalty % from to s)
|
||||
(barriers-crossed from to s))))
|
||||
(or (road-bonus from to s) 1)))))
|
||||
|
||||
|
|
@ -177,10 +183,9 @@
|
|||
(let [r (s/nearest s target traversable? search-radius)]
|
||||
(when-not r (throw
|
||||
(Exception.
|
||||
(cs/join " " ["Unable to find walkable facet within"
|
||||
(format "Unable to find walkable facet within %s of %s"
|
||||
search-radius
|
||||
"of"
|
||||
target]))))
|
||||
target))))
|
||||
r))
|
||||
|
||||
(defn route
|
||||
|
|
|
|||
|
|
@ -1,19 +1,18 @@
|
|||
(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]
|
||||
(:require
|
||||
[cc.journeyman.walkmap.ocean :refer [ocean?]]
|
||||
[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))
|
||||
[cc.journeyman.walkmap.utils :refer [truncate]]
|
||||
[cc.journeyman.walkmap.vertex :as v]
|
||||
[clojure.lang.io :refer [input-stream]]
|
||||
[clojure.string :as s]
|
||||
[me.raynes.fs :refer [base-name split-ext]]
|
||||
[org.clojars.smee.binary.core :as b]
|
||||
[taoensso.timbre :refer [debug]])
|
||||
(:import [clojure.lang Keyword]))
|
||||
|
||||
(defn stl?
|
||||
"True if `o` is recogniseable as an STL structure. An STL structure must
|
||||
|
|
@ -64,13 +63,13 @@
|
|||
(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]
|
||||
([o ^Keyword map-kind]
|
||||
(canonicalise o map-kind (v/vertex 1 1 1)))
|
||||
([o map-kind scale-vertex]
|
||||
([o ^Keyword map-kind scale-vertex]
|
||||
(when-not
|
||||
(keyword? map-kind)
|
||||
(throw (IllegalArgumentException.
|
||||
(u/truncate (str "Must be a keyword: " (or map-kind "nil")) 80))))
|
||||
(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?`
|
||||
|
|
@ -92,13 +91,13 @@
|
|||
(:vertices o)
|
||||
map-kind))
|
||||
:facet map-kind)))]
|
||||
(if (o/ocean? f)
|
||||
(if (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
|
||||
(if (v/vertex? scale-vertex)
|
||||
(v/vertex* c scale-vertex)
|
||||
c))
|
||||
;; shouldn't happen
|
||||
|
|
@ -122,18 +121,14 @@
|
|||
|
||||
**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]
|
||||
([^String 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))))
|
||||
([^String filename ^Keyword map-kind]
|
||||
(decode-binary-stl filename map-kind nil))
|
||||
([filename mapkind superstucture]
|
||||
([^String filename ^Keyword 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)
|
||||
([^String filename ^Keyword map-kind superstructure scale-vertex]
|
||||
(let [in (input-stream filename)
|
||||
stl (canonicalise (b/decode binary-stl in) map-kind scale-vertex)]
|
||||
(if
|
||||
(map? superstructure)
|
||||
|
|
@ -175,12 +170,12 @@
|
|||
"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)]
|
||||
(let [b (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)
|
||||
(debug "Solid name is " solidname)
|
||||
(spit
|
||||
filename
|
||||
(stl->ascii stl solidname))))
|
||||
|
|
@ -190,7 +185,7 @@
|
|||
`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)]
|
||||
(let [[_ ext] (split-ext in-filename)]
|
||||
(binary-stl-to-ascii
|
||||
in-filename
|
||||
(str
|
||||
|
|
|
|||
|
|
@ -3,15 +3,16 @@
|
|||
(: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.path :as p]
|
||||
;; [cc.journeyman.walkmap.polygon :as q]
|
||||
[cc.journeyman.walkmap.utils :as u]
|
||||
[cc.journeyman.walkmap.vertex :as v]))
|
||||
[cc.journeyman.walkmap.vertex :as v])
|
||||
(:import [clojure.lang IFn Map]))
|
||||
|
||||
;; 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,
|
||||
;; 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.
|
||||
|
|
@ -53,7 +54,7 @@
|
|||
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]
|
||||
[^Map s ^Map o ^Map v]
|
||||
(if-not (v/vertex? o)
|
||||
(if (:walkmap.id/id o)
|
||||
(if (v/vertex? v)
|
||||
|
|
@ -161,9 +162,9 @@
|
|||
|
||||
1. `s` is not a map;
|
||||
2. `o` is not a recognisable walkmap object"
|
||||
([o]
|
||||
([^Map o]
|
||||
(store o {}))
|
||||
([o s]
|
||||
([^Map o ^Map s]
|
||||
(when-not (:walkmap.id/id o)
|
||||
(throw
|
||||
(IllegalArgumentException.
|
||||
|
|
@ -188,13 +189,13 @@
|
|||
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]
|
||||
([^Map s ^Map minv ^Map 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)
|
||||
#(v/within-box? % minv' maxv')
|
||||
(filter #(= (:kind %) :vertex) (vals s))))))
|
||||
|
||||
(defn nearest
|
||||
|
|
@ -205,7 +206,9 @@
|
|||
|
||||
WARNING: currently only returns objects which have a defined `:centre`
|
||||
(but most of the significant objects we have do)."
|
||||
[s target filter-fn radius]
|
||||
([^Map s ^Map target ^Number radius]
|
||||
(nearest s target :centre radius))
|
||||
([^Map s ^Map target ^IFn filter-fn ^Number radius]
|
||||
(let [minv (v/vertex
|
||||
(- (:x (v/check-vertex target)) radius)
|
||||
(- (:y target) radius) (- (or (:z target) 0) radius))
|
||||
|
|
@ -218,6 +221,8 @@
|
|||
(first
|
||||
(sort-by
|
||||
#(length (edge target (:centre %)))
|
||||
(filter
|
||||
filter-fn
|
||||
(filter
|
||||
:centre
|
||||
(map #(retrieve % s)
|
||||
|
|
@ -233,16 +238,16 @@
|
|||
(set
|
||||
(map
|
||||
:walkmap.id/id
|
||||
(search-vertices s minv maxv))))))))))))
|
||||
(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 vertex ^Map s]
|
||||
(map
|
||||
#(retrieve % s)
|
||||
(set (-> s :vertex-index (:walkmap.id/id (v/check-vertex vertex)) keys))))
|
||||
([vertex filter-fn s]
|
||||
([^Map vertex ^IFn filter-fn ^Map s]
|
||||
(filter
|
||||
filter-fn
|
||||
(touching vertex s))))
|
||||
|
|
@ -251,9 +256,9 @@
|
|||
"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]
|
||||
([^Map target ^Map s]
|
||||
(neighbours target identity s))
|
||||
([^Map target ^IFn filter-fn ^Map s]
|
||||
(remove
|
||||
#(= target %)
|
||||
(reduce
|
||||
|
|
@ -266,7 +271,7 @@
|
|||
"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]
|
||||
([^Map target ^Map s]
|
||||
(neighbour-ids target identity s))
|
||||
([target filter-fn s]
|
||||
([^Map target ^IFn filter-fn ^Map s]
|
||||
(map :walkmap.id/id (neighbours target filter-fn s))))
|
||||
|
|
|
|||
|
|
@ -2,16 +2,12 @@
|
|||
"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]
|
||||
(:require [clojure.string :as s]
|
||||
[dali.io :as neatly-folded-clock]
|
||||
[hiccup.core :refer [html]]
|
||||
[taoensso.timbre :as l :refer [info error spy]]
|
||||
[taoensso.timbre :refer [info]]
|
||||
[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?]]))
|
||||
[cc.journeyman.walkmap.stl :refer [decode-binary-stl]]))
|
||||
|
||||
(def ^:dynamic *preferred-svg-render*
|
||||
"Mainly for debugging dali; switch SVG renderer to use. Expected values:
|
||||
|
|
@ -88,7 +84,7 @@
|
|||
(map
|
||||
#(reduce max (map :y (:vertices %)))
|
||||
(:facets stl)))]
|
||||
(l/info "Generating SVG for " *preferred-svg-render* " renderer")
|
||||
(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)
|
||||
|
|
@ -102,7 +98,7 @@
|
|||
(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")
|
||||
(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))
|
||||
|
|
|
|||
|
|
@ -4,7 +4,8 @@
|
|||
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]]))
|
||||
[cc.journeyman.walkmap.utils :refer [kind-type]])
|
||||
(:import [clojure.lang Map]))
|
||||
|
||||
(defn tagged?
|
||||
"True if this `object` is tagged with each of these `tags`. It is an error
|
||||
|
|
@ -12,10 +13,7 @@
|
|||
|
||||
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)))))
|
||||
[^Map object & tags]
|
||||
(let [tags' (flatten tags)]
|
||||
(when-not (every? keyword? tags')
|
||||
(throw (IllegalArgumentException.
|
||||
|
|
@ -35,11 +33,8 @@
|
|||
|
||||
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]
|
||||
[^Map 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.
|
||||
|
|
@ -57,10 +52,7 @@
|
|||
|
||||
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)))))
|
||||
[^Map object & tags]
|
||||
(let [tags' (flatten tags)]
|
||||
(when-not (every? keyword? tags')
|
||||
(throw (IllegalArgumentException.
|
||||
|
|
|
|||
|
|
@ -3,16 +3,16 @@
|
|||
(:require [clojure.edn :as edn :only [read]]
|
||||
[clojure.java.io :as io]
|
||||
[clojure.math.numeric-tower :as m]
|
||||
[clojure.set :refer [union]]
|
||||
[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)
|
||||
(let [tags (apply union (map :cc.journeyman.walkmap.tag/tags vals))]
|
||||
(assoc (apply merge-with deep-merge vals) :cc.journeyman.walkmap.tag/tags tags))
|
||||
(last vals)))
|
||||
|
||||
(defn truncate
|
||||
|
|
@ -27,20 +27,20 @@
|
|||
"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\"."
|
||||
messages, 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]
|
||||
([^Number n1 ^Number 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]
|
||||
([^Number n1 ^Number n2 ^Number tolerance]
|
||||
(if (and (number? n1) (number? n2))
|
||||
(< (m/abs (- n1 n2)) tolerance)
|
||||
(= n1 n2))))
|
||||
|
|
|
|||
Loading…
Reference in a new issue