mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

edge

Browse Source
main
Matthew Butterick 4 years ago
parent eebf4cbac5
commit 959a633993
2 changed files with 94 additions and 45 deletions
Show Stats Download Patch File Download Diff File

57
quad/fontproof/command.rkt
Unescape Escape View File

@ -2,34 +2,57 @@
(require "main.rkt") (require "main.rkt")
(module+ raco (module+ raco
;; pull text out of stdin, if any
;; todo: make this cooperate with `read` for confirmation of replace
(define text (string-join (for/list ([t (in-port read)])
(format "~a" t)) " "))
(define command-name (with-handlers ([exn:fail? (λ (exn) #f)]) (define command-name (with-handlers ([exn:fail? (λ (exn) #f)])
(vector-ref (current-command-line-arguments) 0))) (vector-ref (current-command-line-arguments) 0)))
(dispatch command-name)) (dispatch command-name text))
(module+ main (module+ main
(println "this is fontproof command")) (println "this is fontproof command"))
(define (dispatch command-name) (define (dispatch command-name text)
(when (positive? (vector-length (current-command-line-arguments))) (when (positive? (vector-length (current-command-line-arguments)))
(define output-file-path #false) (define output-file-path #false)
(define page-size #false) (define page-size #false)
(define font-sizes #false) (define font-sizes #false)
(define line-heights #false) (define line-heights #false)
(define doc #false)
(define replace #false)
(define families (define families
(command-line #:program "fontproof" (command-line
#:argv (current-command-line-arguments) #:program "fontproof"
#:once-each #:argv (current-command-line-arguments)
[("-p" "--page") page-size-arg "page size" (set! page-size page-size-arg)] #:once-each
[("-o" "--output") output-file-path-arg "output file path" (set! output-file-path output-file-path-arg)] [("-p" "--page") page-size-arg
[("-s" "--size") font-sizes-arg "font sizes" (set! font-sizes font-sizes-arg)] "page size"
[("-l" "--line") line-heights-arg "line heights" (set! line-heights line-heights-arg)] (set! page-size page-size-arg)]
#:args families [("-r" "--replace") "replace existing"
families)) (set! replace #true)]
(for ([family (in-list families)]) [("-d" "--doc") doc-arg
(make-proof family "sample text"
#:page-size page-size (set! doc doc-arg)]
#:font-sizes font-sizes [("-o" "--output") output-file-path-arg
#:line-heights line-heights "output file path"
#:output-file-path output-file-path)))) (set! output-file-path output-file-path-arg)]
[("-s" "--size") font-sizes-arg
"font sizes"
(set! font-sizes font-sizes-arg)]
[("-l" "--leading") line-heights-arg
"font size"
(set! line-heights line-heights-arg)]
#:args families
families))
(cond
[(null? families) (displayln "no family given")]
[else (for ([family (in-list families)])
(make-proof family (if (non-empty-string? text) text doc)
#:page-size page-size
#:font-sizes font-sizes
#:line-heights line-heights
#:output-file-path output-file-path
#:replace replace))])))

82
quad/fontproof/main.rkt
Unescape Escape View File

@ -1,42 +1,68 @@
#lang racket/base #lang debug racket/base
(require quadwriter/core (require quadwriter/core
racket/date racket/date
racket/string racket/string
racket/list) racket/list
racket/match
txexpr)
(provide make-proof) (provide make-proof)
(define doc "todo: more than nothing")
(define (make-proof family-name (define (increment-path path)
(for*/first ([path (in-value path)]
[i (in-naturals 2)]
[incremented-path (in-value (path-replace-extension path (string->bytes/utf-8 (format " ~a~a.pdf" (if (< i 10) "0" "") i))))]
#:unless (file-exists? incremented-path))
incremented-path))
(define (make-proof family-name [doc-arg #f]
#:font-sizes [font-sizes-arg #false] #:font-sizes [font-sizes-arg #false]
#:page-size [page-size-arg #false] #:page-size [page-size-arg #false]
#:line-heights [line-heights-arg #false] #:line-heights [line-heights-arg #false]
#:output-file-path [output-file-path-arg #false]) #:output-file-path [output-file-path-arg #false]
(define page-size (or page-size-arg "letter")) #:replace [replace #false])
(define font-sizes (string-split (or font-sizes-arg "12 10.5 9")))
(define line-heights (string-split (or line-heights-arg "1.25em")))
(define output-file-path (define output-file-path
(or output-file-path-arg (build-path (find-system-path 'desk-dir) (match (path->complete-path
(format "~a proof.pdf" family-name)))) (or output-file-path-arg
(displayln (format "generating test for ~a" family-name)) (build-path (find-system-path 'desk-dir)
(render-pdf (format "~a proof.pdf" family-name))))
`(q [(? file-exists? path) #:when (not replace)
((page-size ,page-size) (displayln (format "File \"~a\" exists" path))
(page-margin-left "12p") (display "Overwrite? [y]es [n]o [k]eep both: ")
(page-margin-right "12p") (case (read)
(font-family ,family-name) [(y yes) path]
(footer-display "true") [(k keep) (increment-path path)]
(line-wrap "best")) [else #false])]
,@(add-between [path path]))
(for*/list ([font-size (in-list font-sizes)] (when output-file-path
[line-height (in-list line-heights)]) (displayln (format "generating test for ~a" family-name))
`(q ((font-size ,font-size) (define page-size (or page-size-arg "letter"))
(line-height ,line-height) (define font-sizes (string-split (or font-sizes-arg "12 10.5 9")))
(footer-text ,(format "~a test ~a/~a · ~a" (define line-heights (string-split (or line-heights-arg "1.25em")))
(define sample-text (or doc-arg "no doc provided"))
(define doc-interior
(cons 'q
(add-between
(for*/list ([font-size (in-list font-sizes)]
[line-height (in-list line-heights)])
(attr-set*
(list
'q sample-text)
'font-size font-size
'line-height line-height
'footer-text (format "~a test ~a/~a · ~a"
family-name family-name
font-size font-size
line-height line-height
(date->string (current-date) #t)))) (date->string (current-date) #t))))
,doc)) page-break)))
section-break)) (define doc (attr-set*
output-file-path)) doc-interior
'page-size page-size
'page-margin-left "12p"
'page-margin-right "12p"
'font-family family-name
'footer-display "true"
'line-wrap "best"))
(render-pdf doc output-file-path)))
Write Preview
Loading…
Cancel
Save