Submodule hustle.

init/FiraCode/clojure/fira_code/calt.clj

@@ -0,0 +1,265 @@
+(ns fira-code.calt
+  (:require
+   [clojure.string :as str]
+   [fira-code.coll :as coll]
+   [fira-code.glyphs :as glyphs]
+   [fira-code.time :as time]
+   [flatland.ordered.map :refer [ordered-map]]))
+
+
+;; No ligature should follow those sequences
+(def ignore-prefixes
+  [["parenleft" "question" "colon"]
+   ;; #578 #624 Regexp lookahead/lookbehind
+   ["parenleft" "question" "equal"]
+   ["parenleft" "question" "less" "equal"]
+   ["parenleft" "question" "exclam"]
+   ["parenleft" "question" "less" "exclam"]
+   ;; #850 PHP <?=
+   ["less" "question" "equal"]
+  ])
+
+
+(defn gen-ignore-prefixes [liga]
+  (str/join
+    (for [prefix ignore-prefixes
+          ;; try to match last N glyphs in `prefix` with N first in `liga`
+          N (range (count liga) 0 -1)
+          :when (= (take-last N prefix) (take N liga))]
+      (str "  ignore sub"
+        " " (str/join " " (drop-last N prefix))
+        " " (first liga) "'"
+        " " (str/join " " (drop 1 liga))
+        ";\n"))))
+
+
+(def ignores
+  { ["slash" "asterisk"]
+    (str
+      "  ignore sub slash' asterisk slash;\n"
+      "  ignore sub asterisk slash' asterisk;\n")
+
+    ["asterisk" "slash"]
+    (str
+      "  ignore sub slash asterisk' slash;\n"
+      "  ignore sub asterisk' slash asterisk;\n")
+
+    ["asterisk" "asterisk"]
+    (str
+      "  ignore sub slash asterisk' asterisk;\n"
+      "  ignore sub asterisk' asterisk slash;\n")
+
+    ["asterisk" "asterisk" "asterisk"]
+    (str
+      "  ignore sub slash asterisk' asterisk asterisk;\n"
+      "  ignore sub asterisk' asterisk asterisk slash;\n")
+    
+    ;; #621 <||>
+    ["less" "bar" "bar"]
+    "  ignore sub less' bar bar greater;\n"
+
+    ["bar" "bar" "greater"]
+    "  ignore sub less bar' bar greater;\n"
+
+    ;; #574 :>=
+    ["colon" "greater"]
+    "  ignore sub colon' greater equal;\n"
+
+    ;; #548 >=<
+    ["greater" "equal"]
+    "  ignore sub greater' equal less;\n"
+
+    ["equal" "less"]
+    "  ignore sub greater equal' less;\n"
+
+    ;; #593 {|}
+    ["braceleft" "bar"]
+    "  ignore sub braceleft' bar braceright;\n"
+
+    ["bar" "braceright"]
+    "  ignore sub braceleft bar' braceright;\n"
+
+    ;; #593 [|]
+    ["bracketleft" "bar"]
+    "  ignore sub bracketleft' bar bracketright;\n"
+
+    ["bar" "bracketright"]
+    "  ignore sub bracketleft bar' bracketright;\n"
+
+    ;; #410 <*>> <+>> <$>>
+    ["greater" "greater"]
+    (str "  ignore sub asterisk greater' greater;\n"
+         "  ignore sub plus greater' greater;\n"
+         "  ignore sub dollar greater' greater;\n")
+
+    ;; #410 <*>>> <+>>> <$>>>
+    ["greater" "greater" "greater"]
+    (str "  ignore sub asterisk greater' greater greater;\n"
+         "  ignore sub plus greater' greater greater;\n"    
+         "  ignore sub dollar greater' greater greater;\n")
+
+    ;; #410 <<*> <<+> <<$>
+    ["less" "less"]
+    (str "  ignore sub less' less asterisk;\n"
+         "  ignore sub less' less plus;\n"
+         "  ignore sub less' less dollar;\n")
+
+    ;; #410 <<<*> <<<+> <<<$>
+    ["less" "less" "less"]
+    (str "  ignore sub less' less less asterisk;\n"
+         "  ignore sub less' less less plus;\n"
+         "  ignore sub less' less less dollar;\n")
+
+    ;; #713 |-|
+    ["bar" "hyphen"]
+    "  ignore sub bar' hyphen bar;\n"
+
+    ["hyphen" "bar"]
+    "  ignore sub bar hyphen' bar;\n"
+
+    ;; #968 [-> [--> [==> [=>
+    ["equal" "greater"]
+    "  ignore sub bracketleft equal' greater;\n"
+
+    ["equal" "equal" "greater"]
+    "  ignore sub bracketleft equal' equal greater;\n"
+
+    ["equal" "equal"]
+    "  ignore sub bracketleft equal' equal;\n"
+
+    ["equal" "equal" "equal"]
+    "  ignore sub bracketleft equal' equal equal;\n"
+
+    ["hyphen" "greater"]
+    "  ignore sub bracketleft hyphen' greater;\n"
+
+    ["hyphen" "hyphen" "greater"]
+    "  ignore sub bracketleft hyphen' hyphen greater;\n"
+
+    ["hyphen" "hyphen"]
+    "  ignore sub bracketleft hyphen' hyphen;\n"
+
+    ["hyphen" "hyphen" "hyphen"]
+    "  ignore sub bracketleft hyphen' hyphen hyphen;\n"
+})
+
+
+;; DO NOT generate ignores at all
+(def skip-ignores? #{
+  ;; #410 <<*>> <<+>> <<$>>
+  ["less" "asterisk" "greater"]
+  ["less" "plus" "greater"]
+  ["less" "dollar" "greater"]
+  ;; #795
+  ["f" "l"] ["F" "l"] ["T" "l"]
+})
+
+
+;; DO NOT generate ligature
+(def manual? #{
+  ;; /\ \/
+  ["slash" "backslash"]
+  ["backslash" "slash"]
+})
+
+
+(defn liga->rule
+  "[f f i] => { [LIG LIG i] f_f_i.liga
+                [LIG   f i] LIG
+                [ f    f i] LIG }"
+  [liga]
+  (case (count liga)
+    2 (let [[a b] liga]
+        (str/replace
+          (str
+            "lookup 1_2 {\n"
+            (when-not (skip-ignores? liga)
+              (str "  ignore sub 1 1' 2;\n"
+                   "  ignore sub 1' 2 2;\n"))
+            (gen-ignore-prefixes liga)
+            (get ignores liga)
+            "  sub 1.spacer 2' by 1_2.liga;\n"
+            "  sub 1'       2  by 1.spacer;\n"
+            ; "sub 1 2 by 1_2.liga;"
+            "} 1_2;")
+          #"\d" {"1" a "2" b}))
+    3 (let [[a b c] liga]
+        (str/replace
+          (str
+            "lookup 1_2_3 {\n"
+            (when-not (skip-ignores? liga)
+             (str "  ignore sub 1 1' 2 3;\n"
+                  "  ignore sub 1' 2 3 3;\n"))
+            (gen-ignore-prefixes liga)
+            (get ignores liga)
+            "  sub 1.spacer 2.spacer 3' by 1_2_3.liga;\n"
+            "  sub 1.spacer 2'       3  by 2.spacer;\n"
+            "  sub 1'       2        3  by 1.spacer;\n"
+            ; "sub 1 2 3 by 1_2_3.liga;"
+            "} 1_2_3;")
+          #"\d" {"1" a "2" b "3" c}))
+    4 (let [[a b c d] liga]
+        (str/replace
+          (str
+            "lookup 1_2_3_4 {\n"
+            (when-not (skip-ignores? liga)
+              (str "  ignore sub 1 1' 2 3 4;\n"
+                   "  ignore sub 1' 2 3 4 4;\n"))
+            (gen-ignore-prefixes liga)
+            (get ignores liga)
+            "  sub 1.spacer 2.spacer 3.spacer 4' by 1_2_3_4.liga;\n"
+            "  sub 1.spacer 2.spacer 3'       4  by 3.spacer;\n"
+            "  sub 1.spacer 2'       3        4  by 2.spacer;\n"
+            "  sub 1'       2        3        4  by 1.spacer;\n"
+            ; "sub 1 2 3 4 by 1_2_3_4.liga;"
+            "} 1_2_3_4;")
+          #"\d" {"1" a "2" b "3" c "4" d}))
+    5 (let [[a b c d e] liga]
+        (str/replace
+          (str
+            "lookup 1_2_3_4_5 {\n"
+            (when-not (skip-ignores? liga)
+              (str "  ignore sub 1 1' 2 3 4 5;\n"
+                   "  ignore sub 1' 2 3 4 4 5;\n"))
+            (gen-ignore-prefixes liga)
+            (get ignores liga)
+            "  sub 1.spacer 2.spacer 3.spacer 4.spacer 5' by 1_2_3_4_5.liga;\n"
+            "  sub 1.spacer 2.spacer 3.spacer 4'       5  by 4.spacer;\n"
+            "  sub 1.spacer 2.spacer 3'       4        5  by 3.spacer;\n"
+            "  sub 1.spacer 2'       3        4        5  by 2.spacer;\n"
+            "  sub 1'       2        3        4        5  by 1.spacer;\n"
+            ; "sub 1 2 3 4 5 by 1_2_3_4_5.liga;"
+            "} 1_2_3_4_5;")
+          #"\d" {"1" a "2" b "3" c "4" d "5" e}))
+))
+
+
+(defn compare-ligas [l1 l2]
+  (cond
+    (> (count l1) (count l2)) -1
+    (< (count l1) (count l2)) 1
+    :else (compare l1 l2)))
+
+
+(defn replace-calt [font ligas]
+  (let [ligas' (->> ligas
+                 (remove manual?) 
+                 (sort compare-ligas))
+        calt   (->> ligas'
+                 (map liga->rule)
+                 (str/join "\n\n"))
+        glyphs (map #(str (str/join "_" %) ".liga") ligas')
+        counts (coll/group-by-to count count ligas')]
+
+    (println "  generated calt:" 
+      ; (str/join " " glyphs)
+      (str
+        #_"(" (get counts 2) " pairs, "
+        (get counts 3) " triples, "
+        (get counts 4) " quadruples, "
+        (count ligas') " total" #_")"))
+
+    (glyphs/update-code font :features "calt"
+      #(str/replace %
+         #"### start of generated calt\n[^#]+\n### end of generated calt\n"
+         (str "### start of generated calt\n" calt "\n### end of generated calt\n")))))

init/FiraCode/clojure/fira_code/checks.clj

@@ -0,0 +1,26 @@
+(ns fira-code.checks
+  (:require
+   [clojure.string :as str]
+   [fira-code.coll :as coll]
+   [fira-code.glyphs :as glyphs]))
+
+
+(defn width-ok? [w]
+  (#{"0" 0 1200 2400} w))
+
+
+(defn widths [font]
+  (doseq [g     (:glyphs font)
+          :when (not= "0" (:export g))
+          l     (:layers g)
+          :let  [w (:width l)]
+          :when (not (width-ok? w))]
+    (println (str "WARN glyph '" (:glyphname g) "' layer '" (:id (glyphs/layer l)) "' has width=" (pr-str w))))
+  font)
+
+
+(defn -main [& args]
+  (let [path (or (first args) "FiraCode.glyphs")
+        font (glyphs/load path)]
+    (widths font)))
+

init/FiraCode/clojure/fira_code/coll.clj

@@ -0,0 +1,15 @@
+(ns fira-code.coll)
+
+
+(defn index-of [pred xs]
+  (let [res (reduce (fn [i x] (if (pred x) (reduced i) (inc i))) 0 xs)]
+    (assert (< res (count xs)) "Nothing found")
+    res))
+
+
+(defn group-by-to [key-fn value-fn xs]
+  (reduce-kv
+    (fn [m k vs]
+      (assoc m k (value-fn vs)))
+    {}
+    (group-by key-fn xs)))

init/FiraCode/clojure/fira_code/glyphs.clj

@@ -0,0 +1,192 @@
+(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))]
+    (apply update-in font [key idx :code] f args)))
+
+
+(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)
+;; 

init/FiraCode/clojure/fira_code/main.clj

@@ -0,0 +1,29 @@
+(ns fira-code.main
+  (:require
+   [clojure.string :as str]
+   [fira-code.calt :as calt]
+   [fira-code.coll :as coll]
+   [fira-code.checks :as checks]
+   [fira-code.glyphs :as glyphs]
+   [fira-code.not-space :as not-space]
+   [fira-code.spacers :as spacers]
+   [fira-code.time :as time]
+   [flatland.ordered.map :refer [ordered-map]]))
+
+
+(defn -main [& args]
+  (let [path   (or (first args) "FiraCode.glyphs")
+        font   (glyphs/load path)
+        ligas  (for [g (:glyphs font)
+                     :let [name (:glyphname g)]
+                     :when (str/ends-with? name ".liga")
+                     :when (not= "0" (:export g))
+                     :let [[_ liga] (re-matches #"([A-Za-z_]+)\.liga" name)]]
+                 (str/split liga #"_")) ;; [ ["dash" "greater" "greater"] ... ]
+        font'  (-> font
+                 (calt/replace-calt ligas)
+                 (spacers/add-spacers ligas)
+                 (not-space/regen-not-space)
+                 (checks/widths))]
+    (glyphs/save! path font')
+    (println)))

init/FiraCode/clojure/fira_code/not_space.clj

@@ -0,0 +1,14 @@
+(ns fira-code.not-space
+  (:require
+   [clojure.string :as str]
+   [fira-code.glyphs :as glyphs]))
+
+
+(defn regen-not-space [font]
+  (let [not-spaces (->> (:glyphs font)
+                     (remove #(re-find #"^\.|space$|space\." (:glyphname %)))
+                     (remove #(= "0" (:export %)))
+                     (map :glyphname)
+                     (sort))]
+    (println "  regenerated NotSpace:" (count not-spaces) "glyphs")
+    (glyphs/update-code font :classes "NotSpace" (constantly (str/join " " not-spaces)))))

init/FiraCode/clojure/fira_code/spacers.clj

@@ -0,0 +1,31 @@
+(ns fira-code.spacers
+  (:require
+   [clojure.string :as str]
+   [fira-code.glyphs :as glyphs]
+   [fira-code.time :as time]
+   [flatland.ordered.map :refer [ordered-map]]))
+
+
+(defn spacer [name]
+  (ordered-map
+    :color 3,
+    :glyphname name,
+    :lastChange (time/now-str),
+    :layers
+    [(ordered-map :layerId (:Light glyphs/weights), :width 1200)
+     (ordered-map :layerId (:Bold glyphs/weights), :width 1200)]))
+
+
+(defn add-spacers [font ligas]
+  (let [needed   (->> (into #{} cat ligas)
+                   (map #(str % ".spacer")))
+        existing (->> (:glyphs font)
+                   (map :glyphname)
+                   (filter #(str/ends-with? % ".spacer")))
+        new      (->> (remove (set existing) needed)
+                   (sort-by str/lower-case))]
+    (if-not (empty? new)
+      (do
+        (println "  added glyphs: " (str/join " " new))
+        (update font :glyphs #(into % (map spacer new))))
+      font)))

init/FiraCode/clojure/fira_code/time.clj

@@ -0,0 +1,13 @@
+(ns fira-code.time
+  (:import
+   [java.time LocalDateTime ZoneId]
+   [java.time.format DateTimeFormatter]))
+
+
+(def ^ZoneId UTC (ZoneId/of "UTC"))
+
+
+(defn now-str []
+  (.format
+    (DateTimeFormatter/ofPattern "yyyy-MM-dd HH:mm:ss +0000")
+    (LocalDateTime/now UTC)))