mirror of
https://github.com/tonsky/FiraCode.git
synced 2024-08-17 00:40:32 +03:00
223 lines
6.6 KiB
Clojure
Executable File
223 lines
6.6 KiB
Clojure
Executable File
(ns fira-code.glyphs
|
||
(:refer-clojure :exclude [load])
|
||
(:require
|
||
[clojure.java.io :as io]
|
||
[clojure.string :as str]
|
||
[fipp.edn :as fipp]
|
||
[fira-code.coll :as coll]
|
||
[flatland.ordered.map :refer [ordered-map]]))
|
||
|
||
(def ^:dynamic *str)
|
||
(def ^:dynamic *pos)
|
||
|
||
(defn current-char [] (nth @*str @*pos))
|
||
|
||
(defn advance! [] (swap! *pos inc))
|
||
|
||
(declare parse-anything!)
|
||
|
||
(defn skip-ws! []
|
||
(loop []
|
||
(case (current-char)
|
||
\space (do (advance!) (recur))
|
||
\newline (do (advance!) (recur))
|
||
nil)))
|
||
|
||
(defn parse-escaped-string! []
|
||
(skip-ws!)
|
||
(when (= \" (current-char))
|
||
(let [sb (StringBuilder.)]
|
||
(->
|
||
(loop []
|
||
(advance!)
|
||
(let [ch (current-char)]
|
||
(cond
|
||
(= ch \\) (do (.append sb \\) (advance!) (.append sb (current-char)) (recur))
|
||
(= ch \") (do (advance!) (str sb))
|
||
:else (do (.append sb ch) (recur)))))
|
||
(str/replace "\\012" "\n")
|
||
(str/replace "\\\"" "\"")
|
||
(str/replace "\\\\" "\\")))))
|
||
|
||
(defn parse-string! []
|
||
(skip-ws!)
|
||
(let [sb (StringBuilder.)]
|
||
(loop []
|
||
(let [ch (current-char)]
|
||
(cond
|
||
(#{\space \newline \{ \} \( \) \; \, \" \=} ch) sb
|
||
:else (do (.append sb ch) (advance!) (recur)))))
|
||
(let [res (str sb)]
|
||
(cond
|
||
(re-matches #"-?[1-9][0-9]*" res) (Integer/parseInt res)
|
||
(re-matches #"-?[0-9]+\.[0-9]+" res) (Double/parseDouble res)
|
||
(re-matches #"[a-zA-Z][a-zA-Z\.0-9]*" res) (keyword res)
|
||
:else res))))
|
||
|
||
(defn expect [c]
|
||
(assert (= c (current-char))
|
||
(str "Expected '" c
|
||
"', found " (current-char)
|
||
" at " @*pos
|
||
" around here:\n" (subs @*str (max 0 (- @*pos 100)) (min (count @*str) (+ @*pos 100))))))
|
||
|
||
(defn parse-map! []
|
||
(skip-ws!)
|
||
(when (= \{ (current-char))
|
||
(advance!)
|
||
(loop [m (ordered-map)]
|
||
(skip-ws!)
|
||
(if (= \} (current-char))
|
||
(do (advance!) m)
|
||
(let [k (or (parse-escaped-string!) (parse-string!))
|
||
_ (do (skip-ws!) (expect \=) (advance!))
|
||
v (parse-anything!)
|
||
v (if (keyword? v) (name v) v)
|
||
_ (do (skip-ws!) (expect \;) (advance!))]
|
||
(recur (assoc m k v)))))))
|
||
|
||
(defn parse-list! []
|
||
(skip-ws!)
|
||
(when (= \( (current-char))
|
||
(advance!)
|
||
(loop [l []]
|
||
(skip-ws!)
|
||
(if (= \) (current-char))
|
||
(do (advance!) l)
|
||
(let [v (parse-anything!)
|
||
_ (skip-ws!)
|
||
_ (when (not= \) (current-char))
|
||
(expect \,)
|
||
(advance!))]
|
||
(recur (conj l v)))))))
|
||
|
||
(defn parse-anything! []
|
||
(skip-ws!)
|
||
(or
|
||
(parse-map!)
|
||
(parse-list!)
|
||
(parse-escaped-string!)
|
||
(parse-string!)))
|
||
|
||
(defn parse [s]
|
||
(binding [*str (atom s)
|
||
*pos (atom 0)]
|
||
(parse-anything!)))
|
||
|
||
(def escapes {"\n" "\\012"
|
||
"\"" "\\\""
|
||
"\\" "\\\\"})
|
||
|
||
(def escape-re #"[\n\"\\]")
|
||
|
||
(defn- serialize-impl [form]
|
||
(cond
|
||
(string? form) (if (re-matches #"[a-zA-Z0-9._/]+" form)
|
||
form
|
||
(str \" (str/replace form escape-re escapes) \"))
|
||
(keyword? form) (name form)
|
||
(number? form) (str form)
|
||
(instance? clojure.lang.MapEntry form)
|
||
(str
|
||
(serialize-impl (key form))
|
||
" = "
|
||
(if (= ".appVersion" (key form)) ;; https://github.com/googlefonts/glyphsLib/issues/209
|
||
(str \" (val form) \")
|
||
(serialize-impl (val form)))
|
||
";")
|
||
(sequential? form) (if (empty? form)
|
||
"(\n)"
|
||
(str "(\n" (str/join ",\n" (map serialize-impl form)) "\n)"))
|
||
(map? form) (if (empty? form)
|
||
"{\n}"
|
||
(str "{\n" (str/join "\n" (map serialize-impl form)) "\n}"))))
|
||
|
||
(defn serialize [font]
|
||
(str (serialize-impl font) "\n"))
|
||
|
||
; (-> (slurp "FiraCode.glyphs") parse serialize (->> (spit "FiraCode_saved.glyphs")))
|
||
|
||
(defn load [path]
|
||
(println (str "Parsing '" path "'..."))
|
||
(parse (slurp path)))
|
||
|
||
(defn save! [path font]
|
||
(println (str "Saving '" path "'..."))
|
||
(spit path (serialize font)))
|
||
|
||
(defn -main [& args]
|
||
(let [font (-> (slurp "FiraCode.glyphs") parse)]
|
||
(with-open [os (io/writer "clojure/FiraCode.edn")]
|
||
(binding [*out* os]
|
||
(fipp/pprint font {:width 200})))))
|
||
|
||
|
||
(defn update-code [font key name f & args]
|
||
(let [idx (coll/index-of #(= (:name %) name) (get font key))]
|
||
(assert (>= idx 0) (str "Can’t find " key "[name=\"" name "\"], got " (str/join ", " (map :name (get font key)))))
|
||
(apply update-in font [key idx :code] f args)))
|
||
|
||
|
||
(defn lines [s]
|
||
(inc (count (re-seq #"\n" s))))
|
||
|
||
|
||
(defn words [s]
|
||
(count (re-seq #"[^\s]+" s)))
|
||
|
||
|
||
(defn set-feature [font name feature]
|
||
(let [idx (coll/index-of #(= (:name %) name) (:features font))]
|
||
(if (pos? idx)
|
||
(do
|
||
(println " replacing feature" name "with" (lines (:code feature)) "lines")
|
||
(assoc-in font [:features idx] feature))
|
||
(do
|
||
(println " appending to feature" name (lines (:code feature)) "lines")
|
||
(update font :features conj feature)))))
|
||
|
||
|
||
(defn set-class [font name class]
|
||
(let [idx (coll/index-of #(= (:name %) name) (:classes font))]
|
||
(if (pos? idx)
|
||
(do
|
||
(println " replacing class" name "with" (words (:code class)) "entries")
|
||
(assoc-in font [:classes idx] class))
|
||
(do
|
||
(println " appending to class" name (words (:code class)) "entries")
|
||
(update font :classes conj class)))))
|
||
|
||
|
||
(def weights
|
||
{:Light "B67F0F2D-EC95-4CB8-966E-23AE86958A69"
|
||
:Regular "UUID0"
|
||
:Bold "4B7A3BAF-EAD8-4024-9BEA-BB1DE86CFCFA"})
|
||
|
||
|
||
(defn layer [l]
|
||
{ :id (condp = (:layerId l)
|
||
(:Light weights) "Light"
|
||
(:Regular weights) "Regular"
|
||
(:Bold weights) "Bold"
|
||
(:layerId l))
|
||
:width (:width l) })
|
||
|
||
(defn save-not600 []
|
||
(let [font (-> (slurp "FiraCode.glyphs") parse)]
|
||
(with-open [os (io/writer "clojure/FiraCode_not600.edn")]
|
||
(binding [*out* os]
|
||
(let [glyphs (for [glyph (:glyphs font)
|
||
:when (->> (:layers glyph)
|
||
(filter #(contains? (set (vals weights)) (:layerId %)))
|
||
(every? #(= 600 (:width %)))
|
||
(not))]
|
||
{:glyphname (:glyphname glyph)
|
||
:layers (mapv layer (:layers glyph))})]
|
||
(doseq [glyph glyphs]
|
||
(fipp/pprint glyph {:width 200}))
|
||
(count glyphs))))))
|
||
|
||
;; (-main)
|
||
;; (save-not600)
|
||
;; (-> (slurp "FiraCode.glyphs") parse keys)
|
||
;; |