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,7 +140,7 @@
 
 
 (define (line-wrap xs size)
-  (break xs size
+  (wrap xs size
         #:hard-break (λ (q) (equal? "¶" (car (quad-elems q))))
         #:soft-break soft-break-for-line?
         #:finish-wrap (λ (pcs q idx)
@@ -179,7 +179,7 @@
                                                  (hash-ref (quad-attrs q) 'doc-title)
                                                  (date->string (current-date) #t))
                                      side-margin
-                                      (- (pdf-height doc) bottom-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))))
@@ -219,7 +219,9 @@
    '((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
+  (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]

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)
@@ -72,7 +73,7 @@
                                 ;; page number
                                 (save doc)
                                 (fill-color doc "blue")
-                              (text doc str 10 10 (hasheq 'link "https://practicaltypography.com"))
+                                (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))
@@ -103,7 +104,7 @@
 
 (define consolidate-into-runs? #t)
 (define (line-wrap xs size [debug #f])
-  (break xs size debug
+  (wrap xs size debug
         #:soft-break soft-break?
         #:finish-wrap (λ (pcs q idx) (list (struct-copy quad $line
                                                         [elems
@@ -116,7 +117,7 @@
                                                              pcs)])))))
 
 (define (page-wrap xs size [debug #f])
-  (break xs size debug
+  (wrap xs size debug
         #:finish-wrap (λ (pcs q idx) (list (struct-copy quad $page
                                                         [elems pcs])))))
 

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,18 +1,19 @@
 #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
+(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?
@@ -20,12 +21,10 @@
       #: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,10 +45,11 @@
   ;; thus beginning of list represents the end of the wrap
   (append partial (dropf wrap nonprinting-soft-break-in-middle?)))
 
-(define (break-softs qs
+(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
@@ -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,7 +114,7 @@
                       null
                       (+ dist current-dist)
                       other-qs)]
-               [_ #:when (empty? next-wrap-head)
+               [(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)
@@ -114,14 +122,14 @@
                       null
                       #false
                       qs)]
-               [_ ; finish the wrap & reset the line without consuming a quad
+               [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,7 +186,7 @@
 (define soft-break? (λ (q)  (memv (car (quad-elems q)) '(#\space #\-))))
 
 (define (linewrap xs size [debug #f])
-  (add-between (break xs size debug
+  (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))
@@ -315,7 +323,7 @@
 
 (define (pagewrap xs size [debug #f])
   (add-between
-   (break (flatten xs) size debug
+   (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)))
@@ -353,7 +361,7 @@
 
 (define (linewrap2 xs size [debug #f])
   (add-between
-   (break xs size debug
+   (wrap xs size debug
          #:hard-break (λ (q) (memv (car (quad-elems q)) '(#\newline)))
          #:soft-break soft-break?
          #:finish-wrap (λ (pcs . _) (list (apply q pcs))))
@@ -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))))))