commit bde80c5f6759aab5ff6a61add0704a8f83f3f94b Spenser Truex <truex@equwal.com> 2021-02-05 15:47:29 -0800 Add combinatoric script
README.md | 12 +++ all-fonts-default.lisp | 37 +++++++ alt-hack-new-glyphs | 1 + generator.ros | 265 +++++++++++++++++++++++++++++++------------------ glyphs | 2 +- hack | 1 - script-default.lisp | 4 + source | 2 +- tarflat | 16 +++ tt-hinting | 2 +- 10 files changed, 241 insertions(+), 101 deletions(-)
diff --git a/README.md b/README.md index 202b787..724d048 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,17 @@ # Hack with an alternative zero. +Warning: + +Generating alt-hacks is confusing. Among the confusions: +- Installing binaries in your /home/user directory +- Undocumented dependencies (including the above!) +- alt-hacks script that I made is lazy about helping you and sucks. To use it: +$ sbcl +(ql:quickload :alexandria) +(ql:quickload :uiop) +(load "all-fonts.lisp) +(all-fonts::gen-all-fonts) ; spend forever generating an assload of stuff + [Released font downloads](https://www.equwal.com/alt-hacks.html) Like [Hack](https://github.com/ryanoasis/nerd-fonts) fonts? Dislike diff --git a/all-fonts-default.lisp b/all-fonts-default.lisp new file mode 100644 index 0000000..cc23e73 --- /dev/null +++ b/all-fonts-default.lisp @@ -0,0 +1,37 @@ +(defpackage :all-fonts + (:use :cl) + (:import-from :alexandria :map-combinations) + (:import-from :uiop :run-program)) +(in-package :all-fonts) + +(defparameter *groups* + '(curve round backslash diamond dot forwardslash noslab1 flattop3 widerknife slabi) + "Things you actually want to permute together.") + +(defparameter *exclusions* + '((curve round) + (backslash diamond dot forwardslash)) + "Things which you don't want specified at the same time.") + +(defun verify (spec) + "Ensure that the spec is not bogus." + (let ((group (not (set-difference spec *groups*))) + (exclusion (not (some #'identity + (mapcar #'(lambda (ex) + (<= 2 (length (intersection spec ex)))) + *exclusions*))))) + (values (and group exclusion) + (if group (if exclusion 'group-and-exclusion 'group) + (if exclusion 'exclusion 'unknown))))) +(defun gen-all-fonts () + (loop for x from 1 to (length *groups*) + do (map-combinations + (lambda (f) + (when (verify f) + (run-program (format nil "./generator.ros --ttf --woff --woff2 ~(~{ ~A~}~)" f) :output t) + ;; KLUDGE: Weird bug where everything ends up in the ttf folder + (run-program (format nil "tar -vcf - Hack/build/ttf/* | xz -12 >'~(~{~A~}~).tar.xz'" f) :output t) + (run-program "rm -Rf Hack/build") + (run-program "mkdir Hack/build"))) + *groups* + :length x))) diff --git a/alt-hack-new-glyphs b/alt-hack-new-glyphs new file mode 160000 index 0000000..4921583 --- /dev/null +++ b/alt-hack-new-glyphs @@ -0,0 +1 @@ +Subproject commit 4921583737a2368684eb7ce3fad4b68579a2596b diff --git a/generator.ros b/generator.ros index 37f460d..9e6fbb5 100755 --- a/generator.ros +++ b/generator.ros @@ -3,35 +3,19 @@ #| exec ros -Q -- $0 "$@" |# +;;; This file (c) Spenser Truex 2021 +;;; MIT license. + (progn ;;init forms (ros:ensure-asdf) - #+quicklisp(ql:quickload '(:alexandria :str :uiop :let-over-lambda) - :silent t) - (asdf:load-system :utils) ;My utilities, has the COLLECT macro. - ) + #+quicklisp(ql:quickload '(:alexandria :uiop) + :silent t)) +;;; EXAMPLE USAGE: +;;; cd alt-hack && ./generator.ros curve dot slabi (defpackage :ros.script.generator.3783095582 - (:use :cl) - (:import-from - :alexandria - :flatten - :compose) - (:import-from :str :concat) - (:import-from :utils :collect :group :mapatoms) - (:import-from - :uiop - :copy-file - :resolve-symlinks - :directory-files - :subdirectories - :run-program)) + (:use :cl)) (in-package :ros.script.generator.3783095582) -;;; Uses a magic symlinks to deal with directories. Make sure they exist in your -;;; toplevel: -;;; - tt-hinting (in hack/post_processing) -;;; - glyphs (in alt-hack) -;;; - source (in hack) -;;; - hack (defvar *weights* '("Bold" "BoldItalic" "Italic" "Regular")) (defun uncomment (spec) @@ -40,34 +24,80 @@ exec ros -Q -- $0 "$@" (= 1 (length item)))) spec)) +(defparameter *helpful-groups* + '( + (curve "u0028-curved" "(" + "u0029-curved" ")") + (round "u0028-rounder" "(" + "u0029-rounder" ")") + (backslash "u0030-backslash" "0") + (diamond "u0030-diamond" "0") + (dot "u0030-dotted" "0") + (forwardslash "u0030-forwardslash" "0") + (noslab1 "u0031-noslab" "1") + (flattop3 "u0033-flattop" "3") + (wider "u003C-wider" "<" + "u003E-wider" ">") + (knife "u0066-knife" "f") + (slabi "u0069-slab" "i" + "u00EC-slab" "ì" + "u00ED-slab" "í" + "u00EE-slab" "î" + "u00EF-slab" "ï" + "u0129-slab" "ĩ" + "u012B-slab" "ī" + "u012D-slab" "ĭ" + "u012F-slab" "į" + "u0131-slab" "ı" + "u0456-slab" "і" + "u0457-slab" "ї")) + "Groups with extra information for user help.") + +(defun prune (test tree) + (labels ((rec (tree acc) + (cond + ((null tree) (nreverse acc)) + ((consp (car tree)) + (rec (cdr tree) + (cons (rec (car tree) nil) acc))) + (t (rec (cdr tree) + (if (funcall test (car tree)) + acc + (cons (car tree) acc))))))) + (rec tree nil))) + +(defun pprint-helpful-groups () + (let ((more-helpful (prune #'(lambda (s) + (and (stringp s) + (< 1 (length s)))) + *helpful-groups*))) + (loop for g in more-helpful + do (format t "~A:~%" (car g)) + do (format t "~{~A ~}~%" (cdr g))))) (defparameter *groups* - (mapcar #'uncomment - '((curve "u0028-curved" "(" - "u0029-curved" ")") - (round "u0028-rounder" "(" - "u0029-rounder" ")") - (backslash "u0030-backslash" "0") - (diamond "u0030-diamond" "0") - (dot "u0030-dotted" "0") - (forwardslash "u0030-forwardslash" "0") - (noslab1 "u0031-noslab" "1") - (flattop3 "u0033-flattop" "3") - (wider "u003C-wider" "<" - "u003E-wider" ">") - (knife "u0066-knife" "f") - (slabi "u0069-slab" "i" - "u00EC-slab" "ì" - "u00ED-slab" "í" - "u00EE-slab" "î" - "u00EF-slab" "ï" - "u0129-slab" "ĩ" - "u012B-slab" "ī" - "u012D-slab" "ĭ" - "u012F-slab" "į" - "u0131-slab" "ı" - "u0456-slab" "і" - "u0457-slab" "ї"))) + (mapcar #'uncomment *helpful-groups*) "Things you actually want to permute together.") +(defparameter *exclusions* + '((curve round) + (backslash diamond dot forwardslash)) + "Things which you don't want specified at the same time.") +(defparameter *formats* + '("ttf" "woff" "woff2") + "Valid parameters to call as formats.") + +(define-symbol-macro help + (progn (pprint-lines + "generator.ros OPTIONS* {SHOW | SPEC+}") + (format t "These are valid OPTIONS: ~{~A ~}~%" + (mapcar #'(lambda (f) (concatenate 'string "--" f)) + *formats*)) + (pprint-lines "SPEC should be a list of:") + (pprint-helpful-groups) + (pprint-lines + "Keep in mind that it makes no sense to include" + "the same character spec twice." + "SHOW just finds all available glyphs in alt-hack." + "TEST runs the test functions for ttf, woff and woff2."))) (defun find-keyword (keyword group) (when (not (null group)) @@ -79,30 +109,11 @@ exec ros -Q -- $0 "$@" (defun folders (keyword) (cdr (find-keyword keyword *groups*))) -(defun pprint-letters (letter-alist) - (dolist (p letter-alist) - (format t "~S ~S~%" - (car p) (string (cdr p))))) - -(defun show-characters () - (let ((dirs (subdirectories "glyphs"))) - (pprint-letters - (collect (d dirs) - (let ((mat (car (last (pathname-directory d))))) - (cons mat - (code-char (read (make-string-input-stream - (concat "#x" - (subseq mat 1 (search "-" mat)))))))))))) - -(defun help () - (format t "~@{~A~%~}" - "generator.ros SPEC+" - "SPEC should be a list of:") - (format t "~{~T~A~%~}" - (remove-if #'stringp (flatten *groups*)))) +(defun pprint-lines (&rest strings) + (format t "~{~A~%~}" strings)) (defun remove-hints () - (let ((files (directory-files #P"tt-hinting"))) + (let ((files (uiop:directory-files #P"Hack/postbuild_processing/tt-hinting"))) (dolist (f files) (with-open-file (si f :direction :input) (with-open-file (so f :direction :output @@ -115,44 +126,104 @@ exec ros -Q -- $0 "$@" (dolist (arg ufolders) (dolist (weight *weights*) (dolist (f (uiop:directory-files - (concat "glyphs/" arg "/" - (string-downcase weight) "/"))) - (copy-file f - (concat "hack/" "source/Hack-" weight - ".ufo/glyphs/" - (concat (pathname-name f) "." - (pathname-type f)))))))) + (concatenate 'string "glyphs/" arg "/" + (string-downcase weight) "/"))) + (uiop:copy-file f + (concatenate 'string + "Hack/source/Hack-" + weight + ".ufo/glyphs/" + (pathname-name f) + "." + (pathname-type f))))))) (defun make-it (&optional subcommand) ;; Cannot use uiop:launch-program since it is asynchronous. - (run-program (if subcommand + (uiop:run-program (if subcommand (list "make" subcommand) "make") :output *standard-output* - :directory (resolve-symlinks #P"hack") + :directory #P"Hack" :error-output *standard-output*)) (defun build (&rest make-commands) (dolist (m make-commands) (make-it m))) (defun verify (spec) - (not (set-difference spec (mapcar #'car *groups*)))) + "Ensure that the spec is not bogus." + (let ((group (not (set-difference spec (mapcar #'car *groups*)))) + (exclusion (not (some #'identity + (mapcar #'(lambda (ex) + (<= 2 (length (intersection spec ex)))) + *exclusions*))))) + (values (and group exclusion) + (if group (if exclusion 'group-and-exclusion 'group) + (if exclusion 'exclusion 'unknown))))) + +(defun show-characters () + (flet ((pprint-letters (letter-alist) + (dolist (p letter-alist) + (format t "~T~A~T~A~%" + (string (cdr p)) (car p))))) + (let ((dirs (uiop:subdirectories "glyphs"))) + (pprint-letters + (loop + for d in dirs + collecting + (let ((mat (car (last (pathname-directory d))))) + (cons + mat + (code-char (read-from-string + (concatenate 'string + "#x" + (subseq mat 1 (search "-" mat)))))))))))) +(defun format-parser (argv) + (when argv + (let ((c (car argv))) + (when (and (< 2 (length c)) + (string= "--" (subseq c 0 2))) + (cons (subseq c 2) (format-parser (cdr argv))))))) +(defun should-help (argv) + (or (null argv) + (dolist (a argv) + (when (or (search "-?" a) + (search "-h" a) + (search "help" a)) + (return t))))) +(defun should-test (argv) + (string= (car argv) "test")) + +(define-symbol-macro test + (progn (format t "Helping you:~%") + (main "help") + (format t "~%DONE. Trying TTF.") + (main "--ttf") + (format t "~%DONE. Trying WOFF.") + (main "--woff") + (format t "~%DONE. Trying WOFF2.") + (main "--woff2"))) (defun main (&rest argv) (declare (ignorable argv)) - (let ((f (first argv))) - (if (or (null argv) - (search "-?" f) - (search "--help" f) - (search "-h" f)) - (help) - (let ((argv (mapcar (compose #'intern #'string-upcase) argv))) - (when (verify argv) - (remove-hints) - (mapc #'put-glyphs! - (mapcar #'folders argv)) - ;; Can't get woff2 on my system. - ;; (make-it "woff2") - ;; (make-it) - (build "ttf" "woff")))))) + (if (should-help argv) + help + (if (should-test argv) + test + (let ((formats (format-parser argv))) + (let ((argv (mapcar (lambda (g) (intern (string-upcase g))) + (nthcdr (length formats) argv))) + (formats (or formats "ttf woff woff2"))) + (if (and argv (string= "SHOW" (string-upcase (car argv)))) + (show-characters) + (multiple-value-bind (bool name) + (verify argv) + (if bool + (progn (remove-hints) + (mapc #'put-glyphs! + (mapcar #'folders argv)) + ;; Can't get woff2 on my system. + (mapc #'build formats)) + (progn (format t "Invalid ~S in spec: ~{~A ~}~%" + name + argv)))))))))) ;;; vim: set ft=lisp lisp: diff --git a/glyphs b/glyphs index d90c0ba..5584ac7 120000 --- a/glyphs +++ b/glyphs @@ -1 +1 @@ -/home/jose/src/gh/source-foundry/alt-hack/glyphs \ No newline at end of file +/home/jose/src/repos/gh/source-foundry/alt-hack/glyphs \ No newline at end of file diff --git a/hack b/hack deleted file mode 120000 index 37532e5..0000000 --- a/hack +++ /dev/null @@ -1 +0,0 @@ -/home/jose/src/gh/source-foundry/hack \ No newline at end of file diff --git a/script-default.lisp b/script-default.lisp new file mode 100644 index 0000000..938b3b8 --- /dev/null +++ b/script-default.lisp @@ -0,0 +1,4 @@ +(ql:quickload :alexandria) +(ql:quickload :uiop) +(load "all-fonts-default.lisp") +(all-fonts::gen-all-fonts) diff --git a/source b/source index 4742210..8c1d058 120000 --- a/source +++ b/source @@ -1 +1 @@ -/home/jose/src/gh/source-foundry/hack/source \ No newline at end of file +/home/jose/src/repos/gh/source-foundry/hack/source \ No newline at end of file diff --git a/tarflat b/tarflat new file mode 100755 index 0000000..8baef2b --- /dev/null +++ b/tarflat @@ -0,0 +1,16 @@ +#!/bin/sh +PWD1=$(pwd) +flatfile () { + mkdir -p out + cd out || return 1 + tar -xf ../"$1" + cd "$PWD1" || return 1 + cd "$PWD1"/out/Hack/build/ttf || return 1 + tar -cf - * | xz -12 >"$PWD1"/"$1.flat" + mv "$PWD1"/"$1.flat" "$PWD1"/"$1" + cd "$PWD1" || return 1 + rm -Rf out +} + +# can't use -exec on shell functions, so do this +find . -name '*.tar.xz' | while read -r file ; do flatfile "$(echo $file | sed 's/^\.\///')" ; done diff --git a/tt-hinting b/tt-hinting index 405f0d0..63cc159 120000 --- a/tt-hinting +++ b/tt-hinting @@ -1 +1 @@ -/home/jose/src/gh/source-foundry/hack/postbuild_processing/tt-hinting \ No newline at end of file +/home/jose/src/repos/gh/source-foundry/hack/postbuild_processing/tt-hinting \ No newline at end of file