refactor: split tex modules
This commit is contained in:
@@ -9,7 +9,10 @@
|
||||
[net.deertopia.doerg.html :as doerg-html]
|
||||
[hiccup2.core :as hiccup]
|
||||
[clojure.pprint]
|
||||
#_
|
||||
[net.deertopia.doerg.tex :as tex]
|
||||
[net.deertopia.doerg.tex.native :as tex-native]
|
||||
[net.deertopia.doerg.tex.temml :as tex-temml]
|
||||
[clojure.zip :as z]
|
||||
[babashka.fs :as fs]))
|
||||
|
||||
@@ -58,7 +61,7 @@
|
||||
(defn org-document
|
||||
"Recursively render an Org-mode document to Hiccup."
|
||||
[doc]
|
||||
(tex/binding-temml-worker
|
||||
(tex-temml/binding-worker
|
||||
(let [rendered (-> doc gather-footnotes render-tex-snippets
|
||||
org-element-recursive)]
|
||||
[:html
|
||||
@@ -173,11 +176,11 @@
|
||||
(let [rendered-snippets
|
||||
(delay (->> @promises
|
||||
(map #(-> % :node :value))
|
||||
(apply tex/render-xelatex svg-dir)))]
|
||||
(apply tex-native/render svg-dir)))]
|
||||
(doseq [{:keys [promise node]} @promises]
|
||||
(try (let [{:keys [value]} node
|
||||
temml (tex/render-temml value)]
|
||||
(if (tex/erroneous-temml-output? temml)
|
||||
temml (tex-temml/render value)]
|
||||
(if (tex-temml/erroneous-output? temml)
|
||||
(let [tex (get @rendered-snippets value)]
|
||||
(if (:errors tex)
|
||||
(deliver promise (hiccup/raw temml))
|
||||
|
||||
@@ -1,220 +1,4 @@
|
||||
(ns net.deertopia.doerg.tex
|
||||
(:require [babashka.process :as p]
|
||||
[net.deertopia.doerg.common :as common]
|
||||
[clj-cbor.core :as cbor]
|
||||
[clojure.java.io :as io]
|
||||
[clojure.string :as str]
|
||||
[clojure.tools.logging :as l]
|
||||
[babashka.fs :as fs])
|
||||
(:import (java.io ByteArrayOutputStream)))
|
||||
|
||||
;;; XeLaTeX
|
||||
|
||||
(def ^:private scale-divisor 66873.46948423679)
|
||||
|
||||
(def ^:private font-size 10)
|
||||
|
||||
(def ^:private tightpage-regexp
|
||||
#"Preview: Tightpage (-?\d+) *(-?\d+) *(-?\d+) *(-?\d+)")
|
||||
|
||||
(def ^:private preview-start-regexp
|
||||
#"! Preview: Snippet (\d+) started.")
|
||||
|
||||
(def ^:private preview-end-regexp
|
||||
#"(?:^Preview: Tightpage.*$)?\n! Preview: Snippet (\d+) ended.\((\d+)\+(\d+)x(\d+)\)")
|
||||
|
||||
(defn- invoke [extra-opts & args]
|
||||
(let [namespace (or (::ns extra-opts)
|
||||
(first args))
|
||||
out-bytes (ByteArrayOutputStream.)
|
||||
out-stream (common/tee-output-stream
|
||||
out-bytes
|
||||
(l/log-stream :info (str namespace "/out")))
|
||||
err-stream (l/log-stream :info (str namespace "/err"))
|
||||
opts (merge extra-opts
|
||||
{:out out-stream :err err-stream :continue true
|
||||
:shutdown p/destroy-tree
|
||||
:pre-start-fn (fn [{:keys [cmd]}]
|
||||
(l/infof "$ %s"
|
||||
(str/join " " cmd)))
|
||||
:exit-fn (fn [{:keys [cmd exit]}]
|
||||
(l/infof "%s exited w/ status %d"
|
||||
(first cmd) exit))})
|
||||
r (apply p/shell opts args)
|
||||
out (.toString out-bytes)]
|
||||
(-> r
|
||||
(assoc ::out out))))
|
||||
|
||||
(defn- parse-tightpage [xelatex-out]
|
||||
(->> (re-find tightpage-regexp xelatex-out)
|
||||
(drop 1)
|
||||
(map parse-long)))
|
||||
|
||||
(defn- snippet-dimensions [[tp1 tp2 tp3 tp4] [d1 d2 d3]]
|
||||
(let [depth (/ (- d2 tp2) scale-divisor font-size)]
|
||||
{:depth depth
|
||||
:height (+ depth
|
||||
(/ (+ d1 tp4)
|
||||
scale-divisor
|
||||
font-size))
|
||||
:width (/ (+ d3 tp3 (- tp2))
|
||||
scale-divisor
|
||||
font-size)}))
|
||||
|
||||
(defn- parse-xelatex-output [out]
|
||||
(let [tightpage-info (parse-tightpage out)
|
||||
m-start (re-matcher preview-start-regexp out)
|
||||
m-end (re-matcher preview-end-regexp out)]
|
||||
(loop [acc []]
|
||||
(if-some [[_ snippet-ix] (re-find m-start)]
|
||||
(let [r (re-find m-end)
|
||||
[_ snippet-ix* _ _ _] r
|
||||
dimensional-info (->> r (drop 2) (map parse-long))
|
||||
errors (-> out
|
||||
(subs (.end m-start) (.start m-end))
|
||||
(str/replace-first #"[^!]*" "")
|
||||
str/trim)]
|
||||
(assert (= snippet-ix snippet-ix*))
|
||||
(recur (conj acc (-> (snippet-dimensions
|
||||
tightpage-info dimensional-info)
|
||||
(assoc :errors (if (empty? errors)
|
||||
nil
|
||||
errors))))))
|
||||
acc))))
|
||||
|
||||
(defn- invoke-xelatex [& {:keys [file output-dir]}]
|
||||
(invoke
|
||||
{:dir output-dir}
|
||||
"xelatex" "-no-pdf" "-interaction" "nonstopmode"
|
||||
"-output-directory" output-dir file))
|
||||
|
||||
;; dvisvgm --page=1- --optimize --clipjoin --relative --no-fonts -v3 --message='processing page {?pageno}: output written to {?svgpath}' --bbox=preview -o %B-%%9p.svg %f
|
||||
|
||||
(defn- invoke-dvisvgm [& {:keys [file output-dir]}]
|
||||
(invoke
|
||||
{:dir output-dir}
|
||||
"dvisvgm" "--page=1-" "--optimize" "--clipjoin"
|
||||
"--relative" "--no-fonts" "-v3"
|
||||
"--message=processing page {?pageno}: output written to {?svgpath}"
|
||||
"--bbox=preview" "-o" "%9p.svg" file))
|
||||
|
||||
(defn- snippet-file-names
|
||||
"Return a map of TeX snippets (as strings, including the math
|
||||
delimiters) to file names as would be output by
|
||||
`invoke-dvisvgm`. The returned file names are relative to dvisvgm's
|
||||
output directory."
|
||||
[snippets]
|
||||
(let [svgs (for [i (range)]
|
||||
(format "%09d.svg" i))]
|
||||
(zipmap (reverse snippets) svgs)))
|
||||
|
||||
(defn- instantiate-preview-template [snippets]
|
||||
(let [contents (->> (for [s snippets]
|
||||
(format "\\begin{preview}\n%s\n\\end{preview}" s))
|
||||
(str/join "\n"))]
|
||||
(-> (io/resource "net/deertopia/doerg/preview-template.tex")
|
||||
slurp
|
||||
(str/replace-first "% {{contents}}" contents))))
|
||||
|
||||
(defn render-xelatex
|
||||
"Render a collection of `snippets` to SVGs in `output-dir` using
|
||||
XeLaTeX and dvisvgm. Returns a map whose keys are `snippets` and
|
||||
whose values are maps containing dimensional info, a string of
|
||||
errors output by XeLaTeX, and the path to the generated SVG
|
||||
file. Math delimiters are *not* implicitly added to each snippet."
|
||||
[output-dir & snippets]
|
||||
(fs/with-temp-dir [dir {:prefix "doerg-xelatex"}]
|
||||
(let [preview-tex (fs/file dir "preview.tex")
|
||||
preview-xdv (fs/file dir "preview.xdv")
|
||||
distinct-snippets (distinct snippets)]
|
||||
(fs/create-dirs output-dir)
|
||||
(->> (instantiate-preview-template distinct-snippets)
|
||||
(spit preview-tex))
|
||||
(let [dimensions (-> (invoke-xelatex :output-dir dir :file preview-tex)
|
||||
::out parse-xelatex-output)
|
||||
_ (invoke-dvisvgm :output-dir output-dir :file preview-xdv)]
|
||||
;; Adorn each snippet with dimensions and errors parsed from
|
||||
;; XeLaTeX's output, and the paths to SVG files generated by
|
||||
;; dvisvgm.
|
||||
(assert (= (count distinct-snippets) (count dimensions)))
|
||||
(->> (map (fn [ix snippet dimensions]
|
||||
{snippet
|
||||
(-> dimensions
|
||||
(assoc
|
||||
:file (fs/file output-dir
|
||||
(format "%09d.svg" (inc ix)))))})
|
||||
(range)
|
||||
distinct-snippets
|
||||
dimensions)
|
||||
(into {})))
|
||||
#_
|
||||
(do (when (fs/exists? "/tmp/doerg-tex-test") ; For debugging
|
||||
(fs/delete-tree "/tmp/doerg-tex-test"))
|
||||
(fs/copy-tree dir "/tmp/doerg-tex-test")))))
|
||||
|
||||
(comment
|
||||
(render-xelatex "/tmp/doerg-tex-svgs"
|
||||
"\\(c = \\sqrt{x^2 + y^2}\\)"
|
||||
"\\(x\\)" "\\(y\\)" "\\(x\\)"
|
||||
"\\(\\undefinedcommandlol\\)"))
|
||||
|
||||
|
||||
;;; Temml
|
||||
|
||||
(def ^:dynamic *temml-worker-timeout-duration*
|
||||
"Number of milliseconds to wait before killing the external Uniorg
|
||||
process."
|
||||
(* 10 1000))
|
||||
|
||||
(def ^:dynamic *temml-worker*)
|
||||
|
||||
(defn temml-worker [& {:keys [preamble]}]
|
||||
(p/process
|
||||
{:shutdown p/destroy-tree
|
||||
:err (l/log-stream :info "temml/err")}
|
||||
#_"doerg-tex"
|
||||
"./doerg-tex/index.js"
|
||||
"--preamble"
|
||||
"resources/net/deertopia/doerg/prelude.tex"))
|
||||
|
||||
(defn close-temml-worker [tw]
|
||||
(.close (:in tw)))
|
||||
|
||||
(defmacro with-temml-worker [tw & body]
|
||||
`(let [~tw (temml-worker)]
|
||||
(try
|
||||
(do ~@body)
|
||||
(finally
|
||||
(close-temml-worker ~tw)
|
||||
(p/destroy-tree ~tw)))))
|
||||
|
||||
(defmacro binding-temml-worker [& body]
|
||||
`(binding [*temml-worker* (temml-worker)]
|
||||
(try
|
||||
~@body
|
||||
(finally
|
||||
(close-temml-worker *temml-worker*)))))
|
||||
|
||||
(defn command-temml-worker [x]
|
||||
(cbor/encode cbor/default-codec (:in *temml-worker*) x)
|
||||
(.flush (:in *temml-worker*))
|
||||
(cbor/decode cbor/default-codec (:out *temml-worker*)))
|
||||
|
||||
(defn render-temml-inline [s]
|
||||
(command-temml-worker s))
|
||||
|
||||
(defn render-temml-display [s]
|
||||
(command-temml-worker [s]))
|
||||
|
||||
(defn render-temml [s]
|
||||
(if-let [[_ inner] (re-matches #"(?s)\\[(.*)\\]" s)]
|
||||
(render-temml-display inner)
|
||||
(if (re-matches #"(?s)\\begin\{.+?}(.*?)\\end\{.+?}" s)
|
||||
(render-temml-display s)
|
||||
(if-let [[_ inner] (re-matches #"(?s)\\\((.*)\\\)" s)]
|
||||
(render-temml-inline inner)
|
||||
(throw (ex-info "weird" {:snippet s}))))))
|
||||
|
||||
;; hackky....
|
||||
(defn erroneous-temml-output? [s]
|
||||
(re-find #"(#b22222|temml-error)" s))
|
||||
(:require [net.deertopia.doerg.tex.native :as native]
|
||||
[net.deertopia.doerg.tex.temml :as temml]
|
||||
[babashka.fs :as fs]))
|
||||
|
||||
154
doerg/src/net/deertopia/doerg/tex/native.clj
Normal file
154
doerg/src/net/deertopia/doerg/tex/native.clj
Normal file
@@ -0,0 +1,154 @@
|
||||
(ns net.deertopia.doerg.tex.native
|
||||
"Shelling out to (Xe)LaTeX and dvisvgm. Much magic borrowed from
|
||||
the org-latex-preview package for Emacs."
|
||||
(:require [babashka.process :as p]
|
||||
[net.deertopia.doerg.common :as common]
|
||||
[clojure.java.io :as io]
|
||||
[clojure.string :as str]
|
||||
[clojure.tools.logging :as l]
|
||||
[babashka.fs :as fs])
|
||||
(:import (java.io ByteArrayOutputStream)))
|
||||
|
||||
(def ^:private scale-divisor 66873.46948423679)
|
||||
|
||||
(def ^:private font-size 10)
|
||||
|
||||
(def ^:private tightpage-regexp
|
||||
#"Preview: Tightpage (-?\d+) *(-?\d+) *(-?\d+) *(-?\d+)")
|
||||
|
||||
(def ^:private preview-start-regexp
|
||||
#"! Preview: Snippet (\d+) started.")
|
||||
|
||||
(def ^:private preview-end-regexp
|
||||
#"(?:^Preview: Tightpage.*$)?\n! Preview: Snippet (\d+) ended.\((\d+)\+(\d+)x(\d+)\)")
|
||||
|
||||
(defn- invoke [extra-opts & args]
|
||||
(let [namespace (or (::ns extra-opts) (first args))
|
||||
out-bytes (ByteArrayOutputStream.)
|
||||
out-stream (common/tee-output-stream
|
||||
out-bytes
|
||||
(l/log-stream :info (str namespace "/out")))
|
||||
err-stream (l/log-stream :info (str namespace "/err"))
|
||||
opts (merge extra-opts
|
||||
{:out out-stream :err err-stream :continue true
|
||||
:shutdown p/destroy-tree
|
||||
:pre-start-fn (fn [{:keys [cmd]}]
|
||||
(l/infof "$ %s"
|
||||
(str/join " " cmd)))
|
||||
:exit-fn (fn [{:keys [cmd exit]}]
|
||||
(l/infof "%s exited w/ status %d"
|
||||
(first cmd) exit))})
|
||||
r (apply p/shell opts args)
|
||||
out (.toString out-bytes)]
|
||||
(-> r
|
||||
(assoc ::out out))))
|
||||
|
||||
(defn- parse-tightpage [latex-out]
|
||||
(->> (re-find tightpage-regexp latex-out)
|
||||
(drop 1)
|
||||
(map parse-long)))
|
||||
|
||||
(defn- compute-geometry [[tp1 tp2 tp3 tp4] [d1 d2 d3]]
|
||||
(let [depth (/ (- d2 tp2) scale-divisor font-size)]
|
||||
{:depth depth
|
||||
:height (+ depth
|
||||
(/ (+ d1 tp4)
|
||||
scale-divisor
|
||||
font-size))
|
||||
:width (/ (+ d3 tp3 (- tp2))
|
||||
scale-divisor
|
||||
font-size)}))
|
||||
|
||||
(defn- parse-latex-output [out]
|
||||
(let [tightpage-info (parse-tightpage out)
|
||||
m-start (re-matcher preview-start-regexp out)
|
||||
m-end (re-matcher preview-end-regexp out)]
|
||||
(loop [acc []]
|
||||
(if-some [[_ snippet-ix] (re-find m-start)]
|
||||
(let [r (re-find m-end)
|
||||
[_ snippet-ix* _ _ _] r
|
||||
dimensional-info (->> r (drop 2) (map parse-long))
|
||||
errors (-> out
|
||||
(subs (.end m-start) (.start m-end))
|
||||
(str/replace-first #"[^!]*" "")
|
||||
str/trim)]
|
||||
(assert (= snippet-ix snippet-ix*))
|
||||
(recur (conj acc (-> (compute-geometry
|
||||
tightpage-info dimensional-info)
|
||||
(assoc :errors (if (empty? errors)
|
||||
nil
|
||||
errors))))))
|
||||
acc))))
|
||||
|
||||
(defn- invoke-latex [& {:keys [file output-dir latex]
|
||||
:or {latex "xelatex"}}]
|
||||
(invoke
|
||||
{:dir output-dir}
|
||||
latex "-no-pdf" "-interaction" "nonstopmode"
|
||||
"-output-directory" output-dir file))
|
||||
|
||||
(defn- invoke-dvisvgm [& {:keys [file output-dir]}]
|
||||
(invoke
|
||||
{:dir output-dir}
|
||||
"dvisvgm" "--page=1-" "--optimize" "--clipjoin"
|
||||
"--relative" "--no-fonts" "-v3"
|
||||
"--message=processing page {?pageno}: output written to {?svgpath}"
|
||||
"--bbox=preview" "-o" "%9p.svg" file))
|
||||
|
||||
(defn- snippet-file-names
|
||||
"Return a map of TeX snippets (as strings, including the math
|
||||
delimiters) to file names as would be output by
|
||||
`invoke-dvisvgm`. The returned file names are relative to dvisvgm's
|
||||
output directory."
|
||||
[snippets]
|
||||
(let [svgs (for [i (range)]
|
||||
(format "%09d.svg" i))]
|
||||
(zipmap (reverse snippets) svgs)))
|
||||
|
||||
(defn- instantiate-preview-template [snippets]
|
||||
(let [contents (->> (for [s snippets]
|
||||
(format "\\begin{preview}\n%s\n\\end{preview}" s))
|
||||
(str/join "\n"))]
|
||||
(-> (io/resource "net/deertopia/doerg/preview-template.tex")
|
||||
slurp
|
||||
(str/replace-first "% {{contents}}" contents))))
|
||||
|
||||
(defn render
|
||||
"Render a collection of `snippets` to SVGs in `output-dir` using a
|
||||
LaTeX engine (XeLaTeX at the moment) and dvisvgm. Returns a map
|
||||
whose keys are `snippets` and whose values are maps containing
|
||||
geometry info, a string of errors output by LaTeX, and the path to
|
||||
the generated SVG file. Math delimiters are *not* implicitly added
|
||||
to each snippet."
|
||||
[output-dir & snippets]
|
||||
(fs/with-temp-dir [dir {:prefix "doerg-latex"}]
|
||||
(let [preview-tex (fs/file dir "preview.tex")
|
||||
preview-xdv (fs/file dir "preview.xdv")
|
||||
distinct-snippets (distinct snippets)]
|
||||
(fs/create-dirs output-dir)
|
||||
(->> (instantiate-preview-template distinct-snippets)
|
||||
(spit preview-tex))
|
||||
(let [dimensions (-> (invoke-latex :output-dir dir :file preview-tex)
|
||||
::out parse-latex-output)
|
||||
_ (invoke-dvisvgm :output-dir output-dir :file preview-xdv)]
|
||||
;; Adorn each snippet with dimensions and errors parsed from
|
||||
;; LaTeX's output, and the paths to SVG files generated by
|
||||
;; dvisvgm.
|
||||
(assert (= (count distinct-snippets) (count dimensions)))
|
||||
(->> (map (fn [ix snippet dimensions]
|
||||
{snippet
|
||||
(-> dimensions
|
||||
(assoc
|
||||
:file (fs/file output-dir
|
||||
(format "%09d.svg" (inc ix)))))})
|
||||
(range)
|
||||
distinct-snippets
|
||||
dimensions)
|
||||
(into {}))))))
|
||||
|
||||
(comment
|
||||
(render "/tmp/doerg-tex-svgs"
|
||||
"\\(c = \\sqrt{x^2 + y^2}\\)"
|
||||
"\\(x\\)" "\\(y\\)" "\\(x\\)"
|
||||
"\\(\\undefinedcommandlol\\)"))
|
||||
|
||||
67
doerg/src/net/deertopia/doerg/tex/temml.clj
Normal file
67
doerg/src/net/deertopia/doerg/tex/temml.clj
Normal file
@@ -0,0 +1,67 @@
|
||||
(ns net.deertopia.doerg.tex.temml
|
||||
(:require [babashka.process :as p]
|
||||
[net.deertopia.doerg.common :as common]
|
||||
[clj-cbor.core :as cbor]
|
||||
[clojure.java.io :as io]
|
||||
[clojure.string :as str]
|
||||
[clojure.tools.logging :as l]
|
||||
[babashka.fs :as fs])
|
||||
(:import (java.io ByteArrayOutputStream)))
|
||||
|
||||
(def ^:dynamic *worker-timeout-duration*
|
||||
"Number of milliseconds to wait before killing the external Uniorg
|
||||
process."
|
||||
(* 10 1000))
|
||||
|
||||
(def ^:dynamic *worker*)
|
||||
|
||||
(defn worker [& {:keys [preamble]}]
|
||||
(p/process
|
||||
{:shutdown p/destroy-tree
|
||||
:err (l/log-stream :info "temml/err")}
|
||||
#_"doerg-tex"
|
||||
"./doerg-tex/index.js"
|
||||
"--preamble"
|
||||
"resources/net/deertopia/doerg/prelude.tex"))
|
||||
|
||||
(defn close-worker [tw]
|
||||
(.close (:in tw)))
|
||||
|
||||
(defmacro with-worker [tw & body]
|
||||
`(let [~tw (worker)]
|
||||
(try
|
||||
(do ~@body)
|
||||
(finally
|
||||
(close-worker ~tw)
|
||||
(p/destroy-tree ~tw)))))
|
||||
|
||||
(defmacro binding-worker [& body]
|
||||
`(binding [*worker* (worker)]
|
||||
(try
|
||||
~@body
|
||||
(finally
|
||||
(close-worker *worker*)))))
|
||||
|
||||
(defn command-worker [x]
|
||||
(cbor/encode cbor/default-codec (:in *worker*) x)
|
||||
(.flush (:in *worker*))
|
||||
(cbor/decode cbor/default-codec (:out *worker*)))
|
||||
|
||||
(defn render-inline [s]
|
||||
(command-worker s))
|
||||
|
||||
(defn render-display [s]
|
||||
(command-worker [s]))
|
||||
|
||||
(defn render [s]
|
||||
(if-let [[_ inner] (re-matches #"(?s)\\[(.*)\\]" s)]
|
||||
(render-display inner)
|
||||
(if (re-matches #"(?s)\\begin\{.+?}(.*?)\\end\{.+?}" s)
|
||||
(render-display s)
|
||||
(if-let [[_ inner] (re-matches #"(?s)\\\((.*)\\\)" s)]
|
||||
(render-inline inner)
|
||||
(throw (ex-info "weird" {:snippet s}))))))
|
||||
|
||||
;; hackky....
|
||||
(defn erroneous-output? [s]
|
||||
(re-find #"(#b22222|temml-error)" s))
|
||||
Reference in New Issue
Block a user