add wrap-anywhere option

quad/qtest/hyphenate.rkt

@@ -6,7 +6,7 @@ A simple _hyphenation engine_ that uses the Knuth–Liang hyphenation algorithm
 
 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. Yes! No?!ß
 
 ## 1. Installation
 
@@ -25,4 +25,31 @@ any length, use `#:min-length` `#f`.
 A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
 Certain word processors allow users to [insert soft
 hyphens](http://practicaltypography.com/optional-hyphens.html) in their
+text. A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
+Certain word processors allow users to [insert soft
+hyphens](http://practicaltypography.com/optional-hyphens.html) in their
+text. A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
+Certain word processors allow users to [insert soft
+hyphens](http://practicaltypography.com/optional-hyphens.html) in their
+text. A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
+Certain word processors allow users to [insert soft
+hyphens](http://practicaltypography.com/optional-hyphens.html) in their
+text. A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
+Certain word processors allow users to [insert soft
+hyphens](http://practicaltypography.com/optional-hyphens.html) in their
+text.A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
+Certain word processors allow users to [insert soft
+hyphens](http://practicaltypography.com/optional-hyphens.html) in their
+text.A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
+Certain word processors allow users to [insert soft
+hyphens](http://practicaltypography.com/optional-hyphens.html) in their
+text.A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
+Certain word processors allow users to [insert soft
+hyphens](http://practicaltypography.com/optional-hyphens.html) in their
+text.A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
+Certain word processors allow users to [insert soft
+hyphens](http://practicaltypography.com/optional-hyphens.html) in their
+text.A [list of web colors](https://en.wikipedia.org/wiki/Web_colors).
+Certain word processors allow users to [insert soft
+hyphens](http://practicaltypography.com/optional-hyphens.html) in their
 text.

quad/qtest/markdown.rkt

@@ -140,31 +140,31 @@
 
 
 (define (line-wrap xs size)
-  (break xs size
-         #:hard-break (λ (q) (equal? "¶" (car (quad-elems q))))
-         #:soft-break soft-break-for-line?
-         #:finish-wrap (λ (pcs q idx)
-                         (define new-elems (consolidate-runs pcs))
-                         (append
-                          (if (= idx 1) (list q:line-spacer) null)
-                          (list (struct-copy quad q:line
-                                             [attrs (let ([attrs (hash-copy (quad-attrs q:line))])
-                                                      (define container-val (hash-ref (quad-attrs (car new-elems)) 'container #f))
-                                                      (when (and container-val
-                                                                 (for/and ([elem (in-list (cdr new-elems))])
-                                                                          (equal? (hash-ref (quad-attrs elem) 'container #f)
-                                                                                  container-val)))
-                                                        (hash-set! attrs 'container container-val))
-                                                      attrs)]
-                                             [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 new-elems]))))))
+  (wrap xs size
+        #:hard-break (λ (q) (equal? "¶" (car (quad-elems q))))
+        #:soft-break soft-break-for-line?
+        #:finish-wrap (λ (pcs q idx)
+                        (define new-elems (consolidate-runs pcs))
+                        (append
+                         (if (= idx 1) (list q:line-spacer) null)
+                         (list (struct-copy quad q:line
+                                            [attrs (let ([attrs (hash-copy (quad-attrs q:line))])
+                                                     (define container-val (hash-ref (quad-attrs (car new-elems)) 'container #f))
+                                                     (when (and container-val
+                                                                (for/and ([elem (in-list (cdr new-elems))])
+                                                                         (equal? (hash-ref (quad-attrs elem) 'container #f)
+                                                                                 container-val)))
+                                                       (hash-set! attrs 'container container-val))
+                                                     attrs)]
+                                            [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 new-elems]))))))
 
 (define top-margin 60)
 (define bottom-margin 120)
@@ -174,12 +174,12 @@
 (define q:page (q #:offset page-offset
                   #:draw-start (λ (q doc) (add-page doc))
                   #:draw-end (λ (q doc)
-                                (font-size doc 10)
-                                (text doc (format "~a · ~a at ~a" (hash-ref (quad-attrs q) 'page-number)
-                                                  (hash-ref (quad-attrs q) 'doc-title)
-                                                  (date->string (current-date) #t))
-                                      side-margin
-                                      (- (pdf-height doc) bottom-margin)))))
+                               (font-size doc 10)
+                               (text doc (format "~a · ~a at ~a" (hash-ref (quad-attrs q) 'page-number)
+                                                 (hash-ref (quad-attrs q) 'doc-title)
+                                                 (date->string (current-date) #t))
+                                     side-margin
+                                     (+ (- (pdf-height doc) bottom-margin) 20)))))
 
 (define q:doc (q #:draw-start (λ (q doc) (start-doc doc))
                  #:draw-end (λ (q doc) (end-doc doc))))
@@ -193,13 +193,13 @@
                        (for/sum ([pc (in-list pcs)])
                                 (pt-y (size pc)))))
      #:draw-start (λ (q doc)
-                  (save doc)
-                  (match-define (list left top) (quad-origin q))
-                  (match-define (list right bottom) (size q))
-                  (rect doc (- left 4) (+ top 6) right (+ bottom 2))
-                  (line-width doc 1)
-                  (fill-and-stroke doc "#eee" "#999")
-                  (restore doc))))
+                    (save doc)
+                    (match-define (list left top) (quad-origin q))
+                    (match-define (list right bottom) (size q))
+                    (rect doc (- left 4) (+ top 6) right (+ bottom 2))
+                    (line-width doc 1)
+                    (fill-and-stroke doc "#eee" "#999")
+                    (restore doc))))
 
 (define (contiguous-group-by pred xs)
   ;; like `group-by`, but only groups together contiguous xs with the same pred value.
@@ -219,17 +219,19 @@
    '((1 1) (2 2 2) (3) (4) (5 5) (6 6) (7) (8) (9))))
 
 (define (page-wrap xs vertical-height path)
-  (break xs vertical-height
-         #:finish-wrap (λ (lns q idx)
-                         (list (struct-copy quad q:page
-                                            [attrs (let ([page-number idx]
-                                                         [h (hash-copy (quad-attrs q:page))])
-                                                     (hash-set! h 'page-number page-number)
-                                                     (define-values (dir name _)
-                                                       (split-path (path-replace-extension path #"")))
-                                                     (hash-set! h 'doc-title (string-titlecase (path->string name)))
-                                                     h)]
-                                            [elems lns])))))
+  (wrap xs vertical-height
+        #:soft-break line-spacer?
+        #:wrap-anywhere? #t
+        #:finish-wrap (λ (lns q idx)
+                        (list (struct-copy quad q:page
+                                           [attrs (let ([page-number idx]
+                                                        [h (hash-copy (quad-attrs q:page))])
+                                                    (hash-set! h 'page-number page-number)
+                                                    (define-values (dir name _)
+                                                      (split-path (path-replace-extension path #"")))
+                                                    (hash-set! h 'doc-title (string-titlecase (path->string name)))
+                                                    h)]
+                                           [elems lns])))))
 
 (define (insert-containers pages)
   ;; container recomposition happens after page composition because page breaks can happen between lines.

quad/qtest/typewriter.rkt

@@ -38,7 +38,8 @@
                                  [(hash-has-key? (quad-attrs q) 'link)
                                   (save doc)
                                   (fill-color doc "blue")
-                                  (text doc str (first  (quad-origin q)) (second (quad-origin q)) (hasheq 'link (hash-ref (quad-attrs q) 'link)))
+                                  (text doc str (first  (quad-origin q)) (second (quad-origin q))
+                                        #:link (hash-ref (quad-attrs q) 'link))
                                   (restore doc)]
                                  [else
                                   #;(println str)
@@ -66,15 +67,15 @@
 (define $page (q #:attrs (hasheq 'type "page")
                  #:offset '(36 36)
                  #:draw-start (λ (q doc)
-                              (add-page doc)
-                              (font-size doc 10)
-                              (define str (string-append "page " (number->string page-count)))
-                              ;; page number
-                              (save doc)
-                              (fill-color doc "blue")
-                              (text doc str 10 10 (hasheq 'link "https://practicaltypography.com"))
-                              (restore doc)
-                              (set! page-count (add1 page-count)))))
+                                (add-page doc)
+                                (font-size doc 10)
+                                (define str (string-append "page " (number->string page-count)))
+                                ;; page number
+                                (save doc)
+                                (fill-color doc "blue")
+                                (text doc str 10 10 #:link "https://practicaltypography.com")
+                                (restore doc)
+                                (set! page-count (add1 page-count)))))
 (define $doc (q #:draw-start (λ (q doc) (start-doc doc))
                 #:draw-end (λ (q doc) (end-doc doc))))
 (struct $break quad ())
@@ -96,29 +97,29 @@
                                  [elems (merge-adjacent-strings (apply append (for/list ([pc (in-list run-pcs)])
                                                                                         (quad-elems pc))))]
                                  [size (delay (pt (for/sum ([pc (in-list run-pcs)])
-                                                             (pt-x (size pc)))
-                                                    (pt-y (size (car pcs)))))]))
+                                                           (pt-x (size pc)))
+                                                  (pt-y (size (car pcs)))))]))
     (values (cons new-run runs) rest)))
 
 
 (define consolidate-into-runs? #t)
 (define (line-wrap xs size [debug #f])
-  (break xs size debug
-         #:soft-break soft-break?
-         #:finish-wrap (λ (pcs q idx) (list (struct-copy quad $line
-                                                  [elems
-                                                   ;; 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
-                                                   ;; that is, it suffices to position the first letter
-                                                   (if consolidate-into-runs?
-                                                       (consolidate-runs pcs)
-                                                       pcs)])))))
+  (wrap xs size debug
+        #:soft-break soft-break?
+        #:finish-wrap (λ (pcs q idx) (list (struct-copy quad $line
+                                                        [elems
+                                                         ;; 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
+                                                         ;; that is, it suffices to position the first letter
+                                                         (if consolidate-into-runs?
+                                                             (consolidate-runs pcs)
+                                                             pcs)])))))
 
 (define (page-wrap xs size [debug #f])
-  (break xs size debug
-         #:finish-wrap (λ (pcs q idx) (list (struct-copy quad $page
-                                                  [elems pcs])))))
+  (wrap xs size debug
+        #:finish-wrap (λ (pcs q idx) (list (struct-copy quad $page
+                                                        [elems pcs])))))
 
 (define (typeset pdf qarg)
   (define chars 65)

quad/quad/main.rkt

@@ -3,13 +3,13 @@
 (require "atomize.rkt"
 "quad.rkt"
 "qexpr.rkt"
-"break.rkt"
+"wrap.rkt"
 "position.rkt"
 "param.rkt")
 
 (provide (all-from-out "atomize.rkt"
 "quad.rkt"
 "qexpr.rkt"
-"break.rkt"
+"wrap.rkt"
 "position.rkt"
 "param.rkt"))

quad/quad/quad.rkt

@@ -57,7 +57,7 @@
    (define (hash-proc h recur) (equal-hash-code h))
    (define (hash2-proc h recur) (equal-secondary-hash-code h))])
 
-(define (default-printable q [sig #f]) #f)
+(define (default-printable q [sig #f]) #t)
 
 (define (default-draw q surface)
   (for-each (λ (qi) (draw qi surface)) (quad-elems q)))

quad/quad/wrap.rkt

@@ -1,31 +1,30 @@
 #lang debug racket
 (require racket/list racket/match sugar/debug 
          "param.rkt" "quad.rkt" "atomize.rkt" "position.rkt")
-(provide break)
+(provide wrap)
 
 (define-syntax (debug-report stx)
   (syntax-case stx ()
     [(_ EXPR ...) (with-syntax ([debug (datum->syntax stx 'debug)])
                     #'(when debug (report EXPR ...)))]))
 
-(define (break xs
-               [target-size (current-wrap-distance)]
-               [debug #f]
-               #:hard-break [hard-break? (λ (x) #f)]
-               #:soft-break [soft-break? (λ (x) #f)]
-               #:finish-wrap [finish-wrap-proc (λ (xs q idx) (list xs))])
+(define (wrap xs
+              [target-size (current-wrap-distance)]
+              [debug #f]
+              #:hard-break [hard-break? (λ (x) #f)]
+              #:soft-break [soft-break? (λ (x) #f)]
+              #:wrap-anywhere? [wrap-anywhere? #f]
+              #:finish-wrap [finish-wrap-proc (λ (xs q idx) (list xs))])
   #;((listof quad?)
      (real?
       any/c
       #:hard-break (quad? . -> . any/c)
       #:soft-break (quad? . -> . any/c)
       #:finish-wrap ((listof any/c) quad? natural? . -> . (listof any/c))) . ->* . (listof any/c))
-  (break-hards xs target-size debug hard-break? soft-break? finish-wrap-proc))
 
-;; the hard breaks are used to divide the wrap territory into smaller chunks
-;; that can be cached, parallelized, etc.
-(define (break-hards qs target-size debug hard-break? soft-break? finish-wrap-proc)
-  (let loop ([wraps null][qs qs])
+  ;; the hard breaks are used to divide the wrap territory into smaller chunks
+  ;; that can be cached, parallelized, etc.
+  (let loop ([wraps null][qs xs])
     (match qs
       ;; ignore a trailing hard break
       [(or (? null?) (list (? hard-break?))) (append* (reverse wraps))]
@@ -33,7 +32,7 @@
        (define-values (head tail) (splitf-at rest (λ (x) (not (hard-break? x)))))
        ;; head will be empty (intentionally) if qs starts with two hard breaks
        ;; because there should be a blank wrap in between
-       (define next-wrap (break-softs head target-size debug soft-break? finish-wrap-proc))
+       (define next-wrap (wrap-soft-breaks head target-size debug soft-break? wrap-anywhere? finish-wrap-proc))
        (debug-report next-wrap)
        (loop (cons next-wrap wraps) tail)])))
 
@@ -46,11 +45,12 @@
   ;; thus beginning of list represents the end of the wrap
   (append partial (dropf wrap nonprinting-soft-break-in-middle?)))
 
-(define (break-softs qs
-                     target-size
-                     debug
-                     soft-break?
-                     finish-wrap-proc) ; takes quads in wrap, triggering quad, and wrap idx; returns list containing wrap (and maybe other things)
+(define (wrap-soft-breaks qs
+                          target-size
+                          debug
+                          soft-break?
+                          wrap-anywhere?
+                          finish-wrap-proc) ; takes quads in wrap, triggering quad, and wrap idx; returns list containing wrap (and maybe other things)
   (define (finish-wrap qs wrap-idx [wrap-triggering-q (car qs)])
     ;; reverse because quads accumulated in reverse
     ;; wrap-triggering-q is ordinarily the last accumulated q
@@ -95,8 +95,16 @@
           (define would-overflow? (and current-dist (> (+ dist current-dist) target-size)))
           (cond
             [would-overflow?
-             (match q
-               [(and (? soft-break?) (? nonprinting-at-end?))
+             (cond
+               [wrap-anywhere?
+                (debug-report 'we-can-wrap-anywhere-so-why-not-here)
+                (loop (cons (finish-wrap (wrap-append next-wrap-tail next-wrap-head) wrap-idx) wraps)
+                      (add1 wrap-idx)
+                      null
+                      null
+                      #false
+                      qs)]
+               [(and (soft-break? q) (nonprinting-at-end? q))
                 (debug-report 'would-overflow-soft-nonprinting)
                 ;; a break is inevitable but we want to wait to finish the wrap until we see a hard quad
                 ;; but we can move the current-partial into the current-wrap
@@ -106,22 +114,22 @@
                       null
                       (+ dist current-dist)
                       other-qs)]
-               [_ #:when (empty? next-wrap-head)
-                  (debug-report 'would-overflow-hard-without-captured-break)
-                  (loop (cons (finish-wrap next-wrap-tail wrap-idx) wraps)
-                        (add1 wrap-idx)
-                        null
-                        null
-                        #false
-                        qs)]
-               [_ ; finish the wrap & reset the line without consuming a quad
+               [(empty? next-wrap-head)
+                (debug-report 'would-overflow-hard-without-captured-break)
+                (loop (cons (finish-wrap next-wrap-tail wrap-idx) wraps)
+                      (add1 wrap-idx)
+                      null
+                      null
+                      #false
+                      qs)]
+               [else ; finish the wrap & reset the line without consuming a quad
                 (loop (cons (finish-wrap next-wrap-head wrap-idx) wraps)
                       (add1 wrap-idx)
                       null
                       next-wrap-tail
                       (apply + (map distance next-wrap-tail))
                       qs)])]         
-            [(soft-break? q) ; printing soft break, like a hyphen
+            [(soft-break? q)
              (debug-report 'would-not-overflow-soft)
              ;; a soft break that fits, so move it on top of the next-wrap-head with the next-wrap-tail
              (loop wraps
@@ -178,10 +186,10 @@
 (define soft-break? (λ (q)  (memv (car (quad-elems q)) '(#\space #\-))))
 
 (define (linewrap xs size [debug #f])
-  (add-between (break xs size debug
-                      #:finish-wrap (λ (xs . _) (list xs))
-                      #:hard-break (λ (q) (char=? (car (quad-elems q)) #\newline))
-                      #:soft-break soft-break?) lbr))
+  (add-between (wrap xs size debug
+                     #:finish-wrap (λ (xs . _) (list xs))
+                     #:hard-break (λ (q) (char=? (car (quad-elems q)) #\newline))
+                     #:soft-break soft-break?) lbr))
 
 (module+ test
   (require rackunit))
@@ -284,13 +292,13 @@
 (define (visual-wrap str int [debug #f])
   (string-join
    (for/list ([x (in-list (linewrap (for/list ([atom (atomize str)])
-                                      (if (equal? (quad-elems atom) '(#\space))
-                                          (struct-copy quad sp)
-                                          (struct-copy quad q-one
-                                                       [attrs (quad-attrs atom)]
-                                                       [elems (quad-elems atom)]))) int debug))]
+                                              (if (equal? (quad-elems atom) '(#\space))
+                                                  (struct-copy quad sp)
+                                                  (struct-copy quad q-one
+                                                               [attrs (quad-attrs atom)]
+                                                               [elems (quad-elems atom)]))) int debug))]
               #:when (and (list? x) (andmap quad? x)))
-     (list->string (map car (map quad-elems x))))
+             (list->string (map car (map quad-elems x))))
    "|"))
 
 (module+ test
@@ -315,9 +323,9 @@
 
 (define (pagewrap xs size [debug #f])
   (add-between
-   (break (flatten xs) size debug
-          #:hard-break (λ (x) (and (quad? x) (memv (car (quad-elems x)) '(#\page))))
-          #:soft-break (λ (x) (and (quad? x) (eq? x lbr)))) pbr))
+   (wrap (flatten xs) size debug
+         #:hard-break (λ (x) (and (quad? x) (memv (car (quad-elems x)) '(#\page))))
+         #:soft-break (λ (x) (and (quad? x) (eq? x lbr)))) pbr))
 (define pbr (q #:size #false #:elems '(#\page)))
 
 (module+ test
@@ -353,10 +361,10 @@
 
 (define (linewrap2 xs size [debug #f])
   (add-between
-   (break xs size debug
-          #:hard-break (λ (q) (memv (car (quad-elems q)) '(#\newline)))
-          #:soft-break soft-break?
-          #:finish-wrap (λ (pcs . _) (list (apply q pcs))))
+   (wrap xs size debug
+         #:hard-break (λ (q) (memv (car (quad-elems q)) '(#\newline)))
+         #:soft-break soft-break?
+         #:finish-wrap (λ (pcs . _) (list (apply q pcs))))
    lbr))
 
 (module+ test
@@ -369,3 +377,18 @@
    (check-equal? (linewrap2 (list x x x x) 3) (list (q x x x) lbr (q x)))
    (check-equal? (linewrap2 (list x x x sp x x) 2) (list (q x x) lbr (q x) lbr (q x x)))
    (check-equal? (linewrap2 (list x x x sp x x) 3) (list (q x x x) lbr (q x x)))))
+
+(module+ test
+  (test-case
+   "wrap anywhere behavior"
+   (struct sp quad ())
+   (define (qsoft)
+     (q #:type sp
+        #:printable (λ (q sig) (not (memq sig '(start end))))
+        #:size (pt 1 1)))
+   (define (qhard) (q #:attrs (hasheq 'q 1) #:size (pt 1 1)))
+   (define qs (list (qhard) (qsoft) (qhard) (qhard)))
+   ;; only wraps on soft break, so two qhards go in second wrap
+   (check-equal? (wrap qs 3 #:soft-break sp?) (list (list (qhard)) (list (qhard) (qhard))))
+   ;; wraps anywhere, so two qhards fit onto first wrap with space
+   (check-equal? (wrap qs 3 #:soft-break sp? #:wrap-anywhere? #t) (list (list (qhard) (qsoft) (qhard)) (list (qhard))))))