refac

quad/quad/break.rkt

@@ -64,6 +64,8 @@
                      finish-wrap-proc)
   (define break-val=? (if (symbol? break-val) eq? equal?))
   (define (cleanup-wraplist xs)
+    ;; combine the segments into a flat list, and drop any trailing breaks
+    ;; (on the idea that breaks should separate things, and there's nothing left to separate)
     (dropf-right (append* (reverse xs)) (λ (x) (break-val=? break-val x))))
   (define wraps
     (for/fold ([wraps null]
@@ -96,111 +98,90 @@
    [((== empty) _) wrap]
    [(partial (list (? nonprinting-in-middle-soft-break?) ... rest ...)) (append (or partial null) rest)]))
 
+
+(define (finish-wraps wraps wrap-proc soft-break?)
+  (for/list ([wrap (in-list 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 (? (conjoin soft-break? nonprinting-at-end?)) ... rest ...)
+       (wrap-proc (reverse rest))])))
+
 (define (break-softs qs
                      target-size
                      debug
                      break-val
                      soft-break?
                      finish-wrap-proc)
-  (define start-signal (gensym))
+  (for/fold ([wraps null] ; list of (list of quads)
-  ;; qs = list of quads
+             [current-wrap null] ; list of quads ending in previous `soft-break?`
-  ;; current-dist = integer
+             [current-partial null] ; list of unbreakable quads
-  ;; current-wrap = list of quads ending in previous `soft-break?`
+             [current-dist #false] ; #false (to indicate start) or integer
-  ;; current-partial = list of unbreakable quads
+             [qs qs] ; list of quads
-  ;; wraps = list of (list of quads)
+             #:result (let ()
-  (let loop ([wraps null][current-wrap null][current-partial null][current-dist start-signal][qs qs])
-    (match qs
-      [(== empty)
-       (when debug (report 'all-quads-wrapped))
-       ;; combine the segments into a flat list, and drop any trailing breaks
-       ;; (on the idea that breaks should separate things, and there's nothing left to separate)
-       ;; wraps alternate with breaks
-       (debug-report wraps)
-       ;; use false as signal to indicate the end
                         (define last-wrap (append-to-wrap #false (append-to-wrap current-partial current-wrap)))
-       (for/list ([wrap (in-list (cons last-wrap wraps))])
+                        (finish-wraps (cons last-wrap wraps) finish-wrap-proc soft-break?)))
-         (match wrap
+            ([i (in-naturals)]
-           [(list (? nonprinting-at-end?)) wrap] ; matches break signals
+             #:break (empty? qs))
-           ;; pieces will have been accumulated in reverse order
+    (match-define (cons q other-qs) qs)
-           ;; thus beginning of list represents the end of the wrap
-           [(list (? (conjoin soft-break? nonprinting-at-end?)) ... rest ...)
-            (debug-report (finish-wrap-proc (reverse rest)))
-            (finish-wrap-proc (reverse rest))]))]
-      [(cons q other-qs)
     (debug-report q 'next-q)
-       (define at-start? (eq? current-dist start-signal))
+    (define at-start? (not current-dist))
-       (cond
+    (define dist (if (and (quad? q) (printable? q)) (distance q) 0))
-         [at-start?
+    (define would-overflow? (and current-dist (> (+ dist current-dist) target-size)))
     (cond
-            [(and (soft-break? q) (nonprinting-at-start? q))
+      [(and at-start? (soft-break? q) (nonprinting-at-start? q))
        (debug-report q 'skipping-soft-break-at-beginning)
-             ;; skip it
+       (values wraps
-             (loop wraps
                current-wrap
                current-partial
                current-dist
                other-qs)]
-            [else ; printing quad
+      [at-start?
        (debug-report 'hard-quad-at-start)
-             (loop wraps
+       (values wraps
                current-wrap
-                   (cons q current-partial)
+               (list q)
                (distance q)
-                   other-qs)])]
+               other-qs)]
-         [else
+      [(and would-overflow? (soft-break? q) (nonprinting-at-end? q))
-          (define dist (if (and (quad? q) (printable? q)) (distance q) 0))
-          (debug-report current-dist)
-          (debug-report dist)
-          (define would-overflow? (> (+ dist current-dist) target-size))
-          (cond
-            [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
+       (values wraps
                (append-to-wrap (cons q current-partial) current-wrap)
                null
                (+ dist current-dist)
                other-qs)]
-               [else
+      [(and would-overflow? (empty? current-wrap))
-                (debug-report 'would-overflow-hard)
+       (debug-report 'would-overflow-hard-without-captured-break)
-                (debug-report (empty? current-wrap))
+       (values (list* (list break-val) current-partial wraps)
-                ;; finish the wrap & reset the line without consuming a quad
+               null
-                (if (empty? current-wrap) ; means we have not captured a soft break
-                    (loop (list* (list break-val) current-partial wraps)
-                          current-wrap ; which is empty
                null
-                          start-signal
+               #false
-                          qs)
+               qs)]
-                    (loop (list* (list break-val) current-wrap wraps)
+      [would-overflow? ; finish the wrap & reset the line without consuming a quad
+       (values (list* (list break-val) current-wrap wraps)
                null
                current-partial
                (apply + (map distance current-partial))
-                          qs))])]
+               qs)]
-            [else
-             (cond
       [(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 current-wrap with the current-partial
-                (cond
+       (values wraps
-                  [else
-                   (loop wraps
                (append-to-wrap (cons q current-partial) current-wrap)
                null
                (+ dist current-dist)
-                         other-qs)])]
+               other-qs)]
       [else
        (debug-report 'would-not-overflow)
        ;; add to partial
-                (loop wraps
+       (values wraps
                current-wrap
                (cons q current-partial)
                (+ dist current-dist)
-                      other-qs)])])
+               other-qs)])))
-
-          ])])))
 
 
 (define x (q (list 'size (pt 1 1)) #\x))