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

support bold, ital, qml

Browse Source
main
Matthew Butterick 4 years ago
parent ec31d4b920
commit a98f80843d
2 changed files with 158 additions and 100 deletions
Show Stats Download Patch File Download Diff File

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

@ -1,58 +1,78 @@
#lang debug racket #lang debug racket
(require "main.rkt") (require racket/logging
"main.rkt")
(module+ raco (module+ raco
;; pull text out of stdin, if any (with-logging-to-port
;; todo: make this cooperate with `read` for confirmation of replace (current-error-port)
(define text (string-join (for/list ([t (in-port read)]) handle-raco-command
(format "~a" t)) " ")) #:logger fontproof-logger
(define command-name (with-handlers ([exn:fail? (λ (exn) #f)]) 'info
(vector-ref (current-command-line-arguments) 0))) 'fontproof))
(dispatch command-name text))
(module+ main (module+ main
(println "this is fontproof command")) (println "this is fontproof command"))
(define (dispatch command-name text) (define (handle-raco-command)
(when (positive? (vector-length (current-command-line-arguments))) (define command-name (with-handlers ([exn:fail? (λ (exn) #f)])
(define output-file-path #false) (vector-ref (current-command-line-arguments) 0)))
(define page-size #false) (define output-file-path #false)
(define font-sizes #false) (define page-size #false)
(define line-heights #false) (define font-sizes #false)
(define doc #false) (define line-heights #false)
(define replace #false) (define doc #false)
(define families (define replace #false)
(command-line (define output-qml? #false)
#:program "fontproof" (define make-bold? #false)
#:argv (current-command-line-arguments) (define make-italic? #false)
#:once-each (define families
[("-p" "--page") page-size-arg (command-line
"page size" #:program "fontproof"
(set! page-size page-size-arg)] #:argv (current-command-line-arguments)
[("-r" "--replace") "replace existing" #:once-each
(set! replace #true)] [("-p" "--page") page-size-arg
[("-d" "--doc") doc-arg "page size"
"sample text" (set! page-size page-size-arg)]
(set! doc doc-arg)] [("-r" "--replace") "replace existing"
[("-o" "--output") output-file-path-arg (set! replace #true)]
"output file path" [("-d" "--doc") doc-arg
(set! output-file-path output-file-path-arg)] "sample text"
[("-s" "--size") font-sizes-arg (set! doc doc-arg)]
"font sizes" [("-o" "--output") output-file-path-arg
(set! font-sizes font-sizes-arg)] "output file path"
[("-l" "--leading") line-heights-arg (set! output-file-path output-file-path-arg)]
"font size" [("-s" "--size") font-sizes-arg
(set! line-heights line-heights-arg)] "font sizes"
#:args families (set! font-sizes font-sizes-arg)]
families)) [("-l" "--leading") line-heights-arg
(cond "font size"
[(null? families) (displayln "no family given")] (set! line-heights line-heights-arg)]
[else (for ([family (in-list families)]) [("-b" "--bold") "also generate bold proof"
(make-proof family (if (non-empty-string? text) text doc) (set! make-bold? #true)]
#:page-size page-size [("-i" "--italic") "also generate italic proof"
#:font-sizes font-sizes (set! make-italic? #true)]
#:line-heights line-heights [("-q" "--qml") "output QML"
#:output-file-path output-file-path (set! output-qml? #true)]
#:replace replace))]))) #:args families
families))
(match families
[(? null?) (raise-user-error "No font to proof. Exiting.")]
[_ (for ([family (in-list families)])
(make-proof family
(or doc (match (current-input-port)
;; pull text out of stdin, if any
;; use `terminal-port?` to distinguish piped input from tty input
[(not (? terminal-port?))
(string-join (for/list ([t (in-port read)])
(format "~a" t)) " ")]
[_ #false]))
#:page-size page-size
#:bold make-bold?
#:italic make-italic?
#:font-sizes font-sizes
#:line-heights line-heights
#:output-file-path output-file-path
#:replace replace
#:qml output-qml?))]))

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

@ -1,68 +1,106 @@
#lang debug racket/base #lang debug racket/base
(require quadwriter/core (require quadwriter/core
racket/date racket/date
racket/file
racket/string racket/string
racket/list racket/list
racket/match racket/match
txexpr) racket/path
(provide make-proof) txexpr
quad/qexpr)
(provide (all-defined-out))
(define-logger fontproof)
(define (increment-path path) (define (increment-path path)
(for*/first ([path (in-value path)] (for*/first ([i (in-naturals 2)]
[i (in-naturals 2)] [incremented-path (in-value
[incremented-path (in-value (path-replace-extension path (string->bytes/utf-8 (format " ~a~a.pdf" (if (< i 10) "0" "") i))))] (path-replace-extension path
(string->bytes/utf-8
(format " ~a~a.pdf" (if (< i 10) "0" "") i))))]
#:unless (file-exists? incremented-path)) #:unless (file-exists? incremented-path))
incremented-path)) incremented-path))
(define (make-proof family-name [doc-arg #f] (define (boolean->string bool) (if bool "true" "false"))
(define (make-proof font-or-qml [sample-text #f]
#:bold [make-bold #false]
#:italic [make-italic #false]
#: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]
#:qml [output-qml? #true]
#:replace [replace #false]) #:replace [replace #false])
(define output-file-path (define-values (doc output-file-path)
(match (path->complete-path (match font-or-qml
(or output-file-path-arg [(? qml-path? qml-ps)
(build-path (find-system-path 'desk-dir) (define doc (qml->qexpr (file->string qml-ps)))
(format "~a proof.pdf" family-name)))) (define output-file-path (path-replace-extension qml-ps #".pdf"))
[(? file-exists? path) #:when (not replace) (values doc output-file-path)]
(displayln (format "File \"~a\" exists" path)) [font-name-arg
(display "Overwrite? [y]es [n]o [k]eep both: ") (unless sample-text
(case (read) (raise-user-error "Nothing to proof. Exiting."))
[(y yes) path] (define-values (initial-font-family initial-font-bold initial-font-italic)
[(k keep) (increment-path path)] (let ([bi-suffix-pat #px"\\s*((?i:bold))?\\s*((?i:italic))?$"])
[else #false])] (match-define (list suffix bold? italic?) (regexp-match bi-suffix-pat font-name-arg))
[path path])) (values (string-trim font-name-arg suffix #:left? #false) bold? italic?)))
(when output-file-path (log-fontproof-info (format "generating proof for ~a" font-name-arg))
(displayln (format "generating test for ~a" family-name)) (define page-size (or page-size-arg "letter"))
(define page-size (or page-size-arg "letter")) (define font-sizes (string-split (or font-sizes-arg "12 10.5 9")))
(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 line-heights (string-split (or line-heights-arg "1.25em"))) (define bold-variants (cond
(define sample-text (or doc-arg "no doc provided")) [initial-font-bold '(#t)]
(define doc-interior [make-bold '(#f #t)]
(cons 'q [else '(#f)]))
(add-between (define italic-variants (cond
(for*/list ([font-size (in-list font-sizes)] [initial-font-italic '(#t)]
[line-height (in-list line-heights)]) [make-italic '(#f #t)]
(attr-set* [else '(#f)]))
(list (when (and initial-font-bold make-bold)
'q sample-text) (log-fontproof-info (format "starting font is bold; omitting bold proof~a" (match (length italic-variants) [2 "s"] [_ ""]))))
'font-size font-size (when (and initial-font-italic make-italic)
'line-height line-height (log-fontproof-info (format "starting font is italic; omitting italic proof~a" (format "starting font is bold; omitting bold proof~a" (match (length italic-variants) [2 "s"] [_ ""])))))
'footer-text (format "~a test ~a/~a · ~a" (define doc-interior
family-name (cons 'q
font-size (add-between
line-height (for*/list ([font-size (in-list font-sizes)]
(date->string (current-date) #t)))) [font-bold (in-list bold-variants)]
page-break))) [font-italic (in-list italic-variants)]
(define doc (attr-set* [line-height (in-list line-heights)])
doc-interior (attr-set*
'page-size page-size (list
'page-margin-left "12p" 'q sample-text)
'page-margin-right "12p" 'font-size font-size
'font-family family-name 'font-italic (boolean->string font-italic)
'hyphenate "false" 'font-bold (boolean->string font-bold)
'footer-display "true")) 'line-height line-height
(render-pdf doc output-file-path))) 'footer-text (format "~a test ~a/~a · ~a"
initial-font-family
font-size
line-height
(date->string (current-date) #t))))
page-break)))
(define doc (attr-set*
doc-interior
'page-size page-size
'page-margin-left "12p"
'page-margin-right "12p"
'font-family initial-font-family
'hyphenate "false"
'footer-display "true"))
(define output-file-path
(match (path->complete-path
(or output-file-path-arg
(build-path (find-system-path 'desk-dir)
(format "~a proof.pdf" font-name-arg))))
[(? file-exists? path) #:when (not replace) (increment-path path)]
[path path]))
(values doc output-file-path)]))
(begin0
(render-pdf doc output-file-path)
(when output-qml?
(define qml-path (path-replace-extension output-file-path #".qml"))
(call-with-output-file* qml-path
(λ (op) (display (qexpr->qml doc) op ))
#:exists 'replace))))
Write Preview
Loading…
Cancel
Save