diff --git a/ChangeLog b/ChangeLog index 1888649cb..08bb24f6a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,6 @@ +2023-04-10 Rebecca Kelly + * Info/map-digraphs: add tool to generate GraphViz files describing the interconnections between maps and regions. + 2023-03-15 Daniel Hawkins * scorn/country/farmland_1, world/world_105_116: New map for one of the huts in the fields outside Scorn. diff --git a/Info/region-digraphs b/Info/region-digraphs new file mode 100755 index 000000000..761d18c94 --- /dev/null +++ b/Info/region-digraphs @@ -0,0 +1,198 @@ +#!/bin/sh +#_(:bootstrapper + DEPS=' {:deps {}} ';# {:deps {clj-time {:mvn/version "0.14.2"}}} + exec clj -Sdeps "$DEPS" "$0" "$@" + :end) + +; Usage: region-digraphs crossfire-maps/ output-dir/ +; Generate a GraphViz visualization of interconnections between +; Crossfire maps. Outputs a different digraph for each region. +; Generate images with: +; for i in *.dot; do neato -Tsvg $i > ${i%.dot}.svg; done +; To generate HTML server-side imagemaps, use: +; for i in *.dot; do neato -Timap $i > ${i%.dot}.map; done + +(ns region-digraphs + (:require [clojure.java.io :as jio] + [clojure.string :as string])) + +(defn is-map? + "Check if the given File is a crossfire map. It must exist, be a file, and start with the line 'arch map'" + [file] + (and + file + (.canRead file) + (.isFile file) + (-> file jio/reader line-seq first (= "arch map")))) + +(defn- field-extractor + [field-name] + (let [pattern (re-pattern (str "^" field-name " (.*)$"))] + (fn [line] + (get (re-find pattern line) 1)))) + +(def slaying-field (field-extractor "slaying")) +(def name-field (field-extractor "name")) +(def region-field (field-extractor "region")) + +(defn map-name-from-metadata + "Read the initial map arch from the contents and extract the human-readable name from it, if present. Nil otherwise." + [contents] + (->> contents + (take-while (partial not= "end")) + (some name-field))) + +(defn add-name + "Given a map and its definition, assoc the human-friendly map name. World map cells just get the region name to avoid hundreds of world_X_Y nodes, everything else gets the metadata name if possible and the file name if not." + [{:keys [path region] :as map} mapdef] + (let [name (or (map-name-from-metadata mapdef) + (.. path (getFileName) (toString)))] + (assoc map :name + (cond + (not (string/starts-with? name "world_")) name + :else (str "[region: " region "]"))))) + +(defn to-map-path + "Turn a [slaying] value into a canonical map path, or nil. In practice, this means: + - if it ends with .py, discard it, it's a script link and not a map link + - if it starts with /, resolve it relative to the repo root + - otherwise, resolve it relative to the origin map's containing directory + no attempt is made to check the validity of the path." + [{:keys [path]} root exit] + (let [exit-path (.toPath (jio/file exit))] + (cond + (string/ends-with? exit ".py") nil + (.isAbsolute exit-path) (.resolve + root + (.relativize (.toPath (jio/file "/")) + exit-path)) + :else (.. path (getParent) (resolve exit-path) (normalize))))) + +(defn list-exits + "Find all the *valid* exits in a mapdef. This just blindly grabs all the [slaying] values from the map and then shoves them through is-map? to just get the ones that point to actual maps that exist. + Returns a set of map paths." + [map-obj mapdef root] + (->> mapdef + (keep slaying-field) + (keep (partial to-map-path map-obj root)) + (filter #(is-map? (.toFile %))) + (into #{}))) + +(defn add-exits + "Read the mapdef and assoc the set of exit paths into the mapobj." + [map contents root] + (assoc map :exits + (list-exits map contents root))) + +(defn add-region + "Read the mapdef and assoc the region into the mapobj, or 'none' if no region is defined." + [map-obj mapdef] + (assoc map-obj :region + (or + (->> mapdef + (keep region-field) + first) + "none"))) + +(defn read-map + "Read in a map file and emit a structure of the form: + {:path canonical absolute path to the map, with / as the root of the map repo + :name name from map metadata, or bare filename if no name specified + :region region the map belongs to, if any + :exits set of map paths that this map has exits to + }" + [root file] + (let [contents (-> file slurp string/split-lines)] + (println "Reading: " (.toString (.relativize root (.toPath file)))) + (-> + {:path (.toPath file)} + (add-region contents) + (add-name contents) + (add-exits contents root)))) + +(defn exit-dest + "Generate an [exit-name, bidirectional?] pair for an exit leading from this-map to other-map. + Unidirectional links are generated unconditionally. Bidirectional links are generated only from the map with the name that sorts earlier." + [this-map other-map] + (cond + (not (-> other-map :exits (:path this-map))) [(:name other-map) false] + (< (compare (:name this-map) (:name other-map)) 0) [(:name other-map) true] + :else nil)) + +(defn resolve-exits + "Turn the map paths emitted by read-map into human readable exit names to feed to graphviz. Drops exits that lead to missing maps, and collapses all out-of-region exits into '[to region-name]'. + Returns a set of [name, bidi?] pairs where bidi? is true if the link is bidirectional." + [exits maps this-map] + (->> exits + (keep (fn [exit-path] + (let [other-map (maps (.toString exit-path))] + (cond + (nil? other-map) nil + (= (:name this-map) (:name other-map)) nil + (= (:region other-map) (:region this-map)) + (exit-dest this-map other-map) + :else [(str "[to " (:region other-map) "]") false])))) + (into #{}))) + +(defn resolve-all-exits + "Given a [path -> mapobj] map, turn the exits in each map into the name of the actual mapobj they refer to, or delete them if they do not resolve." + [maps] + (map (fn [[k v]] [k (update v :exits resolve-exits maps v)]) + maps)) + +(defn generate-edges + "Actually produce the graphviz source text for all the edges in a given region. Returns a seq of strings." + [maps] + (for [{:keys [name exits]} maps + [dst bidi?] exits] + (str \" name "\" -> \"" dst "\"" (when bidi? " [dir=both]")))) + +(defn map-nodes + "Return a seq of graphviz node declarations for all the maps in the given path->map map." + [maps] + (for [{:keys [name path]} maps] + (str \" name "\" [href=\"" path ".html\"]"))) + +(defn write-graph + "Generate a graphviz file for the given region and write it to dest." + [dest [region maps]] + (let [dest-file (jio/file (.toFile dest) (str region ".dot")) + edges (generate-edges maps)] + (println "Writing: " (.toString dest-file)) + (spit + dest-file + (str + "digraph crossfire_" region " {\n" + " concentrate=true\n" + " overlap=false\n" + " " + (string/join "\n " (map-nodes maps)) + " " + (string/join "\n " (sort edges)) + "\n}\n")))) + +(defn resolve-paths + [root [path map]] + [path (update map :path + (fn [path] + (str "/" (.toString (.relativize root path)))))]) + +(defn generate-digraphs + [source-dir dest-dir] + (let [source-dir (.toPath (jio/file source-dir)) + dest-dir (.toPath (jio/file dest-dir))] + (->> (file-seq (.toFile source-dir)) + ;; (take 1000) ; for testing + (filter is-map?) + (map (partial read-map source-dir)) + (map (juxt #(.toString (:path %)) identity)) + (into {}) + (resolve-all-exits) + (map (partial resolve-paths source-dir)) + (map second) + (group-by :region) + (run! (partial write-graph dest-dir))))) + +(apply generate-digraphs *command-line-args*) + +"All done!"