diff --git a/quad/quadwriter/core.rkt b/quad/quadwriter/core.rkt index 572f0ad8..94f6833f 100644 --- a/quad/quadwriter/core.rkt +++ b/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))] diff --git a/quad/quadwriter/font.rkt b/quad/quadwriter/font.rkt new file mode 100644 index 00000000..27bc96b3 --- /dev/null +++ b/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%")) diff --git a/quad/quadwriter/fonts/source-serif/LICENSE.md b/quad/quadwriter/fonts/source-serif/LICENSE.md new file mode 100755 index 00000000..09be3f61 --- /dev/null +++ b/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. diff --git a/quad/quadwriter/fonts/source-serif/SourceSerifPro-Bold.otf b/quad/quadwriter/fonts/source-serif/SourceSerifPro-Bold.otf new file mode 100755 index 00000000..bb640dca Binary files /dev/null and b/quad/quadwriter/fonts/source-serif/SourceSerifPro-Bold.otf differ diff --git a/quad/quadwriter/fonts/source-serif/SourceSerifPro-BoldIt.otf b/quad/quadwriter/fonts/source-serif/SourceSerifPro-BoldIt.otf new file mode 100755 index 00000000..7da8ec15 Binary files /dev/null and b/quad/quadwriter/fonts/source-serif/SourceSerifPro-BoldIt.otf differ diff --git a/quad/quadwriter/fonts/source-serif/SourceSerifPro-It.otf b/quad/quadwriter/fonts/source-serif/SourceSerifPro-It.otf new file mode 100755 index 00000000..f2d4c157 Binary files /dev/null and b/quad/quadwriter/fonts/source-serif/SourceSerifPro-It.otf differ diff --git a/quad/quadwriter/fonts/source-serif/SourceSerifPro-Regular.otf b/quad/quadwriter/fonts/source-serif/SourceSerifPro-Regular.otf new file mode 100755 index 00000000..4ff89331 Binary files /dev/null and b/quad/quadwriter/fonts/source-serif/SourceSerifPro-Regular.otf differ diff --git a/quad/quadwriter/markdown.rkt b/quad/quadwriter/markdown.rkt index fb86317b..88bfeab4 100644 --- a/quad/quadwriter/markdown.rkt +++ b/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))))) \ No newline at end of file + PATH-STRING + . PARSED-STXS))))) \ No newline at end of file diff --git a/quad/quadwriter/param.rkt b/quad/quadwriter/param.rkt new file mode 100644 index 00000000..e8d29062 --- /dev/null +++ b/quad/quadwriter/param.rkt @@ -0,0 +1,3 @@ +#lang debug racket/base +(provide (all-defined-out)) +(define current-doc (make-parameter #f)) \ No newline at end of file diff --git a/quad/quadwriter/reader-helper.rkt b/quad/quadwriter/reader-helper.rkt index 56ce2cdd..1c6c6f79 100644 --- a/quad/quadwriter/reader-helper.rkt +++ b/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