tolerate fontlessness

main
Matthew Butterick 6 years ago
parent 170e13b719
commit 56e825cc9e

@ -275,18 +275,25 @@
[substr (in-list (regexp-match* (regexp (string hyphen-char)) hstr #:gap-select? #t))])
(struct-copy quad q [elems (list substr)]))]))))
(require sugar/list)
(define (fill-wrap qs ending-q)
(match-define (list line-width line-height) (quad-size q:line))
(match (quad-ref (car qs) 'line-align #f)
;; todo: how to detect last line of paragraph?
(match (and ending-q (pair? qs) (quad-ref (car qs) 'line-align #f))
["justify"
(define words (for/list ([q (in-list qs)]
#:unless (equal? (car (quad-elems q)) " "))
q))
(define words-width (pt-x (apply pt+ (map size words))))
(define empty-hspace (- line-width words-width))
(define space-width (/ empty-hspace (sub1 (length words))))
(add-between words (make-quad #:size (pt space-width line-height)))]
[_ qs]))
;; words may still be in hyphenated fragments
;; (though soft hyphens would have been removed)
(define word-sublists (filter-split qs (λ (q) (equal? (car (quad-elems q)) " "))))
(match (length word-sublists)
[1 qs] ; can't justify single word
[word-count
(define words-width (for*/sum ([word-sublist (in-list word-sublists)]
[word (in-list word-sublist)])
(pt-x (size word))))
(define empty-hspace (- line-width words-width))
(define space-width (/ empty-hspace (sub1 word-count)))
(apply append (add-between word-sublists (list (make-quad #:size (pt space-width line-height)))))])]
[_ qs]))
(define (line-wrap qs wrap-size)
(wrap qs

@ -20,14 +20,14 @@
(define ascender-cache (make-hash))
(define (ascender q)
(define font-key-val (quad-ref q font-path-key "Courier"))
(define font-key-val (quad-ref q font-path-key #false))
(unless font-key-val
(error 'ascender-no-font-key))
(hash-ref! ascender-cache font-key-val (λ () (font-ascent (get-font font-key-val)))))
(define units-cache (make-hash))
(define (units-per-em q)
(define font-key-val (quad-ref q font-path-key "Courier"))
(define font-key-val (quad-ref q font-path-key #false))
(unless font-key-val
(error 'units-per-em-no-font-key))
(hash-ref! units-cache font-key-val (λ () (font-units-per-em (get-font font-key-val)))))
@ -38,7 +38,7 @@
(define (vertical-baseline-offset q)
(cond
[(quad-ref q font-path-key #f)
[(quad-ref q font-path-key #false)
(* (/ (ascender q) (units-per-em q) 1.0) (fontsize q))]
[else 0]))
@ -53,7 +53,9 @@
[else (raise-argument-error 'anchor->local-point (format "anchor value in ~v" valid-anchors) anchor)]))
(match-define (list x y) (size q))
(pt (coerce-int (* x x-fac))
(coerce-int (+ (* y y-fac) (if (memq anchor '(bi bo)) (vertical-baseline-offset q) 0)))))
(coerce-int (+ (* y y-fac) (match anchor
[(or 'bi 'bo) (vertical-baseline-offset q)]
[_ 0])))))
(define (inner-point q)
;; calculate absolute location of inner-point

Loading…
Cancel
Save