more

quad/quadwriter/core.rkt

@@ -1,8 +1,5 @@
 #lang debug racket/base
-(require (for-syntax racket/base)
-         racket/runtime-path
-         racket/path
-         racket/string
+(require (for-syntax)
          racket/promise
          racket/match
          racket/list
@@ -12,7 +9,9 @@
          quad
          sugar/debug
          racket/unsafe/ops
-         hyphenate)
+         hyphenate
+         "param.rkt"
+         "font.rkt")
 
 (provide hrbr lbr pbr run default-font-size default-font-face)
 
@@ -50,12 +49,7 @@
                                    (λ (q doc) (draw-debug q doc "#99f" "#ccf"))
                                    void)))
 
-(define-runtime-path quadwriter-fonts-dir "fonts")
-(define-runtime-path default-font-face "fonts/charter/charter.otf")
-(define default-font-family "charter")
-(define default-font-size 12)
 
-(define current-doc (make-parameter #f))
 
 (define (make-size-promise q [str-arg #f])
   (delay
@@ -500,76 +494,6 @@
                [#false line-group]
                [_ (list (block-wrap line-group))]))))
 
-(define font-paths (make-hash))
-
-(define (setup-font-path-table! base-path)
-  ;; populate `font-paths` table with font paths
-  ;; search "fonts" subdirectory in project for other subdirectories
-  ;; which are presumed to contain fonts.
-  ;; and link them to their family names & styles.
-  ;; this allows a flexible mapping from internal to external names, like @font-face
-  ;; note that all the semantics are derived from the file system
-  ;; not any metadata fields within the font.
-  ;; this is faster and easier, because you can just muck with the directory and filenames
-  ;; to change the font mapping.
-  ;; though it also creates the potential for mischief,
-  ;; if a font is named something that doesn't reflect its visual reality.
-  ;; but we are not the font police.
-  (define-values (dir path _) (split-path #R base-path))
-  (define doc-fonts-dir (build-path #R dir "fonts"))
-  ;; run doc-fonts-dir first because earlier fonts take precedence
-  (for* ([fonts-dir (in-list (list quadwriter-fonts-dir doc-fonts-dir ))]
-         #:when (directory-exists? fonts-dir)
-         [font-family-subdir (in-directory fonts-dir)]
-         #:when (directory-exists? font-family-subdir)
-         [font-path (in-directory font-family-subdir)]
-         #:when (member (path-get-extension font-path) '(#".otf" #".ttf")))
-    (match-define (list font-path-string family-name)
-      (map (λ (x) (path->string (find-relative-path fonts-dir x))) (list font-path font-family-subdir)))
-    (define key
-      (cons family-name
-            (match (string-downcase font-path-string)
-              [(and (regexp "bold") (regexp "italic")) 'bi]
-              [(regexp "bold") 'b]
-              [(regexp "italic") 'i]
-              [_ 'r])))
-    ;; only set value if there's not one there already.
-    ;; this means that we only use the first eligible font we find.
-    (hash-ref! font-paths key font-path)))
-
-(define (font-attrs->path font-family bold italic)
-  ;; find the font-path corresponding to a certain family name and style.
-  (define key (cons font-family
-                    (cond
-                      [(and bold italic) 'bi]
-                      [bold 'b]
-                      [italic 'i]
-                      [else 'r])))
-  (define regular-key (cons font-family 'r))
-  (cond
-    [(hash-ref font-paths key #false)]
-    ;; if there isn't one, try the regular style.
-    [(hash-ref font-paths regular-key #false)]
-    ;; If there isn't one, use the default.
-    [else default-font-face]))
-
-(define (resolve-font-path attrs)
-  (define this-font-family (hash-ref! attrs 'font-family default-font-family))
-  (define this-bold (hash-ref! attrs 'font-bold #false))
-  (define this-italic (hash-ref! attrs 'font-italic #false))
-  (hash-set! attrs 'font-path (font-attrs->path this-font-family this-bold this-italic)))
-
-(define (parse-percentage pstr)
-  (/ (string->number (string-trim pstr "%")) 100.0))
-
-(define (resolve-font-size attrs)
-  (define this-font-size (hash-ref! attrs 'font-size default-font-size))
-  (define this-font-size-adjust (parse-percentage (hash-ref! attrs 'font-size-adjust "100%")))
-  ;; we bake the adjustment into the font size...
-  (hash-set! attrs 'font-size (* this-font-size this-font-size-adjust))
-  ;; and then set the adjustment back to 100% (since it's now accounted for)
-  (hash-set! attrs 'font-size-adjust "100%"))
-
 (define (handle-cascading-attrs attrs)
   (resolve-font-path attrs)
   (resolve-font-size attrs))
@@ -599,9 +523,9 @@
                                             #:height (if zoom-mode? 400 792))))
   (define line-width (- (pdf-width pdf) (* 2 side-margin)))
   (define vertical-height (- (pdf-height pdf) top-margin bottom-margin))
-  (setup-font-path-table! pdf-path)
   (parameterize ([current-doc pdf]
                  [verbose-quad-printing? #false])
+    (setup-font-path-table! pdf-path)
     (let* ([x (time-name parse-qexpr (qexpr->quad  `(q ((font-family ,default-font-family)
                                                         (font-size ,(number->string default-font-size))) ,xs)))]
            [x (time-name atomize (atomize x #:attrs-proc handle-cascading-attrs))]

quad/quadwriter/font.rkt

@@ -0,0 +1,82 @@
+#lang debug racket/base
+(require racket/runtime-path
+         racket/string
+         racket/path
+         racket/match)
+(provide (all-defined-out))
+
+(define-runtime-path quadwriter-fonts-dir "fonts")
+(define-runtime-path default-font-face "fonts/source-serif/SourceSerifPro-Regular.otf")
+(define default-font-family "source-serif")
+(define default-font-size 12)
+
+(define font-paths (make-hash))
+
+(define (setup-font-path-table! base-path)
+  ;; populate `font-paths` table with font paths
+  ;; search "fonts" subdirectory in project for other subdirectories
+  ;; which are presumed to contain fonts.
+  ;; and link them to their family names & styles.
+  ;; this allows a flexible mapping from internal to external names, like @font-face
+  ;; note that all the semantics are derived from the file system
+  ;; not any metadata fields within the font.
+  ;; this is faster and easier, because you can just muck with the directory and filenames
+  ;; to change the font mapping.
+  ;; though it also creates the potential for mischief,
+  ;; if a font is named something that doesn't reflect its visual reality.
+  ;; but we are not the font police.
+  (hash-clear! font-paths)
+  (define-values (dir path _) (split-path base-path))
+  (define doc-fonts-dir (build-path dir "fonts"))
+  ;; run doc-fonts-dir first because earlier fonts take precedence
+  (for* ([fonts-dir (in-list (list quadwriter-fonts-dir doc-fonts-dir ))]
+         #:when (directory-exists? fonts-dir)
+         [font-family-subdir (in-directory fonts-dir)]
+         #:when (directory-exists? font-family-subdir)
+         [font-path (in-directory font-family-subdir)]
+         #:when (member (path-get-extension font-path) '(#".otf" #".ttf")))
+    (match-define (list font-path-string family-name)
+      (map (λ (x) (path->string (find-relative-path fonts-dir x))) (list font-path font-family-subdir)))
+    (define key
+      (cons family-name
+            (match (string-downcase font-path-string)
+              [(and (regexp "bold") (regexp "it(alic)?")) 'bi]
+              [(regexp "bold") 'b]
+              [(regexp "it(alic)?") 'i]
+              [_ 'r])))
+    ;; only set value if there's not one there already.
+    ;; this means that we only use the first eligible font we find.
+    (hash-ref! font-paths key font-path)))
+
+(define (font-attrs->path font-family bold italic)
+  ;; find the font-path corresponding to a certain family name and style.
+  (define key (cons font-family
+                    (cond
+                      [(and bold italic) 'bi]
+                      [bold 'b]
+                      [italic 'i]
+                      [else 'r])))
+  (define regular-key (cons font-family 'r))
+  (cond
+    [(hash-ref font-paths key #false)]
+    ;; if there isn't one, try the regular style.
+    [(hash-ref font-paths regular-key #false)]
+    ;; If there isn't one, use the default.
+    [else default-font-face]))
+
+(define (resolve-font-path attrs)
+  (define this-font-family (hash-ref! attrs 'font-family default-font-family))
+  (define this-bold (hash-ref! attrs 'font-bold #false))
+  (define this-italic (hash-ref! attrs 'font-italic #false))
+  (hash-set! attrs 'font-path (font-attrs->path this-font-family this-bold this-italic)))
+
+(define (parse-percentage pstr)
+  (/ (string->number (string-trim pstr "%")) 100.0))
+
+(define (resolve-font-size attrs)
+  (define this-font-size (hash-ref! attrs 'font-size default-font-size))
+  (define this-font-size-adjust (parse-percentage (hash-ref! attrs 'font-size-adjust "100%")))
+  ;; we bake the adjustment into the font size...
+  (hash-set! attrs 'font-size (* this-font-size this-font-size-adjust))
+  ;; and then set the adjustment back to 100% (since it's now accounted for)
+  (hash-set! attrs 'font-size-adjust "100%"))

quad/quadwriter/fonts/source-serif/LICENSE.md

@@ -0,0 +1,93 @@
+Copyright 2014-2018 Adobe (http://www.adobe.com/), with Reserved Font Name 'Source'. All Rights Reserved. Source is a trademark of Adobe in the United States and/or other countries.
+
+This Font Software is licensed under the SIL Open Font License, Version 1.1.
+
+This license is copied below, and is also available with a FAQ at: http://scripts.sil.org/OFL
+
+
+-----------------------------------------------------------
+SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
+-----------------------------------------------------------
+
+PREAMBLE
+The goals of the Open Font License (OFL) are to stimulate worldwide
+development of collaborative font projects, to support the font creation
+efforts of academic and linguistic communities, and to provide a free and
+open framework in which fonts may be shared and improved in partnership
+with others.
+
+The OFL allows the licensed fonts to be used, studied, modified and
+redistributed freely as long as they are not sold by themselves. The
+fonts, including any derivative works, can be bundled, embedded,
+redistributed and/or sold with any software provided that any reserved
+names are not used by derivative works. The fonts and derivatives,
+however, cannot be released under any other type of license. The
+requirement for fonts to remain under this license does not apply
+to any document created using the fonts or their derivatives.
+
+DEFINITIONS
+"Font Software" refers to the set of files released by the Copyright
+Holder(s) under this license and clearly marked as such. This may
+include source files, build scripts and documentation.
+
+"Reserved Font Name" refers to any names specified as such after the
+copyright statement(s).
+
+"Original Version" refers to the collection of Font Software components as
+distributed by the Copyright Holder(s).
+
+"Modified Version" refers to any derivative made by adding to, deleting,
+or substituting -- in part or in whole -- any of the components of the
+Original Version, by changing formats or by porting the Font Software to a
+new environment.
+
+"Author" refers to any designer, engineer, programmer, technical
+writer or other person who contributed to the Font Software.
+
+PERMISSION & CONDITIONS
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of the Font Software, to use, study, copy, merge, embed, modify,
+redistribute, and sell modified and unmodified copies of the Font
+Software, subject to the following conditions:
+
+1) Neither the Font Software nor any of its individual components,
+in Original or Modified Versions, may be sold by itself.
+
+2) Original or Modified Versions of the Font Software may be bundled,
+redistributed and/or sold with any software, provided that each copy
+contains the above copyright notice and this license. These can be
+included either as stand-alone text files, human-readable headers or
+in the appropriate machine-readable metadata fields within text or
+binary files as long as those fields can be easily viewed by the user.
+
+3) No Modified Version of the Font Software may use the Reserved Font
+Name(s) unless explicit written permission is granted by the corresponding
+Copyright Holder. This restriction only applies to the primary font name as
+presented to the users.
+
+4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
+Software shall not be used to promote, endorse or advertise any
+Modified Version, except to acknowledge the contribution(s) of the
+Copyright Holder(s) and the Author(s) or with their explicit written
+permission.
+
+5) The Font Software, modified or unmodified, in part or in whole,
+must be distributed entirely under this license, and must not be
+distributed under any other license. The requirement for fonts to
+remain under this license does not apply to any document created
+using the Font Software.
+
+TERMINATION
+This license becomes null and void if any of the above conditions are
+not met.
+
+DISCLAIMER
+THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
+OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
+COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
+DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
+OTHER DEALINGS IN THE FONT SOFTWARE.

quad/quadwriter/markdown.rkt

@@ -3,7 +3,8 @@
          racket/list
          racket/match
          quadwriter/core
-         "tags.rkt")
+         "tags.rkt"
+         "reader-helper.rkt")
 (provide (except-out (all-defined-out) mb)
          (rename-out [mb #%module-begin])
          #%app #%datum #%top-interaction)
@@ -18,7 +19,7 @@
 (define ndash "–")
 (define mdash "—")
 
-(define-syntax-rule (mb PDF-PATH . STRS)
+(define-syntax-rule (mb PATH-STRING . STRS)
   (#%module-begin
    ;; stick an nbsp in the strings so we have one printing char
    (define strs (match (list . STRS)
@@ -28,21 +29,23 @@
                                       #:before-first (list pbr)
                                       #:after-last (list pbr)
                                       #:splice? #true)))
-   (run qx PDF-PATH)))
+   (run qx (path-string->pdf-path 'PATH-STRING))))
 
 (module reader racket/base
-  (require syntax/strip-context (only-in markdown parse-markdown) "reader-helper.rkt")
+  (require syntax/strip-context
+           (only-in markdown parse-markdown)
+           "reader-helper.rkt")
   (provide (rename-out [rs read-syntax]))
  
   (define (rs path-string p)
-    (define stx (quad-at-reader path-string p))
+    (define stxs (quad-at-reader path-string p))
     (define parsed-stxs
-      (datum->syntax stx
+      (datum->syntax stxs
                      (xexpr->parse-tree
-                      (parse-markdown (apply string-append (syntax->datum stx))))))
+                      (parse-markdown (apply string-append (syntax->datum stxs))))))
     (strip-context
-     (with-syntax ([STXS parsed-stxs]
-                   [PDF-PATH (path-string->pdf-path path-string)])
+     (with-syntax ([PATH-STRING path-string]
+                   [PARSED-STXS parsed-stxs])
        #'(module _ quadwriter/markdown
-           PDF-PATH
-           . STXS)))))
+           PATH-STRING
+           . PARSED-STXS)))))

quad/quadwriter/param.rkt

@@ -0,0 +1,3 @@
+#lang debug racket/base
+(provide (all-defined-out))
+(define current-doc (make-parameter #f))

quad/quadwriter/reader-helper.rkt

@@ -6,7 +6,10 @@
 
 (define (path-string->pdf-path path-string)
   (match (format "~a" path-string)
-    ["unsaved-editor" (build-path (find-system-path 'desk-dir) "untitled.pdf")]
+    ;; weird test but sometimes DrRacket calls the unsaved file
+    ;; 'unsaved-editor and sometimes "unsaved editor"
+    [(regexp #rx"unsaved.editor")
+     (build-path (find-system-path 'desk-dir) "untitled.pdf")]
     [_ (path-replace-extension path-string #".pdf")]))
 
 (define quad-at-reader (make-at-reader