lose it

quad/quad/break.rkt

@@ -1,19 +1,13 @@
 #lang debug racket
 (require racket/list racket/match sugar/debug 
-         "param.rkt" "quad.rkt" "position.rkt")
+         "param.rkt" "quad.rkt" "atomize.rkt" "position.rkt")
+(provide break)
 
 (define-syntax (debug-report stx)
   (syntax-case stx ()
     [(_ EXPR ...) (with-syntax ([debug (datum->syntax stx 'debug)])
                     #'(when debug (report EXPR ...)))]))
 
-(define (distance q)
-  (match (pt- (out-point q) (in-point q))
-    [(list (? zero?) ∆y) ∆y]
-    [(list ∆x (? zero?)) ∆x]
-    [(list ∆x ∆y) (sqrt (+ (* ∆x ∆x) (* ∆y ∆y)))]))
-
-(provide break)
 (define (break xs
                [target-size (current-wrap-distance)]
                [debug #f]
@@ -26,34 +20,19 @@
       #: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
-               hard-break?
-               soft-break?
-               finish-wrap-proc))
+  (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 xs
-                     target-size
-                     debug
-                     hard-break?
-                     soft-break?
-                     finish-wrap-proc)
-  (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 (break-hards qs target-size debug hard-break? soft-break? finish-wrap-proc)
+  (let loop ([wraps null][qs qs])
+    (match qs
+      [(? null?) (append* (reverse wraps))]
+      [(or (cons (? hard-break?) rest) rest)
+       (define-values (head tail) (splitf-at rest (λ (x) (not (hard-break? x)))))
+       ;; head will be empty (intentionally) if qs starts with two hard breaks
+       (define next-wrap (break-softs head target-size debug soft-break? finish-wrap-proc))
+       (loop (cons next-wrap wraps) tail)])))
 
 (define (nonprinting-at-start? x)
   (not (printable? x 'start)))
@@ -63,10 +42,9 @@
   (and (not (printable? x)) (soft-break? x)))
 
 (define (wrap-append partial wrap)
-  (match/values
-   (values partial wrap)
-   [((== empty) _) wrap]
-   [(partial (list (? nonprinting-in-middle-soft-break?) ... rest ...)) (append (or partial null) rest)]))
+  ;; pieces will have been accumulated in reverse order
+  ;; thus beginning of list represents the end of the wrap
+  (append partial (dropf wrap nonprinting-in-middle-soft-break?)))
 
 (define (break-softs qs
                      target-size
@@ -79,13 +57,10 @@
              [current-dist #false] ; #false (to indicate start) or integer
              [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))]))]
+      [(== empty) (define last-wrap (wrap-append next-wrap-tail next-wrap-head))
+                  (append* (reverse
+                            (for/list ([wrap-qs (in-list (cons last-wrap wraps))])
+                              (finish-wrap-proc (reverse (dropf wrap-qs nonprinting-at-end?))))))]
       [(cons q other-qs)
        (debug-report q 'next-q)
        (debug-report (quad-elems q) 'next-q-elems)
@@ -94,23 +69,23 @@
        (define would-overflow? (and current-dist (> (+ dist current-dist) target-size)))
        (cond
          [at-start?
-          (cond
-            [(and (soft-break? q) (nonprinting-at-start? q))
+          (match q
+            [(and (? soft-break?) (? nonprinting-at-start?))
              (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)])]
+            [_ (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))
+          (match q
+            [(and (? soft-break?) (? nonprinting-at-end?))
              (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
@@ -119,14 +94,14 @@
                    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
+            [_ #:when (empty? next-wrap-head)
+               (debug-report 'would-overflow-hard-without-captured-break)
+               (loop (cons next-wrap-tail wraps)
+                     null
+                     null
+                     #false
+                     qs)]
+            [_ ; finish the wrap & reset the line without consuming a quad
              (loop (cons next-wrap-head wraps)
                    null
                    next-wrap-tail

quad/quad/position.rkt

@@ -81,6 +81,11 @@
          (loop (out-point new-q) (cons new-q acc) rest)]
         [(cons x rest) (loop pt (cons x acc) rest)]))))
 
+(define (distance q)
+  (match (pt- (out-point q) (in-point q))
+    [(list-no-order 0 val) val]
+    [(list ∆x ∆y) (sqrt (+ (expt ∆x 2) (expt ∆y 2)))]))
+
 (module+ test
   (require rackunit)
   (test-case