mirror of
https://github.com/i-tu/Hasklig.git
synced 2024-09-17 13:37:21 +03:00
151 lines
4.4 KiB
Clojure
151 lines
4.4 KiB
Clojure
(comment "
|
|
Modified 2016 under the terms of SIL for use in Hasklig.
|
|
Ian Tuomi
|
|
|
|
Copyright (c) 2014, Nikita Prokopov http://tonsky.me
|
|
with Reserved Font Name Fira Code.
|
|
|
|
Copyright (c) 2014, Mozilla Foundation https://mozilla.org/
|
|
with Reserved Font Name Fira Sans.
|
|
|
|
Copyright (c) 2014, Mozilla Foundation https://mozilla.org/
|
|
with Reserved Font Name Fira Mono.
|
|
|
|
Copyright (c) 2014, Telefonica S.A.
|
|
|
|
This Font Software is licensed under the SIL Open Font License, Version 1.1.
|
|
This license is copied below, and is also available with a FAQ at:
|
|
http://scripts.sil.org/OFL
|
|
")
|
|
|
|
|
|
#^:shebang '[
|
|
exec java -cp "$HOME/.m2/repository/org/clojure/clojure/1.7.0/clojure-1.7.0.jar" clojure.main "$0" "$@"]
|
|
|
|
|
|
(require '[clojure.string :as str])
|
|
|
|
(def ligas
|
|
[ ["asterisk" "asterisk" "asterisk"]
|
|
;["bar" "bar" "bar"]
|
|
["equal" "equal" "equal"]
|
|
["equal" "equal" "greater"]
|
|
["equal" "less" "less"]
|
|
["greater" "greater" "equal"]
|
|
["greater" "greater" "greater"]
|
|
["greater" "greater" "hyphen"]
|
|
["hyphen" "less" "less"]
|
|
["less" "asterisk" "greater"]
|
|
["less" "bar" "greater"]
|
|
["less" "dollar" "greater"]
|
|
["less" "plus" "greater"]
|
|
["less" "less" "less"]
|
|
["period" "period" "period"]
|
|
["plus" "plus" "plus"]
|
|
["asterisk" "greater"]
|
|
["backslash" "backslash"]
|
|
["bar" "bar"]
|
|
["bar" "greater"]
|
|
["colon" "colon"]
|
|
["equal" "equal"]
|
|
["equal" "greater"]
|
|
["exclam" "exclam"]
|
|
["greater" "greater"]
|
|
["greater" "hyphen"]
|
|
["hyphen" "greater"]
|
|
["hyphen" "less"]
|
|
["less" "asterisk"]
|
|
["less" "greater"]
|
|
["less" "bar"]
|
|
["less" "hyphen"]
|
|
["less" "less"]
|
|
["period" "period"]
|
|
["plus" "plus"]
|
|
["slash" "equal"]])
|
|
|
|
(defn liga->rules
|
|
"[f f i] => { [CR CR i] f_f_i
|
|
[CR f i] CR
|
|
[ f f i] CR }"
|
|
[liga CR]
|
|
(case (count liga)
|
|
2 (let [[a b] liga]
|
|
{ [CR b] (str a "_" b)
|
|
[ a b] CR})
|
|
3 (let [[a b c] liga]
|
|
{ [CR CR c] (str a "_" b "_" c)
|
|
[CR b c] CR
|
|
[ a b c] CR})
|
|
4 (let [[a b c d] liga]
|
|
{ [CR CR CR d] (str a "_" b "_" c "_" d)
|
|
[CR CR c d] CR
|
|
[CR b c d] CR
|
|
[ a b c d] CR})))
|
|
|
|
|
|
(defn any? [p & colls]
|
|
(if colls
|
|
(let [[coll & cs] colls]
|
|
(some #(apply any? (partial p %) cs) coll))
|
|
(p)))
|
|
|
|
|
|
(defn conflicts? [r1 r2]
|
|
(when (.startsWith (first r2) "CR.") ;; we accept that higher-len ligatures can override lower-length
|
|
;; but once replacement has started (first glyph in rule is CR.*)
|
|
;; there should be no possibility for conflits
|
|
(let [l1 (count r1)
|
|
l2 (count r2)
|
|
prefix1 (subvec r1 0 l2)]
|
|
(= r2 prefix1))))
|
|
|
|
|
|
(def all-rules
|
|
(reduce
|
|
(fn [generated liga]
|
|
(merge generated
|
|
;; looking for smallest i that does not conflict
|
|
;; with any of previous rules
|
|
(some (fn [i]
|
|
(let [CR (str "CR." (String/format "%02d" (to-array [i])))
|
|
rs (liga->rules liga CR)]
|
|
(when-not (any? conflicts? (keys generated) (keys rs))
|
|
rs)))
|
|
(range))))
|
|
{}
|
|
(->> ligas (sort-by count) reverse)))
|
|
|
|
|
|
(defn priority-fn [[from to]]
|
|
[;; first compare how many CRs are there (more is better)
|
|
(- (count (filter #(re-matches #"CR\.\d+" %) from)))
|
|
;; then overal length (more is better)
|
|
(- (count from))
|
|
;; then alphabetical sort with coercing each vector to the same length
|
|
(into from (repeat (- 4 (count from)) "z"))])
|
|
|
|
|
|
(def table (->> all-rules
|
|
(sort-by priority-fn)))
|
|
|
|
|
|
(defn rule->str [[from to]]
|
|
(loop [res "sub"
|
|
seen-non-empty? false
|
|
tokens from]
|
|
(if-let [token (first tokens)]
|
|
(let [class? (.startsWith token "@")
|
|
CR? (.startsWith token "CR.")
|
|
escaped-token (cond
|
|
class? token
|
|
CR? (str "\\" token)
|
|
seen-non-empty? (str "\\" token)
|
|
:else (str "\\" token "'"))]
|
|
(recur (str res " " escaped-token) (not CR?) (next tokens)))
|
|
(str res " by \\" to ";"))))
|
|
|
|
|
|
(println "feature calt {")
|
|
(println " " (->> table (map rule->str) (str/join "\n ")))
|
|
(println "} calt;\n")
|