mbutterick
/
typesetting
2
1
Fork 0
Code Issues 13 Pull Requests Projects Releases Wiki Activity

put offset properties under markup

Browse Source
main
Matthew Butterick 6 years ago
parent fce85ca7a7
commit 3febe20e5b
3 changed files with 56 additions and 49 deletions
Show Stats Download Patch File Download Diff File

6
quad/qtest/fark.rkt
Unescape Escape View File

@ -1,9 +1,11 @@
#lang qtest/markdown #lang qtest/markdown
> what could happen on two lines that doesn't happen in one > what could happen on two lines
> that doesn't happen in one
oh my
``` ```
tell me tell me
I dono I, donut
``` ```

87
quad/qtest/markdown.rkt
Unescape Escape View File

@ -23,7 +23,10 @@
hrbr) hrbr)
(define-tag-function (blockquote attrs exprs) (define-tag-function (blockquote attrs exprs)
(qexpr (list* '(container "bq") '(font "fira") '(fontsize "10") '(line-height "11") '(left-inset "5") attrs) exprs)) (qexpr (list* '(container "bq")
'(font "fira") '(fontsize "10") '(line-height "13.5")
'(inset-top "1") '(inset-bottom "7") '(inset-left "8")
attrs) exprs))
(define id (default-tag-function 'id)) (define id (default-tag-function 'id))
(define class (default-tag-function 'class)) (define class (default-tag-function 'class))
@ -60,10 +63,10 @@
[str (in-list (string-split (string-join (get-elements expr) "") "\n"))]) [str (in-list (string-split (string-join (get-elements expr) "") "\n"))])
`(,(get-tag expr) ,(get-attrs expr) ,str)) `(,(get-tag expr) ,(get-attrs expr) ,str))
lbr)) lbr))
(qexpr (list* '(container "codeblock") '(line-height "13") '(left-inset "12") '(right-inset "12") attrs) new-exprs)) (qexpr (list* '(container "codeblock") '(line-height "13") '(inset-left "12") '(inset-right "12") attrs) new-exprs))
(define (list-base attrs exprs [bullet-val #f]) (define (list-base attrs exprs [bullet-val #f])
(qexpr (list* '(left-inset "20") attrs) (qexpr (list* '(inset-left "20") attrs)
(add-between (add-between
(for/list ([(expr idx) (in-indexed exprs)]) (for/list ([(expr idx) (in-indexed exprs)])
(list* (get-tag expr) (cons (list 'list-index (or bullet-val (format "~a." (add1 idx)))) (get-attrs expr)) (get-elements expr))) (list* (get-tag expr) (cons (list 'list-index (or bullet-val (format "~a." (add1 idx)))) (get-attrs expr)) (get-elements expr)))
@ -87,7 +90,7 @@
#:draw (λ (q doc) #:draw (λ (q doc)
(when (pair? (quad-elems q)) (when (pair? (quad-elems q))
(font doc (path->string (hash-ref (quad-attrs q) 'font))) (font doc (path->string (hash-ref (quad-attrs q) 'font)))
(font-size doc (string->number (hash-ref (quad-attrs q) 'fontsize "12"))) (font-size doc (hash-ref (quad-attrs q) 'fontsize 12))
(fill-color doc (hash-ref (quad-attrs q) 'color "black")) (fill-color doc (hash-ref (quad-attrs q) 'color "black"))
(define str (unsafe-car (quad-elems q))) (define str (unsafe-car (quad-elems q)))
(match-define (list x y) (quad-origin q)) (match-define (list x y) (quad-origin q))
@ -105,7 +108,7 @@
(define-runtime-path fira-mono "fonts/fira-mono.ttf") (define-runtime-path fira-mono "fonts/fira-mono.ttf")
(define default-font-face charter) (define default-font-face charter)
(define default-font-size "12") (define default-font-size 12)
(define (->string-quad doc q) (define (->string-quad doc q)
(cond (cond
@ -133,13 +136,12 @@
attrs)] attrs)]
[elems (quad-elems q)] [elems (quad-elems q)]
[size (delay [size (delay
(define fontsize (string->number (hash-ref (quad-attrs q) 'fontsize))) (define fontsize (hash-ref (quad-attrs q) 'fontsize))
(font-size doc fontsize) (font-size doc fontsize)
(font doc (path->string (hash-ref (quad-attrs q) 'font))) (font doc (path->string (hash-ref (quad-attrs q) 'font)))
(define str (if (pair? (quad-elems q)) (unsafe-car (quad-elems q)) "")) (define str (if (pair? (quad-elems q)) (unsafe-car (quad-elems q)) ""))
(define line-height (cond (define line-height (cond
[(and (pair? (quad-elems q)) [(and (pair? (quad-elems q)) (quad-ref q 'line-height))]
(string->number (quad-ref q 'line-height "NaN")))]
[else (current-line-height doc)])) [else (current-line-height doc)]))
(pt (string-width doc str) line-height))])])) (pt (string-width doc str) line-height))])]))
@ -161,7 +163,7 @@
(define dumb-hardcoded-value 380.1234) (define dumb-hardcoded-value 380.1234)
(define q:line (q #:size (pt dumb-hardcoded-value line-height) (define q:line (q #:size (pt dumb-hardcoded-value line-height)
#:in 'nw #:in 'nw
#:inner 'sw ; puts baseline at lower right corner of line box #:inner 'sw
#:out 'sw #:out 'sw
#:printable #true #:printable #true
#:draw-start draw-debug)) #:draw-start draw-debug))
@ -206,9 +208,17 @@
(check-true (line-break? (second (quad-elems (q "foo" pbr "bar"))))) (check-true (line-break? (second (quad-elems (q "foo" pbr "bar")))))
(check-true (line-break? (second (atomize (q "foo" pbr "bar")))))) (check-true (line-break? (second (atomize (q "foo" pbr "bar"))))))
(define (copy-block-attrs source-hash dest-hash)
(define block-attrs '(container inset-top inset-bottom))
(for ([k (in-list block-attrs)])
(cond
[(hash-ref source-hash k #f) => (λ (val) (hash-set! dest-hash k val))]))
dest-hash)
(define (line-wrap xs wrap-size) (define (line-wrap xs wrap-size)
(wrap xs (λ (q idx) (- wrap-size (string->number (quad-ref q 'left-inset "0")) (wrap xs (λ (q idx) (- wrap-size
(string->number (quad-ref q 'right-inset "0")))) (quad-ref q 'inset-left 0)
(quad-ref q 'inset-right 0)))
#:hard-break line-break? #:hard-break line-break?
#:soft-break soft-break-for-line? #:soft-break soft-break-for-line?
#:finish-wrap #:finish-wrap
@ -219,42 +229,33 @@
[(hr-break? q) [(hr-break? q)
(list (struct-copy quad q:line (list (struct-copy quad q:line
[draw-start (λ (dq doc) [draw-start (λ (dq doc)
(save doc)
(match-define (list left top) (quad-origin dq)) (match-define (list left top) (quad-origin dq))
(match-define (list right bottom)(size dq)) (match-define (list right bottom)(size dq))
(translate doc left (+ top (/ bottom 2))) (translate doc left (+ top (/ bottom 2)))
(move-to doc 0 0) (move-to doc 0 0)
(line-to doc right 0) (line-to doc right 0)
(line-width doc 3) (line-width doc 3)
(stroke doc "#999") (stroke doc "#999"))]))]
(restore doc))]))]
[else [else
(match (consolidate-runs pcs)
(define new-elems (consolidate-runs pcs)) [(? pair? elems)
(cond (define elem (unsafe-car elems))
[(pair? new-elems)
(list (struct-copy quad q:line (list (struct-copy quad q:line
[attrs (let ([attrs (hash-copy (quad-attrs q:line))]) [attrs (copy-block-attrs (quad-attrs elem)
(define container-val (quad-ref (unsafe-car new-elems) 'container)) (hash-copy (quad-attrs q:line)))]
(when (and container-val
(for/and ([elem (in-list (unsafe-cdr new-elems))])
(equal? (quad-ref elem 'container)
container-val)))
(hash-set! attrs 'container container-val))
attrs)]
[size (let () [size (let ()
(define line-heights (define line-heights
(filter-map (filter-map
(λ (q) (string->number (quad-ref q 'line-height "NaN"))) (λ (q) (quad-ref q 'line-height))
pcs)) pcs))
(match-define (list w h) (quad-size q:line)) (match-define (list w h) (quad-size q:line))
(pt w (if (empty? line-heights) h (apply max line-heights))))] (pt w (if (empty? line-heights) h (apply max line-heights))))]
[elems new-elems] [elems elems]
[offset (pt [offset (pt
(string->number (quad-ref (car new-elems) 'left-inset "0")) (quad-ref elem 'inset-left 0)
(second (quad-offset q:line)))] (second (quad-offset q:line)))]
[draw-end (match (and (or (para-break? q) (not q)) [draw-end (match (and (or (para-break? q) (not q))
(quad-ref (car new-elems) 'list-index)) (quad-ref elem 'list-index))
[#false void] [#false void]
[val (λ (q doc) [val (λ (q doc)
(save doc) (save doc)
@ -262,7 +263,7 @@
(quad-origin (car (quad-elems q)))) (quad-origin (car (quad-elems q))))
(text doc val x y) (text doc val x y)
(restore doc))])]))] (restore doc))])]))]
[else null])]) [_ null])])
(if (and (para-break? q) (not (hr-break? q))) (if (and (para-break? q) (not (hr-break? q)))
(list q:line-spacer) (list q:line-spacer)
null))))) null)))))
@ -270,11 +271,11 @@
(define top-margin 60) (define top-margin 60)
(define bottom-margin 120) (define bottom-margin 120)
(define side-margin 120) (define side-margin 120)
(define page-offset (pt (/ side-margin 3) (/ top-margin 3))) (define page-offset (pt (/ side-margin 4) (/ top-margin 3)))
(require racket/date) (require racket/date)
(define q:page (q #:offset page-offset (define q:page (q #:offset page-offset
#:draw-start (λ (q doc) (add-page doc) #:draw-start (λ (q doc) (add-page doc)
(scale doc 2 2)) (scale doc 3 3))
#:draw-end (λ (q doc) #:draw-end (λ (q doc)
(font-size doc 10) (font-size doc 10)
(font doc charter) (font doc charter)
@ -288,23 +289,25 @@
(define q:doc (q #:draw-start (λ (q doc) (start-doc doc)) (define q:doc (q #:draw-start (λ (q doc) (start-doc doc))
#:draw-end (λ (q doc) (end-doc doc)))) #:draw-end (λ (q doc) (end-doc doc))))
(define (make-blockquote pcs) (define (make-blockquote lines)
(define first-line (car lines))
(q #:attrs (hasheq 'type "bq") (q #:attrs (hasheq 'type "bq")
#:in 'nw #:in 'nw
#:out 'sw #:out 'sw
#:elems pcs #:offset (pt 0 (quad-ref first-line 'inset-top 0))
#:size (delay (pt (pt-x (size (car pcs))) #:elems lines
(for/sum ([pc (in-list pcs)]) #:size (delay (pt (pt-x (size first-line)) ;
(pt-y (size pc))))) (+ (for/sum ([line (in-list lines)])
(pt-y (size line)))
(quad-ref first-line 'inset-top 0)
(quad-ref first-line 'inset-bottom 0))))
#:draw-start (λ (q doc) #:draw-start (λ (q doc)
(save doc)
(match-define (list left top) (quad-origin q)) (match-define (list left top) (quad-origin q))
(match-define (list right bottom) (size q)) (match-define (list right bottom) (size q))
#;(rect doc (- left 4) (+ top 6) right (+ bottom 2)) #;(rect doc (- left 4) (+ top 6) right (+ bottom 2))
(rect doc left top right (+ bottom 4)) (rect doc left top right bottom)
(line-width doc 1) (line-width doc 1)
(fill-and-stroke doc "#eee" "#999") (fill-and-stroke doc "#eee" "#999"))))
(restore doc))))
(define (make-codeblock pcs) (define (make-codeblock pcs)
(q #:attrs (hasheq 'type "codeblock") (q #:attrs (hasheq 'type "codeblock")

12
quad/quad/qexpr.rkt
Unescape Escape View File

@ -63,7 +63,7 @@
(define (hash->qattrs attr-hash) (define (hash->qattrs attr-hash)
(for/list ([(k v) (in-dict (hash->list attr-hash))]) (for/list ([(k v) (in-dict (hash->list attr-hash))])
(list k (format "~a" v)))) (list k (format "~a" v))))
(define (quad->qexpr q) (define (quad->qexpr q)
(let loop ([x q]) (let loop ([x q])
@ -79,9 +79,11 @@
[(cons (? valid-tag?) rest) [(cons (? valid-tag?) rest)
(match rest (match rest
[(list (? txexpr-attrs? attrs) (? qexpr? elems) ...) [(list (? txexpr-attrs? attrs) (? qexpr? elems) ...)
(define mheq (make-hash)) (define mheq (make-hash)) ; want mutable hash
(for ([attr-pair (in-list attrs)]) (for ([kv (in-list attrs)])
(apply hash-set! mheq attr-pair)) (match-define (list k v) kv)
;; coerce number strings to actual numbers
(hash-set! mheq k (or (string->number v) v)))
(q #:attrs mheq #:elems (map loop elems))] (q #:attrs mheq #:elems (map loop elems))]
[(list (? qexpr? elems) ...) [(list (? qexpr? elems) ...)
(q #:elems (map loop elems))])] (q #:elems (map loop elems))])]
@ -90,7 +92,7 @@
(module+ test (module+ test
(check-equal? (check-equal?
(qexpr->quad `(q ((font "Charter") (fontsize "12")) (q "Foo bar") ,(make-quad "zzz") (q "Zim Zam"))) (qexpr->quad `(q ((font "Charter") (fontsize "12")) (q "Foo bar") ,(make-quad "zzz") (q "Zim Zam")))
(q (hasheq 'font "Charter" 'fontsize "12") (q "Foo bar") (q "zzz") (q "Zim Zam")))) (q (hasheq 'font "Charter" 'fontsize 12) (q "Foo bar") (q "zzz") (q "Zim Zam"))))
(define (qml->qexpr x) (define (qml->qexpr x)
(parameterize ([permissive-xexprs #t] (parameterize ([permissive-xexprs #t]

Write Preview
Loading…
Cancel
Save