fontproof demo

quad/fontproof/command.rkt

@@ -0,0 +1,35 @@
+#lang debug racket
+(require "main.rkt")
+
+(module+ raco
+  (define command-name (with-handlers ([exn:fail? (λ (exn) #f)])
+                         (vector-ref (current-command-line-arguments) 0)))
+  (dispatch command-name))
+
+(module+ main
+  (println "this is fontproof command"))
+
+(define (dispatch command-name)
+  (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 families
+      (command-line #:program "fontproof"
+                    #:argv (current-command-line-arguments)
+                    #:once-each
+                    [("--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)]
+                    [("--size") font-sizes-arg "font sizes" (set! font-sizes font-sizes-arg)]
+                    [("--leading") line-heights-arg "font size" (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))))
+
+

quad/fontproof/info.rkt

@@ -0,0 +1,3 @@
+#lang info
+
+(define raco-commands '(("fontproof" (submod fontproof/command raco) "issue fontproof command" #f)))

quad/fontproof/main.rkt

@@ -0,0 +1,42 @@
+#lang racket/base
+(require quadwriter/core
+         racket/date
+         racket/string
+         racket/list)
+(provide make-proof)
+
+(define doc "todo: more than nothing")
+
+(define (make-proof family-name
+                    #: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")))
+  (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"
+                                              family-name
+                                              font-size
+                                              line-height
+                                              (date->string (current-date) #t))))
+                       ,doc))
+        section-break))
+   output-file-path))