From 6011e383e64bb481213d5b71f0d94f1132e5127f Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 19 Apr 2019 17:03:05 -0700 Subject: [PATCH] unfoob --- quad/quadwriter/core.rkt | 7 +++-- quad/quadwriter/font.rkt | 1 + quad/quadwriter/lang-helper.rkt | 12 ++++++++- quad/quadwriter/main.rkt | 28 +++++--------------- quad/quadwriter/markdown.rkt | 27 ++++++------------- quad/quadwriter/reader-helper.rkt | 44 ------------------------------- 6 files changed, 30 insertions(+), 89 deletions(-) delete mode 100644 quad/quadwriter/reader-helper.rkt diff --git a/quad/quadwriter/core.rkt b/quad/quadwriter/core.rkt index f07d2236..64d67cc1 100644 --- a/quad/quadwriter/core.rkt +++ b/quad/quadwriter/core.rkt @@ -98,8 +98,7 @@ (fill doc stroke-color) (restore doc))) -(define dumb-hardcoded-line-height 16) -(define q:line (q #:size (pt 0 dumb-hardcoded-line-height) +(define q:line (q #:size (pt 0 default-line-height) #:inner 'sw #:out 'sw #:printable #true @@ -107,7 +106,7 @@ (struct line-spacer quad () #:transparent) (define q:line-spacer (q #:type line-spacer - #:size (pt 0 (* dumb-hardcoded-line-height 0.6)) + #:size (pt 0 (* default-line-height 0.6)) #:out 'sw #:printable (λ (q sig) (not (memq sig '(start end)))) #:draw-start (if (draw-debug-line?) draw-debug void))) @@ -235,7 +234,7 @@ (define (hr-draw dq doc) (match-define (list left top) (quad-origin dq)) - (match-define (list right bottom)(size dq)) + (match-define (list right bottom) (size dq)) (save doc) (translate doc left (+ top (/ bottom 2))) (move-to doc 0 0) diff --git a/quad/quadwriter/font.rkt b/quad/quadwriter/font.rkt index 27bc96b3..8ecffa1c 100644 --- a/quad/quadwriter/font.rkt +++ b/quad/quadwriter/font.rkt @@ -9,6 +9,7 @@ (define-runtime-path default-font-face "fonts/source-serif/SourceSerifPro-Regular.otf") (define default-font-family "source-serif") (define default-font-size 12) +(define default-line-height 16) (define font-paths (make-hash)) diff --git a/quad/quadwriter/lang-helper.rkt b/quad/quadwriter/lang-helper.rkt index ea6b6504..98709406 100644 --- a/quad/quadwriter/lang-helper.rkt +++ b/quad/quadwriter/lang-helper.rkt @@ -1,11 +1,21 @@ #lang debug racket/base (require (for-syntax racket/base) racket/match + syntax/strip-context scribble/reader quadwriter/core txexpr) (provide (all-defined-out)) +(define ((make-read-syntax expander-mod pt-proc) path-string p) + (strip-context + (with-syntax ([PATH-STRING path-string] + [PT (pt-proc path-string p)] + [EXPANDER-MOD expander-mod]) + #'(module _ EXPANDER-MOD + PATH-STRING + . PT)))) + (define-syntax-rule (make-mb DOC-PROC) (begin (provide (rename-out [mb #%module-begin])) @@ -41,4 +51,4 @@ (match x [(txexpr tag attrs elems) (list* tag (cons 'attr-list attrs) (map loop elems))] [(? list? xs) (map loop xs)] - [_ x]))) \ No newline at end of file + [_ x]))) diff --git a/quad/quadwriter/main.rkt b/quad/quadwriter/main.rkt index f62cdce3..1195c4d0 100644 --- a/quad/quadwriter/main.rkt +++ b/quad/quadwriter/main.rkt @@ -1,26 +1,12 @@ #lang debug racket/base -(require (for-syntax racket/base) - quadwriter/core - pollen/tag - "lang-helper.rkt" - quad) -(provide (except-out (all-from-out racket/base) #%module-begin) - q) +(require pollen/tag "lang-helper.rkt") +(provide #%top #%datum #%app #%top-interaction q) (define q (default-tag-function 'q)) - -(define (doc-proc strs) (cons 'q strs)) +(define (doc-proc strs) (apply q strs)) (make-mb doc-proc) -(module+ reader - (require scribble/reader syntax/strip-context "lang-helper.rkt") - (provide (rename-out [quadwriter-rs read-syntax])) - - (define (quadwriter-rs path-string p) - (define stxs (quad-at-reader path-string p)) - (strip-context - (with-syntax ([STXS stxs] - [PDF-PATH (path-replace-extension path-string #".pdf")]) - #'(module _ quadwriter/main - PDF-PATH - . STXS))))) \ No newline at end of file +(module reader racket/base + (require "lang-helper.rkt") + (provide read-syntax) + (define read-syntax (make-read-syntax 'quadwriter quad-at-reader))) \ No newline at end of file diff --git a/quad/quadwriter/markdown.rkt b/quad/quadwriter/markdown.rkt index 7429385a..a03394ec 100644 --- a/quad/quadwriter/markdown.rkt +++ b/quad/quadwriter/markdown.rkt @@ -1,12 +1,11 @@ #lang debug racket/base -(require (for-syntax) - racket/list +(require racket/list racket/match quadwriter/core "tags.rkt" "lang-helper.rkt") (provide (all-defined-out) - #%app #%datum #%top-interaction + #%app #%top #%datum #%top-interaction (all-from-out "tags.rkt")) (define rsquo "’") @@ -19,27 +18,17 @@ (define (doc-proc exprs) (define strs (match exprs - [(? null?) '(" ")] + [(? null?) '(" ")] ; single nonbreaking space, so something prints [strs strs])) + ;; markdown parser returns list of paragraphs (root null (add-between strs (list pbr) #:before-first (list pbr) #:after-last (list pbr) #:splice? #true))) - (make-mb doc-proc) (module reader racket/base - (require syntax/strip-context - racket/port - (only-in markdown parse-markdown) - "lang-helper.rkt") - (provide (rename-out [rs read-syntax])) - - (define (rs path-string p) - (define pt (xexpr->parse-tree (parse-markdown (port->string p)))) - (strip-context - (with-syntax ([PATH-STRING path-string] - [PT pt]) - #'(module _ quadwriter/markdown - PATH-STRING - . PT))))) \ No newline at end of file + (require racket/port markdown "lang-helper.rkt") + (provide read-syntax) + (define read-syntax (make-read-syntax 'quadwriter/markdown + (λ (path-string p) (xexpr->parse-tree (parse-markdown (port->string p))))))) \ No newline at end of file diff --git a/quad/quadwriter/reader-helper.rkt b/quad/quadwriter/reader-helper.rkt deleted file mode 100644 index 8ea5f0f1..00000000 --- a/quad/quadwriter/reader-helper.rkt +++ /dev/null @@ -1,44 +0,0 @@ -#lang debug racket/base -(require (for-syntax racket/base) - racket/match - scribble/reader - quadwriter/core - txexpr) -(provide (all-defined-out)) - -(define-syntax-rule (make-mb DOC-PROC) - (begin - (provide #%module-begin) - (define-syntax (#%module-begin stx) - (syntax-case stx () - [(_ PATH-STRING . EXPRS) - (with-syntax ([DOC (datum->syntax #'PATH-STRING 'doc)]) - #'(#%module-begin - ;; stick an nbsp in the strings so we have one printing char - (define DOC (DOC-PROC (list . EXPRS))) - (provide DOC) - (module+ main - (render-pdf DOC (path-string->pdf-path 'PATH-STRING)))))])))) - -(define (path-string->pdf-path path-string) - (match (format "~a" path-string) - ;; 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 - #:syntax? #t - #:inside? #t - #:command-char #\◊)) - -(define (xexpr->parse-tree x) - ;; an ordinary txexpr can't serve as a parse tree because of the attrs list fails when passed to #%app. - ;; so stick an `attr-list` identifier on it which can hook into the expander. - ;; sort of SXML-ish. - (let loop ([x x]) - (match x - [(txexpr tag attrs elems) (list* tag (cons 'attr-list attrs) (map loop elems))] - [(? list? xs) (map loop xs)] - [_ x]))) \ No newline at end of file