chris/dotfiles
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Submodule hustle.

Browse Source
This commit is contained in:
Christian Busch
2020-05-07 09:30:45 +02:00
parent e0bf46a0bf
commit cc3f6d2f50
164 changed files with 130963 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

265
init/FiraCode/clojure/fira_code/calt.clj Executable file
View File

@ -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")))))

26
init/FiraCode/clojure/fira_code/checks.clj Normal file
View File

@ -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)))

15
init/FiraCode/clojure/fira_code/coll.clj Normal file
View File

@ -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)))

192
init/FiraCode/clojure/fira_code/glyphs.clj Executable file
View File

@ -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)
;;

29
init/FiraCode/clojure/fira_code/main.clj Normal file
View File

@ -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)))

14
init/FiraCode/clojure/fira_code/not_space.clj Normal file
View File

@ -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)))))

31
init/FiraCode/clojure/fira_code/spacers.clj Normal file
View File

@ -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)))

13
init/FiraCode/clojure/fira_code/time.clj Normal file
View File

@ -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)))