explore

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)))

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
+H◊quad[#:fontsize "32"]{H}◊quad[#:fontsize "8"]{H}

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)]