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

headings

Browse Source
main
Matthew Butterick 6 years ago
parent 0ddddd771b
commit 07c820fd35
3 changed files with 71 additions and 29 deletions
Show Stats Download Patch File Download Diff File

BIN
quad/qtest/fonts/fira-light.ttf
View File

Binary file not shown.

7
quad/qtest/hyphenate.rkt
Unescape Escape View File

@ -1,11 +1,15 @@
#lang qtest/markdown #lang qtest/markdown
# Hyphenate
A simple _hyphenation engine_ that uses the Knuth–Liang hyphenation algorithm originally developed for TeX. A simple _hyphenation engine_ that uses the Knuth–Liang hyphenation algorithm originally developed for TeX.
I **have added little** to their work. Accordingly, I take no credit, except a spoonful of *snako-bits.* I **have added little** to their work. Accordingly, I take no credit, except a spoonful of *snako-bits.*
And now, for something __altogether__ the same. And now, for something __altogether__ the same.
## 1. Installation
At the command line: At the command line:
We said `raco pkg install hyphenate` dude We said `raco pkg install hyphenate` dude
@ -16,4 +20,5 @@ Hyphenate `xexpr` by calculating hyphenation points and inserting
`joiner` at those points. By default, `joiner` is the soft hyphen `joiner` at those points. By default, `joiner` is the soft hyphen
\(Unicode 00AD = decimal 173\). Words shorter than \(Unicode 00AD = decimal 173\). Words shorter than
`#:min-length` `length` will not be hyphenated. To hyphenate words of `#:min-length` `length` will not be hyphenated. To hyphenate words of
any length, use `#:min-length` `#f`. any length, use `#:min-length` `#f`.

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

@ -1,6 +1,6 @@
#lang debug racket/base #lang debug racket/base
(require (for-syntax racket/base) racket/runtime-path racket/string racket/promise racket/match racket/list (require (for-syntax racket/base) racket/runtime-path racket/string racket/promise racket/match racket/list
pitfall quad sugar/debug markdown pollen/tag (prefix-in pt: pollen/top)) pitfall quad sugar/debug markdown pollen/tag (prefix-in pt: pollen/top))
(provide (except-out (all-from-out racket/base) #%module-begin #%top) (provide (except-out (all-from-out racket/base) #%module-begin #%top)
(rename-out [mb #%module-begin][pt:#%top #%top]) (rename-out [mb #%module-begin][pt:#%top #%top])
(all-defined-out)) (all-defined-out))
@ -8,8 +8,18 @@
(define-syntax-rule (p attrs . exprs) (define-syntax-rule (p attrs . exprs)
(list 'q 'attrs . exprs)) (list 'q 'attrs . exprs))
(define-syntax-rule (h1 attrs . exprs)
(list 'q (list* '(font "fira") '(fontsize "36") '(line-height "48") 'attrs) . exprs))
(define-syntax-rule (h2 attrs . exprs)
(list 'q (list* '(font "fira") '(fontsize "24") '(line-height "36") 'attrs) . exprs))
(define-syntax-rule (code attrs . exprs) (define-syntax-rule (code attrs . exprs)
(list 'q (list* '(font "fira-mono") '(fontsize "11") '(bg "lightgray") 'attrs) . exprs)) (list 'q (list* '(font "fira-mono") '(fontsize "11") '(bg "aliceblue") 'attrs) . exprs))
(define-syntax-rule (pre attrs . exprs)
(list 'q 'attrs . exprs))
(define-syntax-rule (strong attrs . exprs) (define-syntax-rule (strong attrs . exprs)
(list 'q (cons '(font "charter-bold") 'attrs) . exprs)) (list 'q (cons '(font "charter-bold") 'attrs) . exprs))
@ -34,40 +44,59 @@
(define-runtime-path charter "fonts/charter.ttf") (define-runtime-path charter "fonts/charter.ttf")
(define-runtime-path charter-bold "fonts/charter-bold.ttf") (define-runtime-path charter-bold "fonts/charter-bold.ttf")
(define-runtime-path charter-italic "fonts/charter-italic.ttf") (define-runtime-path charter-italic "fonts/charter-italic.ttf")
(define-runtime-path fira "fonts/fira.ttf") (define-runtime-path fira "fonts/fira-light.ttf")
(define-runtime-path fira-mono "fonts/fira-mono.ttf") (define-runtime-path fira-mono "fonts/fira-mono.ttf")
(define (->string-quad doc q) (define (->string-quad doc q)
(struct-copy quad q:string (struct-copy
[attrs (let ([attrs (quad-attrs q)]) quad q:string
;; attrs hashes are shared between many quads. [attrs (let ([attrs (quad-attrs q)])
;; so the first update will change every reference to the shared hash ;; attrs hashes are shared between many quads.
;; hence why we ignore if val is already a path ;; so the first update will change every reference to the shared hash
;; but this op should ideally happen earlier ;; hence why we ignore if val is already a path
(hash-update! attrs 'font (λ (val) (if (path? val) ;; but this op should ideally happen earlier
val (hash-update! attrs 'font
(match (string-downcase (string-replace val " " "-")) (λ (val) (if (path? val)
["charter" charter] val
["charter-bold" charter-bold] (match (string-downcase (string-replace val " " "-"))
["charter-italic" charter-italic] ["charter" charter]
["fira" fira] ["charter-bold" charter-bold]
["fira-mono" fira-mono])))) ["charter-italic" charter-italic]
attrs)] ["fira" fira]
[elems (quad-elems q)] ["fira-mono" fira-mono]))))
[size (delay attrs)]
(define fontsize (string->number (hash-ref (quad-attrs q) 'fontsize))) [elems (quad-elems q)]
(font-size doc fontsize) [size (delay
(font doc (path->string (hash-ref (quad-attrs q) 'font))) (define fontsize (string->number (hash-ref (quad-attrs q) 'fontsize)))
(define str (car (quad-elems q))) (font-size doc fontsize)
(pt (string-width doc str) (current-line-height doc)))])) (font doc (path->string (hash-ref (quad-attrs q) 'font)))
(define str (car (quad-elems q)))
(pt (string-width doc str) (current-line-height doc)))]))
(define (draw-debug q doc)
(save doc)
(line-width doc 0.5)
(apply rect doc (append (quad-origin q) (size q)))
(stroke doc "#fcc")
(apply rect doc (append (quad-origin q) (size q)))
(clip doc)
(circle doc (pt-x (in-point q)) (pt-y (in-point q)) 3)
(circle doc (pt-x (out-point q)) (pt-y (out-point q)) 3)
(fill doc "#f99")
(restore doc))
(define line-height 20) (define line-height 20)
(define q:line (q #:size (pt +inf.0 line-height) (define q:line (q #:size (pt 380 line-height)
#:in 'nw
#:inner 'sw ; puts baseline at bottom of line box
#:out 'sw #:out 'sw
#:printable #true)) #:printable #true
#:draw (λ (q doc)
#;(draw-debug q doc)
(default-draw q doc))))
(struct line-spacer quad () #:transparent) (struct line-spacer quad () #:transparent)
(define q:line-spacer (q #:type line-spacer (define q:line-spacer (q #:type line-spacer
#:size (pt +inf.0 (* line-height 0.7)) #:size (pt 380 (* line-height 0.7))
#:out 'sw #:out 'sw
#:printable (λ (q sig) #:printable (λ (q sig)
(not (memq sig '(start end)))))) (not (memq sig '(start end))))))
@ -101,6 +130,14 @@
(append (append
(if (= idx 1) (list q:line-spacer) null) (if (= idx 1) (list q:line-spacer) null)
(list (struct-copy quad q:line (list (struct-copy quad q:line
[size (let ()
(define line-heights
(filter-map
(λ (q) (string->number (hash-ref (quad-attrs q) 'line-height "NaN")))
pcs))
(match-define (list w h) (quad-size q:line))
;; when `line-heights` is empty, this is just h
(pt w (apply max (cons h line-heights))))]
[elems (consolidate-runs pcs)])))))) [elems (consolidate-runs pcs)]))))))
(define q:page (q #:offset '(36 36) (define q:page (q #:offset '(36 36)

Write Preview
Loading…
Cancel
Save