clojure/fira_code/glyphs.clj - master - githubmirror/FiraCode

clojure/fira_code/glyphs.clj
236 строк7 KB
Nikita Prokopov
Updated Clojure generator to Glyphs formatVersion 3
02 мар 2026, 22:07
02 мар 2026, 22:071c4866e
(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 "\\\"" "\"")
        (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!)))

(defn- serialize-impl [form]
  (cond
    (string? form)
    (if (re-matches #"[a-zA-Z0-9._/]+" form)
      form
      (str \" (str/replace form #"[\"\\]" {"\"" "\\\""
                                           "\\" "\\\\"}) \"))

    (keyword? form)
    (name form)

    (number? form)
    (str form)

    (instance? clojure.lang.MapEntry form)
    (str
      (serialize-impl (key form))
      " = "
      (case (key form)
        ;; https://github.com/googlefonts/glyphsLib/issues/209
        ".appVersion"
        (str \" (val form) \")

        ;; ¯\_(ツ)_/¯
        (:stemValues "stemValues")
        (str "(\n" (str/join ",\n" (val form)) "\n)")

        ;; else
        (serialize-impl (val form)))
      ";")

    (and (sequential? form) (empty? form))
    "(\n)"

    (and (sequential? form) (<= 2 (count form) 3) (not (coll? (first form))))
    (str "(" (str/join "," (map serialize-impl form)) ")")

    (sequential? form)
    (str "(\n" (str/join ",\n" (map serialize-impl form)) "\n)")

    (and (map? form) (empty? form))
    "{\n}"

    (map? form)
    (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-attr name f & args]
  (let [idx (coll/index-of #(= (get % name-attr) name) (get font key))]
    (assert (>= idx 0) (str "Can’t find " key " tag=" name ", got " (str/join ", " (map #(get % name-attr) (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 #(= (:tag %) 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)
;;