Add region-digraphs tool to generate GraphViz region layout files.

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.

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!"