From d17104fa10446f39b29915c449897e145c39d613 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 20 Mar 2018 07:38:51 -0700 Subject: [PATCH] explore --- quad/quad/position.rkt | 58 +++++++++++++++++++++++++++-------- quad/quad/typewriter-test.rkt | 2 +- quad/quad/typewriter.rkt | 28 +++++++++++++---- 3 files changed, 68 insertions(+), 20 deletions(-) diff --git a/quad/quad/position.rkt b/quad/quad/position.rkt index 8c0de5f0..79519606 100644 --- a/quad/quad/position.rkt +++ b/quad/quad/position.rkt @@ -17,19 +17,21 @@ (define (coerce-int x) (if (integer? x) (inexact->exact x) x)) +(define fonts (make-hash)) + (define/contract (ascender q) (quad? . -> . real?) (define p (hash-ref (attrs q) 'font "Courier")) (unless p (error 'ascender-no-font-key)) - (ascent (openSync p))) + (ascent (hash-ref! fonts p (λ () (openSync p))))) (define/contract (units-per-em q) (quad? . -> . real?) (define p (hash-ref (attrs q) 'font "Courier")) (unless p (error 'units-per-em-no-font-key)) - (unitsPerEm (openSync p))) + (unitsPerEm (hash-ref! fonts p (λ () (openSync p))))) (define (fontsize q) (define val (hash-ref (attrs q) 'fontsize 0)) @@ -60,7 +62,7 @@ (define/contract (in-point q) point/c - (anchor->point q (in q))) + (pt+ (origin q) (anchor->point q (in q)))) (define/contract (out-point q) point/c @@ -92,18 +94,42 @@ (check-equal? (origin (position (quad (hasheq 'in 'sw 'size size)) orig)) (pt 5 -5)) (check-equal? (origin (position (quad (hasheq 'in 'w 'size size)) orig)) (pt 5 0))) + (test-case + "in points" + (check-equal? (in-point (quad (hasheq 'in 'nw 'size '(10 10) 'origin '(5 5)))) (pt 5 5)) + (check-equal? (in-point (quad (hasheq 'in 'n 'size '(10 10) 'origin '(5 5)))) (pt 10 5)) + (check-equal? (in-point (quad (hasheq 'in 'ne 'size '(10 10) 'origin '(5 5)))) (pt 15 5)) + (check-equal? (in-point (quad (hasheq 'in 'w 'size '(10 10) 'origin '(5 5)))) (pt 5 10)) + (check-equal? (in-point (quad (hasheq 'in 'c 'size '(10 10) 'origin '(5 5)))) (pt 10 10)) + (check-equal? (in-point (quad (hasheq 'in 'e 'size '(10 10) 'origin '(5 5)))) (pt 15 10)) + (check-equal? (in-point (quad (hasheq 'in 'sw 'size '(10 10) 'origin '(5 5)))) (pt 5 15)) + (check-equal? (in-point (quad (hasheq 'in 's 'size '(10 10) 'origin '(5 5)))) (pt 10 15)) + (check-equal? (in-point (quad (hasheq 'in 'se 'size '(10 10) 'origin '(5 5)))) (pt 15 15))) + + (test-case + "out points" + (check-equal? (out-point (quad (hasheq 'out 'nw 'size '(10 10) 'origin '(5 5)))) (pt 5 5)) + (check-equal? (out-point (quad (hasheq 'out 'n 'size '(10 10) 'origin '(5 5)))) (pt 10 5)) + (check-equal? (out-point (quad (hasheq 'out 'ne 'size '(10 10) 'origin '(5 5)))) (pt 15 5)) + (check-equal? (out-point (quad (hasheq 'out 'w 'size '(10 10) 'origin '(5 5)))) (pt 5 10)) + (check-equal? (out-point (quad (hasheq 'out 'c 'size '(10 10) 'origin '(5 5)))) (pt 10 10)) + (check-equal? (out-point (quad (hasheq 'out 'e 'size '(10 10) 'origin '(5 5)))) (pt 15 10)) + (check-equal? (out-point (quad (hasheq 'out 'sw 'size '(10 10) 'origin '(5 5)))) (pt 5 15)) + (check-equal? (out-point (quad (hasheq 'out 's 'size '(10 10) 'origin '(5 5)))) (pt 10 15)) + (check-equal? (out-point (quad (hasheq 'out 'se 'size '(10 10) 'origin '(5 5)))) (pt 15 15))) + (test-case "inner points" - (define size '(10 10)) - (define orig '(0 0)) - (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'nw)) orig)) (pt 0 0)) - (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'n)) orig)) (pt 5 0)) - (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'ne)) orig)) (pt 10 0)) - (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'e)) orig)) (pt 10 5)) - (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'se)) orig)) (pt 10 10)) - (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 's)) orig)) (pt 5 10)) - (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'sw)) orig)) (pt 0 10)) - (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'w)) orig)) (pt 0 5))) + (define size '(20 20)) + (define orig '(10 10)) + (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'nw)) orig)) (pt 10 10)) + (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'n)) orig)) (pt 20 10)) + (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'ne)) orig)) (pt 30 10)) + (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'e)) orig)) (pt 30 20)) + (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'se)) orig)) (pt 30 30)) + (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 's)) orig)) (pt 20 30)) + (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'sw)) orig)) (pt 10 30)) + (check-equal? (inner-point (position (quad (hasheq 'size size 'inner 'w)) orig)) (pt 10 20))) (test-case "inner points with offsets" @@ -137,6 +163,12 @@ (require racket/runtime-path fontkit/font) (define-runtime-path fira "fira.ttf") +(define q1 (quad (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 12))) +(define q2 (quad (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 24))) +(define q3 (quad (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 6))) +#;(position (quad #f q1 q2 q3)) + + (module+ test (require rackunit) (define q (quad (list 'in 'bi 'out 'bo 'size '(10 10) 'font fira 'fontsize 12))) diff --git a/quad/quad/typewriter-test.rkt b/quad/quad/typewriter-test.rkt index dcfc7869..e883ad2d 100644 --- a/quad/quad/typewriter-test.rkt +++ b/quad/quad/typewriter-test.rkt @@ -1,3 +1,3 @@ #lang quad/typewriter -◊quad[#:link "http://beautfifulracket.com"]{An expression that} is not a value can ◊quad[#:fontsize "22"]{always} certainly ◊quad[#:fontsize "7"]{be partitioned} into two parts \ No newline at end of file +H◊quad[#:fontsize "32"]{H}◊quad[#:fontsize "8"]{H} \ No newline at end of file diff --git a/quad/quad/typewriter.rkt b/quad/quad/typewriter.rkt index 9c649088..873d041e 100644 --- a/quad/quad/typewriter.rkt +++ b/quad/quad/typewriter.rkt @@ -11,11 +11,24 @@ (struct $shim $quad () #:transparent) (struct $char $quad () #:transparent) (define util-doc (make-object PDFDocument)) +(define (draw-debug q doc) + (send doc save) + (send doc lineWidth 0.25) + (send/apply doc rect (append (origin q) (size q))) + (send doc stroke) + #R (hash-ref (attrs q) 'in) + (send doc circle (+ (pt-x #R(origin q)) (pt-x #R(in-point q))) + (+ (pt-y (origin q)) (pt-y (in-point q))) 1) + (send doc circle (+ (pt-x (origin q)) (pt-x #R(out-point q))) + (+ (pt-y (origin q)) (pt-y (out-point q))) 1) + (send doc fill) + (send doc restore)) + (define char-sizes (make-hasheqv)) (define (charify q) ($char (hash-set* (attrs q) - 'in 'nw - 'out 'ne + 'in 'bi + 'out 'bo 'font fira 'size (hash-ref! char-sizes (car (elems q)) (λ () @@ -29,6 +42,7 @@ [(#\space) (λ (sig) (not (memq sig '(start end))))] [else #t]) 'draw (λ (q doc) + (draw-debug q doc) (send doc fontSize (string->number (hash-ref (attrs q) 'fontsize "12"))) (let ([str (apply string (elems q))]) (cond @@ -62,12 +76,13 @@ (values (cons new-run runs) rest))) (define line-height 16) -(define consolidate-into-runs? #f) +(define consolidate-into-runs? #t) (define (line-wrap xs size [debug #f]) (break xs size debug #:break-val (make-break #\newline) #:soft-break-proc soft-break? - #:finish-wrap-proc (λ (pcs) (list ($line (hasheq 'size (list +inf.0 line-height) 'out 'sw) + #:finish-wrap-proc (λ (pcs) (list ($line (hasheq 'size (list +inf.0 line-height) + 'out 'sw) ;; consolidate chars into a single run (naively) ;; by taking attributes from first (including origin) ;; this only works because there's only one run per line @@ -91,7 +106,8 @@ (send doc addPage) (send doc fontSize 10) (define str (string-append "page " (number->string page-count))) - (as-link doc str "https://practicaltypography.com" 10 10) + ;; page number + #;(as-link doc str "https://practicaltypography.com" 10 10) (set! page-count (add1 page-count)))) '(#\page))) (define (page-wrap xs size [debug #f]) (break xs size debug @@ -118,7 +134,7 @@ (let ([doc (make-object PDFDocument (hasheq 'compress #t 'autoFirstPage #f - 'size '(300 400)))]) + 'size '(150 150)))]) (send* doc [pipe (open-output-file PS #:exists 'replace)] [registerFont "Fira" (path->string fira)]