You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
typesetting/quad/fontproof/command.rkt

95 lines
4.0 KiB
Racket

5 years ago
#lang debug racket
(require racket/logging
racket/match
"main.rkt")
5 years ago
(module+ raco
(with-logging-to-port
(current-error-port)
handle-raco-command
#:logger fontproof-logger
'info
'fontproof))
5 years ago
(module+ main
(println "this is fontproof command"))
(define (handle-raco-command)
(define command-name (with-handlers ([exn:fail? (λ (exn) #f)])
(vector-ref (current-command-line-arguments) 0)))
(define output-file-path #false)
(define page-size #false)
(define font-sizes #false)
(define line-heights #false)
(define doc #false)
(define replace #false)
(define output-qml? #false)
(define make-bold? #false)
(define make-italic? #false)
(define query-mode? #false)
(define families
(command-line
#:program "fontproof"
#:argv (current-command-line-arguments)
#:once-each
[("-p" "--page") page-size-arg
5 years ago
"page size (e.g., letter, A4)"
(set! page-size page-size-arg)]
5 years ago
[("-r" "--replace") "replace existing proof with same name"
(set! replace #true)]
[("-d" "--doc") doc-arg
5 years ago
"source for sample text"
(set! doc doc-arg)]
[("-o" "--output") output-file-path-arg
"output file path"
(set! output-file-path output-file-path-arg)]
[("-s" "--size") font-sizes-arg
5 years ago
"font sizes to proof"
(set! font-sizes font-sizes-arg)]
[("-l" "--leading") line-heights-arg
5 years ago
"line height"
(set! line-heights line-heights-arg)]
[("-b" "--bold") "also generate bold proof (only works with family name)"
(set! make-bold? #true)]
[("-i" "--italic") "also generate italic proof (only works with family name)"
(set! make-italic? #true)]
5 years ago
[("-q" "--qml") "output QML file"
(set! output-qml? #true)]
[("--query") "resolve each family name and font path and show status"
(set! query-mode? #true)]
#:args font-family-names-or-font-paths
font-family-names-or-font-paths))
(match families
[(? null?) (raise-user-error "no fonts to proof; exiting")]
[_ (for ([family (in-list families)])
(cond
[query-mode?
(define status
(match family
[(? font-path-string? ps)
(format (if (file-exists? ps) "found at ~v" "not found at ~v") (path->string (path->complete-path ps)))]
[_ (match-define-values (trimmed-family bold? italic?) (resolve-family-bold-italic family))
(match ((dynamic-require 'fontland/font-path 'family->path) trimmed-family #:bold bold? #:italic italic?)
[#false "not found among installed fonts"]
5 years ago
[(app path->string ps) (format "found installed at ~v" ps)])]))
(log-info (format "family ~v ~a" family status))]
[else
(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?)]))]))
5 years ago