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

Revert "pairify pts"

Browse Source 
This reverts commit 7296e8f41b.
main
Matthew Butterick 6 years ago
parent 7296e8f41b
commit 165241cbc4
4 changed files with 53 additions and 60 deletions
Show Stats Download Patch File Download Diff File

14
quad/qtest/typewriter.rkt
Unescape Escape View File

@ -38,12 +38,12 @@
[(hash-has-key? (quad-attrs q) 'link) [(hash-has-key? (quad-attrs q) 'link)
(save doc) (save doc)
(fill-color doc "blue") (fill-color doc "blue")
(text doc str (pt-x (quad-origin q)) (pt-y (quad-origin q)) (hasheq 'link (hash-ref (quad-attrs q) 'link))) (text doc str (first (quad-origin q)) (second (quad-origin q)) (hasheq 'link (hash-ref (quad-attrs q) 'link)))
(restore doc)] (restore doc)]
[else [else
#;(println str) #;(println str)
(void) (void)
(text doc str (pt-x (quad-origin q)) (pt-y (quad-origin q)))]))))) (apply text doc str (quad-origin q))])))))
(define (quadify doc q) (define (quadify doc q)
(struct-copy quad $textish (struct-copy quad $textish
@ -54,17 +54,17 @@
(define str (car (quad-elems q))) (define str (car (quad-elems q)))
(font-size doc fontsize) (font-size doc fontsize)
(font doc (path->string charter)) (font doc (path->string charter))
(pt (list
(string-width doc str) (string-width doc str)
(current-line-height doc)))])) (current-line-height doc)))]))
(define line-height 16) (define line-height 16)
(define $line (q #:attrs (hasheq 'type "line") (define $line (q #:attrs (hasheq 'type "line")
#:size (pt +inf.0 line-height) #:size (list +inf.0 line-height)
#:out 'sw #:out 'sw
#:printable #true)) #:printable #true))
(define $page (q #:attrs (hasheq 'type "page") (define $page (q #:attrs (hasheq 'type "page")
#:offset (pt 36 36) #:offset '(36 36)
#:pre-draw (λ (q doc) #:pre-draw (λ (q doc)
(add-page doc) (add-page doc)
(font-size doc 10) (font-size doc 10)
@ -81,7 +81,7 @@
(define page-count 1) (define page-count 1)
(define (make-break . xs) (q #:type $break (define (make-break . xs) (q #:type $break
#:printable #f #:printable #f
#:size (pt 0 0) #:size '(0 0)
#:elems xs)) #:elems xs))
(define (consolidate-runs pcs) (define (consolidate-runs pcs)
@ -95,7 +95,7 @@
[attrs (quad-attrs (car pcs))] [attrs (quad-attrs (car pcs))]
[elems (merge-adjacent-strings (apply append (for/list ([pc (in-list run-pcs)]) [elems (merge-adjacent-strings (apply append (for/list ([pc (in-list run-pcs)])
(quad-elems pc))))] (quad-elems pc))))]
[size (delay (pt (for/sum ([pc (in-list run-pcs)]) [size (delay (list (for/sum ([pc (in-list run-pcs)])
(pt-x (size pc))) (pt-x (size pc)))
(pt-y (size (car pcs)))))])) (pt-y (size (car pcs)))))]))
(values (cons new-run runs) rest))) (values (cons new-run runs) rest)))

2
quad/quad/break.rkt
Unescape Escape View File

@ -16,7 +16,7 @@
(λ () (λ ()
(cond (cond
[(quad? q) [(quad? q)
(match-define (cons ∆x ∆y) (pt- (out-point q) (in-point q))) (match-define (list ∆x ∆y) (map - (out-point q) (in-point q)))
(cond (cond
[(zero? ∆x) ∆y] [(zero? ∆x) ∆y]
[(zero? ∆y) ∆x] [(zero? ∆y) ∆x]

85
quad/quad/position.rkt
Unescape Escape View File

@ -2,15 +2,12 @@
(require racket/contract "quad.rkt" fontland) (require racket/contract "quad.rkt" fontland)
(provide (all-defined-out)) (provide (all-defined-out))
(define (fold-pts op pts) (for/fold ([x (pt-x (car pts))] (define pt-x first)
[y (pt-y (car pts))] (define pt-y second)
#:result (pt x y)) (define (pt x y) (list x y))
([pt (in-list (cdr pts))]) (define (pt+ . pts) (apply map + pts))
(values (op x (pt-x pt)) (op y (pt-y pt))))) (define (pt- . pts) (apply map - pts))
(define point? (list/c number? number?))
(define (pt+ . pts) (fold-pts + pts))
(define (pt- . pts) (fold-pts - pts))
(define point? (cons/c number? number?))
(define valid-anchors '(nw n ne w c e sw s se bi bo)) (define valid-anchors '(nw n ne w c e sw s se bi bo))
@ -50,16 +47,16 @@
(* (/ (ascender q) (units-per-em q) 1.0) (fontsize q))) (* (/ (ascender q) (units-per-em q) 1.0) (fontsize q)))
(define (anchor->local-point q anchor) (define (anchor->local-point q anchor)
;; calculate the location of the anchor on the bounding box relative to (pt 0 0) (aka "locally") ;; calculate the location of the anchor on the bounding box relative to '(0 0) (aka "locally")
(unless (valid-anchor? anchor) (unless (valid-anchor? anchor)
(raise-argument-error 'relative-anchor-pt "valid anchor" anchor)) (raise-argument-error 'relative-anchor-pt "valid anchor" anchor))
(match-define (cons x-fac y-fac) (match-define (list x-fac y-fac)
(case anchor (case anchor
[(nw) (pt 0 0 )] [(n) (pt 0.5 0 )] [(ne) (pt 1 0 )] [(nw) '(0 0 )] [(n) '(0.5 0 )] [(ne) '(1 0 )]
[( w) (pt 0 0.5)] [(c) (pt 0.5 0.5)] [( e) (pt 1 0.5)] [( w) '(0 0.5)] [(c) '(0.5 0.5)] [( e) '(1 0.5)]
[(sw) (pt 0 1 )] [(s) (pt 0.5 1 )] [(se) (pt 1 1 )] [(sw) '(0 1 )] [(s) '(0.5 1 )] [(se) '(1 1 )]
[(bi) (pt 0 0 )] [(bo) (pt 1 0 )])) [(bi) '(0 0 )] [(bo) '(1 0 )]))
(match-define (cons x y) (size q)) (match-define (list x y) (size q))
(pt (coerce-int (* x x-fac)) (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) (if (memq anchor '(bi bo)) (vertical-baseline-offset q) 0)))))
@ -100,18 +97,18 @@
(define size (pt 10 10)) (define size (pt 10 10))
(define orig (pt 5 5)) (define orig (pt 5 5))
(check-equal? (quad-origin (position (q #:in 'nw #:size size) orig)) (pt 5 5)) (check-equal? (quad-origin (position (q #:in 'nw #:size size) orig)) (pt 5 5))
;(check-equal? (quad-origin (position (q #:in 'n #:size size) orig)) (pt 0 5)) (check-equal? (quad-origin (position (q #:in 'n #:size size) orig)) (pt 0 5))
;(check-equal? (quad-origin (position (q #:in 'ne #:size size) orig)) (pt -5 5)) (check-equal? (quad-origin (position (q #:in 'ne #:size size) orig)) (pt -5 5))
;(check-equal? (quad-origin (position (q #:in 'e #:size size) orig)) (pt -5 0)) (check-equal? (quad-origin (position (q #:in 'e #:size size) orig)) (pt -5 0))
;(check-equal? (quad-origin (position (q #:in 'se #:size size) orig)) (pt -5 -5)) (check-equal? (quad-origin (position (q #:in 'se #:size size) orig)) (pt -5 -5))
;(check-equal? (quad-origin (position (q #:in 's #:size size) orig)) (pt 0 -5)) (check-equal? (quad-origin (position (q #:in 's #:size size) orig)) (pt 0 -5))
;(check-equal? (quad-origin (position (q #:in 'sw #:size size) orig)) (pt 5 -5)) (check-equal? (quad-origin (position (q #:in 'sw #:size size) orig)) (pt 5 -5))
#;(check-equal? (quad-origin (position (q #:in 'w #:size size) orig)) (pt 5 0))) (check-equal? (quad-origin (position (q #:in 'w #:size size) orig)) (pt 5 0)))
#;(test-case (test-case
"in points" "in points"
(define size (pt 10 10)) (define size '(10 10))
(define origin (pt 5 5)) (define origin '(5 5))
(check-equal? (in-point (q #:in 'nw #:size size #:origin origin)) (pt 5 5)) (check-equal? (in-point (q #:in 'nw #:size size #:origin origin)) (pt 5 5))
(check-equal? (in-point (q #:in 'n #:size size #:origin origin)) (pt 10 5)) (check-equal? (in-point (q #:in 'n #:size size #:origin origin)) (pt 10 5))
(check-equal? (in-point (q #:in 'ne #:size size #:origin origin)) (pt 15 5)) (check-equal? (in-point (q #:in 'ne #:size size #:origin origin)) (pt 15 5))
@ -122,7 +119,7 @@
(check-equal? (in-point (q #:in 's #:size size #:origin origin)) (pt 10 15)) (check-equal? (in-point (q #:in 's #:size size #:origin origin)) (pt 10 15))
(check-equal? (in-point (q #:in 'se #:size size #:origin origin)) (pt 15 15))) (check-equal? (in-point (q #:in 'se #:size size #:origin origin)) (pt 15 15)))
#;(test-case (test-case
"out points" "out points"
(define size (pt 10 10)) (define size (pt 10 10))
(define origin (pt 5 5)) (define origin (pt 5 5))
@ -136,10 +133,10 @@
(check-equal? (out-point (q #:out 's #:size size #:origin origin)) (pt 10 15)) (check-equal? (out-point (q #:out 's #:size size #:origin origin)) (pt 10 15))
(check-equal? (out-point (q #:out 'se #:size size #:origin origin)) (pt 15 15))) (check-equal? (out-point (q #:out 'se #:size size #:origin origin)) (pt 15 15)))
#;(test-case (test-case
"inner points" "inner points"
(define size (pt 20 20)) (define size '(20 20))
(define orig (pt 10 10)) (define orig '(10 10))
(check-equal? (inner-point (position (q #:size size #:inner 'nw) orig)) (pt 10 10)) (check-equal? (inner-point (position (q #:size size #:inner 'nw) orig)) (pt 10 10))
(check-equal? (inner-point (position (q #:size size #:inner 'n) orig)) (pt 20 10)) (check-equal? (inner-point (position (q #:size size #:inner 'n) orig)) (pt 20 10))
(check-equal? (inner-point (position (q #:size size #:inner 'ne) orig)) (pt 30 10)) (check-equal? (inner-point (position (q #:size size #:inner 'ne) orig)) (pt 30 10))
@ -149,33 +146,33 @@
(check-equal? (inner-point (position (q #:size size #:inner 'sw) orig)) (pt 10 30)) (check-equal? (inner-point (position (q #:size size #:inner 'sw) orig)) (pt 10 30))
(check-equal? (inner-point (position (q #:size size #:inner 'w) orig)) (pt 10 20))) (check-equal? (inner-point (position (q #:size size #:inner 'w) orig)) (pt 10 20)))
#;(test-case (test-case
"inner points with offsets" "inner points with offsets"
(define size (pt 10 10)) (define size (pt 10 10))
(define orig (pt 0 0)) (define orig (pt 0 0))
(define off (pt (random 100) (random 100))) (define off (pt (random 100) (random 100)))
(check-equal? (inner-point (position (q #:size size #:inner 'nw #:offset off) orig)) (pt+ (pt 0 0) off)) (check-equal? (inner-point (position (q #:size size #:inner 'nw #:offset off) orig)) (pt+ '(0 0) off))
(check-equal? (inner-point (position (q #:size size #:inner 'n #:offset off) orig)) (pt+ (pt 5 0) off)) (check-equal? (inner-point (position (q #:size size #:inner 'n #:offset off) orig)) (pt+ '(5 0) off))
(check-equal? (inner-point (position (q #:size size #:inner 'ne #:offset off) orig)) (pt+ (pt 10 0) off)) (check-equal? (inner-point (position (q #:size size #:inner 'ne #:offset off) orig)) (pt+ '(10 0) off))
(check-equal? (inner-point (position (q #:size size #:inner 'e #:offset off) orig)) (pt+ (pt 10 5) off)) (check-equal? (inner-point (position (q #:size size #:inner 'e #:offset off) orig)) (pt+ '(10 5) off))
(check-equal? (inner-point (position (q #:size size #:inner 'se #:offset off) orig)) (pt+ (pt 10 10) off)) (check-equal? (inner-point (position (q #:size size #:inner 'se #:offset off) orig)) (pt+ '(10 10) off))
(check-equal? (inner-point (position (q #:size size #:inner 's #:offset off) orig)) (pt+ (pt 5 10) off)) (check-equal? (inner-point (position (q #:size size #:inner 's #:offset off) orig)) (pt+ '(5 10) off))
(check-equal? (inner-point (position (q #:size size #:inner 'sw #:offset off) orig)) (pt+ (pt 0 10) off)) (check-equal? (inner-point (position (q #:size size #:inner 'sw #:offset off) orig)) (pt+ '(0 10) off))
(check-equal? (inner-point (position (q #:size size #:inner 'w #:offset off) orig)) (pt+ (pt 0 5) off)))) (check-equal? (inner-point (position (q #:size size #:inner 'w #:offset off) orig)) (pt+ '(0 5) off))))
(module+ test (module+ test
(require racket/runtime-path fontland/font) (require racket/runtime-path fontland/font)
(define-runtime-path fira "fira.ttf") (define-runtime-path fira "fira.ttf")
(define q1 (q (list 'in 'bi 'out 'bo 'size (pt 10 10) 'font fira 'fontsize 12))) (define q1 (q (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 12)))
(define q2 (q (list 'in 'bi 'out 'bo 'size (pt 10 10) 'font fira 'fontsize 24))) (define q2 (q (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 24)))
(define q3 (q (list 'in 'bi 'out 'bo 'size (pt 10 10) 'font fira 'fontsize 6))) (define q3 (q (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 6)))
#;(position (q #f q1 q2 q3))) #;(position (q #f q1 q2 q3)))
#;(module+ test #;(module+ test
(require rackunit) (require rackunit)
(define q (q (list 'in 'bi 'out 'bo 'size (pt 10 10) 'font fira 'fontsize 12))) (define q (q (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 12)))
(check-equal? (ascender q) 935) (check-equal? (ascender q) 935)
(check-equal? (units-per-em q) 1000) (check-equal? (units-per-em q) 1000)
(define ascender-scaled (* (/ (ascender q) (units-per-em q)) (hash-ref (quad-attrs q) 'fontsize) 1.0)) (define ascender-scaled (* (/ (ascender q) (units-per-em q)) (hash-ref (quad-attrs q) 'fontsize) 1.0))

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

@ -3,10 +3,6 @@
(provide (all-defined-out)) (provide (all-defined-out))
(module+ test (require rackunit)) (module+ test (require rackunit))
(define pt-x car)
(define pt-y cdr)
(define pt cons)
(define (size q) (define (size q)
(match (quad-size q) (match (quad-size q)
[(? procedure? proc) (proc q)] [(? procedure? proc) (proc q)]
@ -61,7 +57,7 @@
((quad-post-draw q) q surface)) ((quad-post-draw q) q surface))
;; why 'nw and 'ne as defaults for in and out points: ;; why 'nw and 'ne as defaults for in and out points:
;; if size is (pt 0 0), 'nw and 'ne are the same point, ;; if size is '(0 0), 'nw and 'ne are the same point,
;; and everything piles up at the origin ;; and everything piles up at the origin
;; if size is otherwise, the items don't pile up (but rather lay out in a row) ;; if size is otherwise, the items don't pile up (but rather lay out in a row)
@ -71,12 +67,12 @@
#:type [type quad] #:type [type quad]
#:attrs [attrs (make-hasheq)] #:attrs [attrs (make-hasheq)]
#:elems [elems null] #:elems [elems null]
#:size [size (pt 0 0)] #:size [size '(0 0)]
#:in [in 'nw] #:in [in 'nw]
#:out [out 'ne] #:out [out 'ne]
#:inner [inner #f] #:inner [inner #f]
#:offset [offset (pt 0 0)] #:offset [offset '(0 0)]
#:origin [origin (pt 0 0)] #:origin [origin '(0 0)]
#:printable [printable default-printable] #:printable [printable default-printable]
#:pre-draw [pre-draw void] #:pre-draw [pre-draw void]
#:post-draw [post-draw void] #:post-draw [post-draw void]

Write Preview
Loading…
Cancel
Save