refac

quad/quad/break.rkt

@@ -19,9 +19,15 @@
 (define (break xs
                [target-size (current-wrap-distance)]
                [debug #f]
-               #:hard-break-proc [hard-break? (λ xs #f)]
-               #:soft-break-proc [soft-break? (λ xs #f)]
+               #:hard-break-proc [hard-break? (λ (x) #f)]
+               #:soft-break-proc [soft-break? (λ (x) #f)]
                #:finish-wrap-proc [finish-wrap-proc list])
+  #;((listof quad?)
+     (real?
+      any/c
+      #:hard-break-proc (any/c . -> . any/c)
+      #:soft-break-proc (any/c . -> . any/c)
+      #:finish-wrap-proc ((listof any/c) . -> . (listof any/c))) . ->* . (listof any/c))
   (break-hards xs
                target-size
                debug
@@ -37,26 +43,26 @@
                      hard-break?
                      soft-break?
                      finish-wrap-proc)
-  (define (cleanup-wraplist xs)
-    (append* (reverse xs)))
-  (define wraps
-    (let loop ([wraps null][xs xs])
-      (match xs
-        [(? null?) wraps]
-        [(cons (? hard-break?) rest)
-         (debug-report x 'hard-break)
-         (loop wraps rest)]
-        [_ (define-values (head tail) (splitf-at xs (λ (x) (not (hard-break? x)))))
-           (loop (cons (cleanup-wraplist (break-softs head
-                                                      target-size
-                                                      debug
-                                                      soft-break?
-                                                      finish-wrap-proc)) wraps) tail)])))
-  (cleanup-wraplist wraps))
-
-(define (nonprinting-at-start? x) (if (quad? x) (not (printable? x 'start)) #t))
-(define (nonprinting-at-end? x) (if (quad? x) (not (printable? x 'end)) #t))
-(define (nonprinting-in-middle-soft-break? x) (and (quad? x) (not (printable? x)) (soft-break? x)))
+  (define (cleanup-wraplist xs) (append* (reverse xs)))
+  (let loop ([wraps null][xs xs])
+    (match xs
+      [(? null?) (cleanup-wraplist wraps)]
+      [(cons (? hard-break?) rest)
+       (debug-report x 'hard-break)
+       (loop wraps rest)]
+      [_ (define-values (head tail) (splitf-at xs (λ (x) (not (hard-break? x)))))
+         (loop (cons (cleanup-wraplist (break-softs head
+                                                    target-size
+                                                    debug
+                                                    soft-break?
+                                                    finish-wrap-proc)) wraps) tail)])))
+
+(define (nonprinting-at-start? x)
+  (not (printable? x 'start)))
+(define (nonprinting-at-end? x)
+  (not (printable? x 'end)))
+(define (nonprinting-in-middle-soft-break? x)
+  (and (not (printable? x)) (soft-break? x)))
 
 (define (wrap-append partial wrap)
   (match/values
@@ -64,89 +70,86 @@
    [((== empty) _) wrap]
    [(partial (list (? nonprinting-in-middle-soft-break?) ... rest ...)) (append (or partial null) rest)]))
 
-
 (define (break-softs qs
                      target-size
                      debug
                      soft-break?
                      finish-wrap-proc)
-  (for/fold ([wraps null] ; list of (list of quads)
+  (let loop ([wraps null] ; list of (list of quads)
              [next-wrap-head null] ; list of quads ending in previous `soft-break?`
              [next-wrap-tail null] ; list of unbreakable quads
              [current-dist #false] ; #false (to indicate start) or integer
-             [qs qs] ; list of quads
-             #:result (let ()
-                        (define last-wrap (wrap-append #false (wrap-append next-wrap-tail next-wrap-head)))
-                        (define finished-wraps
-                          (for/list ([wrap (in-list (cons last-wrap wraps))])
-                            (match wrap
-                              [(list (? nonprinting-at-end?)) wrap] ; matches break signals
-                              ;; pieces will have been accumulated in reverse order
-                              ;; thus beginning of list represents the end of the wrap
-                              [(list (and (? soft-break?) (? nonprinting-at-end?)) ... rest ...)
-                               (finish-wrap-proc (reverse rest))])))
-                        finished-wraps))
-            ([i (in-naturals)]
-             #:break (empty? qs))
-    (match-define (cons q other-qs) qs)
-    (debug-report q 'next-q)
-    (debug-report (quad-elems q) 'next-q-elems)
-    (define at-start? (not current-dist))
-    (define dist (if (and (quad? q) (printable? q)) (distance q) 0))
-    (define would-overflow? (and current-dist (> (+ dist current-dist) target-size)))
-    (cond
-      [(and at-start? (soft-break? q) (nonprinting-at-start? q))
-       (debug-report q 'skipping-soft-break-at-beginning)
-       (values wraps
-               next-wrap-head
-               next-wrap-tail
-               current-dist
-               other-qs)]
-      [at-start?
-       (debug-report 'hard-quad-at-start)
-       (values wraps
-               next-wrap-head
-               (list q)
-               (distance q)
-               other-qs)]
-      [(and would-overflow? (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
-       (values wraps
-               (wrap-append (cons q next-wrap-tail) next-wrap-head)
-               null
-               (+ dist current-dist)
-               other-qs)]
-      [(and would-overflow? (empty? next-wrap-head))
-       (debug-report 'would-overflow-hard-without-captured-break)
-       (values (cons next-wrap-tail wraps)
-               null
-               null
-               #false
-               qs)]
-      [would-overflow? ; finish the wrap & reset the line without consuming a quad
-       (values (cons next-wrap-head wraps)
-               null
-               next-wrap-tail
-               (apply + (map distance next-wrap-tail))
-               qs)]
-      [(soft-break? q) ; printing soft break, like a hyphen
-       (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
-       (values wraps
-               (wrap-append (cons q next-wrap-tail) next-wrap-head)
-               null
-               (+ dist current-dist)
-               other-qs)]
-      [else
-       (debug-report 'would-not-overflow)
-       ;; add to partial
-       (values wraps
-               next-wrap-head
-               (cons q next-wrap-tail)
-               (+ dist current-dist)
-               other-qs)])))
+             [qs qs]) ; list of quads
+    (match qs
+      [(== empty) (define last-wrap (wrap-append #false (wrap-append next-wrap-tail next-wrap-head)))
+                  (for/list ([wrap (in-list (cons last-wrap wraps))])
+                    ;; pieces will have been accumulated in reverse order
+                    ;; thus beginning of list represents the end of the wrap
+                    (match wrap
+                      [(list (and (? soft-break?) (? nonprinting-at-end?)) ... rest ...)
+                       (finish-wrap-proc (reverse rest))]))]
+      [(cons q other-qs)
+       (debug-report q 'next-q)
+       (debug-report (quad-elems q) 'next-q-elems)
+       (define at-start? (not current-dist))
+       (define dist (if (and (quad? q) (printable? q)) (distance q) 0))
+       (define would-overflow? (and current-dist (> (+ dist current-dist) target-size)))
+       (cond
+         [at-start?
+          (cond
+            [(and (soft-break? q) (nonprinting-at-start? q))
+             (debug-report q 'skipping-soft-break-at-beginning)
+             (loop wraps
+                   next-wrap-head
+                   next-wrap-tail
+                   current-dist
+                   other-qs)]
+            [else (debug-report 'hard-quad-at-start)
+                  (loop wraps
+                        next-wrap-head
+                        (list q)
+                        (distance q)
+                        other-qs)])]
+         [would-overflow?
+          (cond
+            [(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
+             (loop wraps
+                   (wrap-append (cons q next-wrap-tail) next-wrap-head)
+                   null
+                   (+ dist current-dist)
+                   other-qs)]
+            [(empty? next-wrap-head)
+             (debug-report 'would-overflow-hard-without-captured-break)
+             (loop (cons next-wrap-tail wraps)
+                   null
+                   null
+                   #false
+                   qs)]
+            [else ; finish the wrap & reset the line without consuming a quad
+             (loop (cons next-wrap-head wraps)
+                   null
+                   next-wrap-tail
+                   (apply + (map distance next-wrap-tail))
+                   qs)])]         
+         [(soft-break? q) ; printing soft break, like a hyphen
+          (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
+                (wrap-append (cons q next-wrap-tail) next-wrap-head)
+                null
+                (+ dist current-dist)
+                other-qs)]
+         [else
+          (debug-report 'would-not-overflow)
+          ;; add to partial
+          (loop wraps
+                next-wrap-head
+                (cons q next-wrap-tail)
+                (+ dist current-dist)
+                other-qs)])])))
 
 
 (define q-zero (q #:size (pt 0 0)))