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

page breaking, page numbers, embedded ttf

Browse Source
main
Matthew Butterick 6 years ago
parent 1a75e163e1
commit b1541fa772
5 changed files with 73 additions and 56 deletions
Show Stats Download Patch File Download Diff File

BIN
quad/quad/FiraMono-Regular.ttf
View File

Binary file not shown.

5
quad/quad/quad.rkt
Unescape Escape View File

@ -14,6 +14,9 @@
#:methods gen:quad
[(define (elems q) ($quad-elems q))
(define (attrs q) ($quad-attrs q))
;; why 'nw and 'ne as defaults for in and out points
;; if size is '(0 0), the points are the same, and everything piles up at the origin
;; if size is otherwise, the items don't pile up (but rather lay out in a row)
(define (in q) (hash-ref (attrs q) 'in 'nw))
(define (out q) (hash-ref (attrs q) 'out 'ne))
(define (inner q) (hash-ref (attrs q) 'inner (λ () (in q))))
@ -23,7 +26,7 @@
[(procedure? v) (v signal)]
[(promise? v) (force v)]
[else v])))
(define (size q) (let ([v (hash-ref (attrs q) 'size '(1 1))])
(define (size q) (let ([v (hash-ref (attrs q) 'size '(0 0))])
(cond
[(procedure? v) (v)]
[(promise? v) (force v)]

4
quad/quad/typewriter-test.rkt
Unescape Escape View File

@ -1,5 +1,3 @@
#lang quad/typewriter
To get started with Racket, download it from the web page and install it. If you are a beginner or would like to use a graphical environment to run programs, run the DrRacket executable. Otherwise, the racket executable will run a command-line Read-Eval-Print-Loop (REPL).
@(number->string (current-seconds))
An expression that is not a value can always be partitioned into two parts: a redex, which is the part that changed in a single-step simplification (highlighted), and the continuation, which is the evaluation context surrounding an expression. In (- 4 (+ 1 1)), the redex is (+ 1 1), and the continuation is (- 4 []), where [] takes the place of the redex. That is, the continuation says how to "continue" after the redex is reduced to a value.

40
quad/quad/typewriter.rkt
Unescape Escape View File

@ -10,20 +10,18 @@
($char (hash-set* (attrs q)
'size (const '(7.2 12))
'printable? (case (car (elems q))
[(#\u00AD)
(λ (sig) (case sig
[(end) #t]
[else #f]))]
[(#\space) (λ (sig) (case sig
[(start end) #f]
[else #t]))]
[(#\u00AD) (λ (sig) (memq sig '(end)))]
[(#\space) (λ (sig) (not (memq sig '(start end))))]
[else #t])
'draw (λ (q doc) (send/apply doc text (apply string (elems q)) (origin q)))) (elems q)))
'draw (λ (q doc)
(send doc fontSize 12)
(send/apply doc text (apply string (elems q)) (origin q)))) (elems q)))
(struct $line $quad () #:transparent)
(struct $page $quad () #:transparent)
(struct $doc $quad () #:transparent)
(struct $break $quad () #:transparent)
(define (break . xs) ($break (hasheq 'printable? #f) xs))
(define page-count 1)
(define (break . xs) ($break (hasheq 'printable? #f 'size '(0 0)) xs))
(define line-height 16)
(define consolidate-into-runs? #t)
@ -39,32 +37,42 @@
(if consolidate-into-runs?
(list ($char (attrs (car pcs)) (append-map elems pcs)))
pcs))))))
(define pb ($break (hasheq 'printable? #f
'size '(0 0)
'draw (λ (q doc)
(send doc addPage)
(send doc fontSize 10)
(send doc text (string-append "page " (number->string page-count)) 10 10)
(set! page-count (add1 page-count)))) '(#\page)))
(define (page-wrap xs size [debug #f])
(wrap xs size debug
#:break-val (break #\page)
#:break-before? #t
#:break-val pb
#:optional-break-proc $break?
#:finish-wrap-proc (λ (pcs) (list ($page (hasheq) (filter-not $break? pcs))))))
(define (typeset args)
(define chars 33)
(define chars 25)
(define line-width (* 7.2 chars))
(define lines-per-page (* 40 line-height))
(define lines-per-page (* 4 line-height))
(position ($doc (hasheq 'origin '(36 36)) (page-wrap (line-wrap (map charify (atomize (apply quad #f args))) line-width) lines-per-page))))
(require hyphenate)
(require hyphenate racket/runtime-path pollen/unstable/typography)
(define-runtime-path fira-mono "FiraMono-Regular.ttf")
(define-macro (mb . ARGS)
(with-pattern ([PS (syntax-property #'ARGS 'ps)])
#'(#%module-begin
(define q (typeset (map hyphenate (list . ARGS))))
(define q (typeset (map hyphenate (map smart-quotes (list . ARGS)))))
;q
(let ([doc (make-object PDFDocument
(hasheq 'compress #t
'autoFirstPage #f
'size '(300 400)))])
(send* doc
[pipe (open-output-file PS #:exists 'replace)]
[font "Courier"]
[registerFont "Fira-Mono" (path->string fira-mono)]
[font "Fira-Mono"]
[fontSize 12])
(draw q doc)
(send doc end))

80
quad/quad/wrap.rkt
Unescape Escape View File

@ -19,11 +19,15 @@
[target-size (current-wrap-distance)]
[debug #f]
#:break-val [break-val 'break]
#:break-before? [break-before? #f]
#:break-after? [break-after? #f]
#:mandatory-break-proc [mandatory-break? (const #f)]
#:optional-break-proc [optional-break? (const #f)]
#:finish-wrap-proc [finish-wrap-proc values])
((any/c) (real? any/c
#:break-val any/c
#:break-before? boolean?
#:break-after? boolean?
#:mandatory-break-proc procedure?
#:optional-break-proc procedure?
#:finish-wrap-proc procedure?) . ->* . (listof any/c))
@ -41,7 +45,8 @@
[(null? xs)
;; combine the segments into a flat list, and drop any trailing breaks
;; (on the idea that breaks should separate things, and there's nothing left to separate)
(dropf-right (append* (reverse (cons (finish-wrap wrap-pieces) wraps))) (λ (x) (eq? x break-val)))]
(define results (dropf-right (append* (reverse (cons (finish-wrap wrap-pieces) wraps))) (λ (x) (eq? x break-val))))
(append (if break-before? (list break-val) empty) results (if break-after? (list break-val) empty))]
[else
(define x (car xs))
(define at-start? (eq? dist-so-far start-signal))
@ -111,17 +116,17 @@
(insert-break 'before)])])))))
(define x (q #f #\x))
(define x (q (list 'size (pt 1 1)) #\x))
(define zwx (q (list 'size (pt 0 0)) #\z))
(define hyph (q #f #\-))
(define hyph (q (list 'size (pt 1 1)) #\-))
(define shy (q (list 'size (pt 1 1) 'printable? (λ (sig)
(case sig
[(end) #t]
[else #f]))) #\-))
(define a (q #f #\a))
(define b (q #f #\b))
(define c (q #f #\c))
(define d (q #f #\d))
(define a (q (list 'size (pt 1 1)) #\a))
(define b (q (list 'size (pt 1 1)) #\b))
(define c (q (list 'size (pt 1 1)) #\c))
(define d (q (list 'size (pt 1 1)) #\d))
(define sp (q (list 'size (pt 1 1) 'printable? (λ (sig)
(case sig
[(start end) #f]
@ -225,11 +230,13 @@
(check-equal? (linewrap (list x x x sp x x) 2) (list x x 'lb x 'lb x x))
(check-equal? (linewrap (list x x x sp x x) 3) (list x x x 'lb x x))))
(define (visual-wrap str int [debug #f])
(apply string (for/list ([b (in-list (linewrap (atomize str) int debug))])
(cond
[(quad? b) (car (elems b))]
[else #\|]))))
(define (visual-wrap str int [debug #f])
(apply string (for/list ([b (in-list (linewrap (for/list ([atom (atomize str)])
($quad (hash-set (attrs atom) 'size '(1 1))
(elems atom))) int debug))])
(cond
[(quad? b) (car (elems b))]
[else #\|]))))
(module+ test
(test-case
"visual breaks"
@ -251,39 +258,40 @@
(check-equal? (visual-wrap "My dog has fleas" 16) "My dog has fleas")))
(define (pagewrap xs size [debug #f])
(wrap xs size debug
#:break-val 'pb
#:mandatory-break-proc (λ (x) (and (quad? x) (memv (car (elems x)) '(#\page))))
#:optional-break-proc (λ (x) (eq? x 'lb))))
(define pbr (q '(size #f) #\page))
(define (pagewrap xs size [debug #f])
(wrap xs size debug
#:break-val 'pb
#:break-before? #t
#:mandatory-break-proc (λ (x) (and (quad? x) (memv (car (elems x)) '(#\page))))
#:optional-break-proc (λ (x) (eq? x 'lb))))
(define pbr (q '(size #f) #\page))
(module+ test
(test-case
"soft page breaks"
(check-equal? (pagewrap null 2) null)
(check-equal? (pagewrap (list x) 2) (list x))
(check-equal? (pagewrap (list x x) 2) (list x x))
(check-equal? (pagewrap (list x x x) 1) (list x 'pb x 'pb x))
(check-equal? (pagewrap (list x x x) 2) (list x x 'pb x))
(check-equal? (pagewrap (list x x x) 3) (list x x x))
(check-equal? (pagewrap (list x x x) 4) (list x x x))
(check-equal? (pagewrap (list x 'lb x x) 2) (list x 'pb x x)))
(check-equal? (pagewrap null 2) '(pb))
(check-equal? (pagewrap (list x) 2) (list 'pb x))
(check-equal? (pagewrap (list x x) 2) (list 'pb x x))
(check-equal? (pagewrap (list x x x) 1) (list 'pb x 'pb x 'pb x))
(check-equal? (pagewrap (list x x x) 2) (list 'pb x x 'pb x))
(check-equal? (pagewrap (list x x x) 3) (list 'pb x x x))
(check-equal? (pagewrap (list x x x) 4) (list 'pb x x x))
(check-equal? (pagewrap (list x 'lb x x) 2) (list 'pb x 'pb x x)))
(test-case
"hard page breaks"
(check-equal? (pagewrap (list x pbr x x) 2) (list x 'pb x x))
(check-equal? (pagewrap (list x pbr x x) 1) (list x 'pb x 'pb x))
(check-equal? (pagewrap (list x pbr pbr x x) 1) (list x 'pb 'pb x 'pb x))
(check-equal? (pagewrap (list x pbr pbr x x) 2) (list x 'pb 'pb x x))
(check-equal? (pagewrap (list 'lb x 'lb 'lb pbr 'lb x x 'lb) 2) (list x 'pb x x)))
(check-equal? (pagewrap (list x pbr x x) 2) (list 'pb x 'pb x x))
(check-equal? (pagewrap (list x pbr x x) 1) (list 'pb x 'pb x 'pb x))
(check-equal? (pagewrap (list x pbr pbr x x) 1) (list 'pb x 'pb 'pb x 'pb x))
(check-equal? (pagewrap (list x pbr pbr x x) 2) (list 'pb x 'pb 'pb x x))
(check-equal? (pagewrap (list 'lb x 'lb 'lb pbr 'lb x x 'lb) 2) (list 'pb x 'pb x x)))
(test-case
"composed line breaks and page breaks"
(check-equal? (pagewrap (linewrap null 1) 2) null)
(check-equal? (pagewrap (linewrap (list x) 1) 2) (list x))
(check-equal? (pagewrap (linewrap (list x x x) 1) 2) (list x 'lb x 'pb x))
(check-equal? (pagewrap (linewrap (list x x x) 2) 2) (list x x 'pb x))
(check-equal? (pagewrap (linewrap (list x x x) 2) 1) (list x 'pb x 'pb x))))
(check-equal? (pagewrap (linewrap null 1) 2) '(pb) )
(check-equal? (pagewrap (linewrap (list x) 1) 2) (list 'pb x))
(check-equal? (pagewrap (linewrap (list x x x) 1) 2) (list 'pb x 'lb x 'pb x))
(check-equal? (pagewrap (linewrap (list x x x) 2) 2) (list 'pb x x 'pb x))
(check-equal? (pagewrap (linewrap (list x x x) 2) 1) (list 'pb x 'pb x 'pb x))))
(struct $slug $quad () #:transparent)
(define (slug . xs) ($slug #f xs))

Write Preview
Loading…
Cancel
Save