From 959a63399368cdb808886d559e87f5cc56f5cb85 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 4 Apr 2020 15:16:51 -0700 Subject: [PATCH] edge --- quad/fontproof/command.rkt | 57 ++++++++++++++++++-------- quad/fontproof/main.rkt | 82 +++++++++++++++++++++++++------------- 2 files changed, 94 insertions(+), 45 deletions(-) diff --git a/quad/fontproof/command.rkt b/quad/fontproof/command.rkt index f9d04011..605c2701 100755 --- a/quad/fontproof/command.rkt +++ b/quad/fontproof/command.rkt @@ -2,34 +2,57 @@ (require "main.rkt") (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)]) (vector-ref (current-command-line-arguments) 0))) - (dispatch command-name)) + (dispatch command-name text)) (module+ main (println "this is fontproof command")) -(define (dispatch command-name) +(define (dispatch command-name text) (when (positive? (vector-length (current-command-line-arguments))) (define output-file-path #false) (define page-size #false) (define font-sizes #false) (define line-heights #false) + (define doc #false) + (define replace #false) (define families - (command-line #:program "fontproof" - #:argv (current-command-line-arguments) - #:once-each - [("-p" "--page") page-size-arg "page size" (set! page-size page-size-arg)] - [("-o" "--output") output-file-path-arg "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" "--line") line-heights-arg "line heights" (set! line-heights line-heights-arg)] - #:args families - families)) - (for ([family (in-list families)]) - (make-proof family - #:page-size page-size - #:font-sizes font-sizes - #:line-heights line-heights - #:output-file-path output-file-path)))) + (command-line + #:program "fontproof" + #:argv (current-command-line-arguments) + #:once-each + [("-p" "--page") page-size-arg + "page size" + (set! page-size page-size-arg)] + [("-r" "--replace") "replace existing" + (set! replace #true)] + [("-d" "--doc") doc-arg + "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 + "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))]))) diff --git a/quad/fontproof/main.rkt b/quad/fontproof/main.rkt index fa7968ba..a7457662 100755 --- a/quad/fontproof/main.rkt +++ b/quad/fontproof/main.rkt @@ -1,42 +1,68 @@ -#lang racket/base +#lang debug racket/base (require quadwriter/core racket/date racket/string - racket/list) + racket/list + racket/match + txexpr) (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] #:page-size [page-size-arg #false] #:line-heights [line-heights-arg #false] - #:output-file-path [output-file-path-arg #false]) - (define page-size (or page-size-arg "letter")) - (define font-sizes (string-split (or font-sizes-arg "12 10.5 9"))) - (define line-heights (string-split (or line-heights-arg "1.25em"))) + #:output-file-path [output-file-path-arg #false] + #:replace [replace #false]) (define output-file-path - (or output-file-path-arg (build-path (find-system-path 'desk-dir) - (format "~a proof.pdf" family-name)))) - (displayln (format "generating test for ~a" family-name)) - (render-pdf - `(q - ((page-size ,page-size) - (page-margin-left "12p") - (page-margin-right "12p") - (font-family ,family-name) - (footer-display "true") - (line-wrap "best")) - ,@(add-between - (for*/list ([font-size (in-list font-sizes)] - [line-height (in-list line-heights)]) - `(q ((font-size ,font-size) - (line-height ,line-height) - (footer-text ,(format "~a test ~a/~a · ~a" + (match (path->complete-path + (or output-file-path-arg + (build-path (find-system-path 'desk-dir) + (format "~a proof.pdf" family-name)))) + [(? file-exists? path) #:when (not replace) + (displayln (format "File \"~a\" exists" path)) + (display "Overwrite? [y]es [n]o [k]eep both: ") + (case (read) + [(y yes) path] + [(k keep) (increment-path path)] + [else #false])] + [path path])) + (when output-file-path + (displayln (format "generating test for ~a" family-name)) + (define page-size (or page-size-arg "letter")) + (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 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 font-size line-height (date->string (current-date) #t)))) - ,doc)) - section-break)) - output-file-path)) \ No newline at end of file + page-break))) + (define doc (attr-set* + 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))) \ No newline at end of file