From 75d96b12ff045005d905307439ab7b7fa6d6f82c Mon Sep 17 00:00:00 2001
From: Matthew Butterick <mb@mbtype.com>
Date: Sat, 3 Nov 2018 18:12:57 -0700
Subject: [PATCH] chars and spaces work

---
 quad/quad/break.rkt | 77 ++++++++++++++++++++++++++++-----------------
 1 file changed, 48 insertions(+), 29 deletions(-)

diff --git a/quad/quad/break.rkt b/quad/quad/break.rkt
index 556b3054..f33f3a37 100644
--- a/quad/quad/break.rkt
+++ b/quad/quad/break.rkt
@@ -1,7 +1,12 @@
-#lang debug racket/base
+#lang debug racket
 (require racket/contract racket/list racket/match txexpr sugar/debug sugar/define sugar/list racket/promise racket/function (only-in racket/control call/prompt) racket/future 
          "param.rkt" "qexpr.rkt" "atomize.rkt" "quad.rkt" "generic.rkt" "position.rkt")
 
+(define-syntax (debug-report stx)
+  (syntax-case stx ()
+    [(_ EXPR ...) (with-syntax ([debug (datum->syntax stx 'debug)])
+                    #'(when debug (report EXPR ...)))]))
+
 (define distance-cache (make-hasheq))
 (define/contract (distance q)
   (any/c . -> . real?)
@@ -65,7 +70,7 @@
                #:break (null? xs))
       (match xs
         [(cons (? hard-break?) rest)
-         (when debug (report x 'hard-break))
+         (debug-report x 'hard-break)
          (values (cons (list break-val) wraps) rest)]
         [_ (define-values (head tail) (splitf-at xs (λ (x) (not (hard-break? x)))))
            (values (cons (cleanup-wraplist (break-softs head
@@ -104,9 +109,11 @@
                    [(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 ...) (finish-wrap-proc (reverse rest))]))]
+                   [(list (? (conjoin soft-break? nonprinting-at-end?)) ... rest ...)
+                    (debug-report (finish-wrap-proc (reverse rest)))
+                    (finish-wrap-proc (reverse rest))]))]
       [(cons q other-qs)
-       (when debug (report q 'next-q))
+       (debug-report q 'next-q)
        (define at-start? (eq? current-dist start-signal))
        #;(define underflow?
            (and (not at-start?)
@@ -130,24 +137,35 @@
                            (cons q current-wrap)) (cdr qs))))
        
        (define dist (and (quad? q) (printable? q (and at-start? 'start)) (distance q)))
-       #R dist
+       (debug-report dist)
        (cond
          [at-start? ; assume printing char
-          (when debug (report 'at-start))
+          (debug-report 'at-start)
           (loop wraps current-wrap (cons q current-partial) dist (cdr qs))]
          [else
           (define would-overflow? (> (+ dist current-dist) target-size))
           (cond
             [would-overflow?
-             (when debug (report 'would-overflow))
-             ;; finish the wrap & reset the line without consuming a q
-             (loop (list* (list break-val) (append current-partial current-wrap) wraps)
-                   null
-                   null
-                   start-signal
-                   qs)]
+             (cond
+               [(soft-break? q)
+                (debug-report 'would-overflow-soft)
+                ;; 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
+                      (append (cons q current-partial) current-wrap)
+                      null
+                      (+ dist current-dist)
+                      other-qs)]
+               [else
+                (debug-report 'would-overflow-hard)
+                ;; finish the wrap & reset the line without consuming a quad
+                (loop (list* (list break-val) (append current-partial current-wrap) wraps)
+                      null
+                      null
+                      start-signal
+                      qs)])]
             [else
-             (when debug (report 'would-not-overflow))
+             (debug-report 'would-not-overflow)
              ;; add to partial
              (loop wraps
                    current-wrap
@@ -230,25 +248,26 @@
 (require rackunit)
 
 (module+ test
-    (test-case
-     "chars"
-     (check-equal? (linewrap (list) 1) null)  
-     (check-equal? (linewrap (list a) 1) (list a))
-     (check-equal? (linewrap (list a b) 1) (list a 'lb b))
-     (check-equal? (linewrap (list a b c) 1) (list a 'lb b 'lb c))
-     (check-equal? (linewrap (list a b c) 2) (list a b 'lb c))
-     (check-equal? (linewrap (list x x x x) 2) (list x x 'lb x x))
-     (check-equal? (linewrap (list x x x x x) 3) (list x x x 'lb x x))
-     (check-equal? (linewrap (list x x x x x) 1) (list x 'lb x 'lb x 'lb x 'lb x))
-     (check-equal? (linewrap (list x x x x x) 10) (list x x x x x))))
+  (test-case
+   "chars"
+   (check-equal? (linewrap (list) 1) null)  
+   (check-equal? (linewrap (list a) 1) (list a))
+   (check-equal? (linewrap (list a b) 1) (list a 'lb b))
+   (check-equal? (linewrap (list a b c) 1) (list a 'lb b 'lb c))
+   (check-equal? (linewrap (list a b c) 2) (list a b 'lb c))
+   (check-equal? (linewrap (list x x x x) 2) (list x x 'lb x x))
+   (check-equal? (linewrap (list x x x x x) 3) (list x x x 'lb x x))
+   (check-equal? (linewrap (list x x x x x) 1) (list x 'lb x 'lb x 'lb x 'lb x))
+   (check-equal? (linewrap (list x x x x x) 10) (list x x x x x))))
 
-#;(module+ test
+
+(module+ test
     (test-case
      "chars and spaces"
-     (check-equal? (linewrap (list x sp x) 1) (list x 'lb x))
-     (check-equal? (linewrap (list x x sp x) 2) (list x x 'lb x))
+     (check-equal? (linewrap (list a sp b) 1) (list a 'lb b))
+     (check-equal? (linewrap (list a b sp c) 2) (list a b 'lb c))
      (check-equal? (linewrap (list a sp b) 3) (list a sp b))
-     (check-equal? (linewrap (list a sp b c) 3) (list a 'lb b c))))
+     (check-equal? (linewrap (list a sp b c) 3) (list a sp b 'lb c))))
 
   
 #;(module+ test