improve typeset loop with cols & pages

quad/quad/typeset.rkt

@@ -4,21 +4,35 @@
 
 (define last-bp-k #f)
 (define line-measure 80)
+(define col-measure 150)
+(define page-measure 300)
 
 (define (typeset qs)
-  (for/fold ([line-pos 0])
-            ([q (in-vector qs)])
-    (unless (quad-dim q) (measure! q))
+  (for*/fold ([page-pos 0]
+              [col-pos 0]
+              [line-pos 0])
+             ([q (in-vector qs)])
     (cond
-      [(and ($white? q) (let/cc bp-k (set! last-bp-k bp-k) #f))
-       (quad-dim-set! q 'break-line)
-       0]
-      [else (define next-line-pos (+ line-pos (quad-dim q)))
-            (if (> next-line-pos line-measure)
-                (last-bp-k #t)
-                next-line-pos)]))
+      [(not (quad-dim q)) ; fit pass
+       (measure! q)
+       (cond
+         [(> page-pos page-measure) (last-bp-k 'break-page)]
+         [(> col-pos col-measure) (last-bp-k 'break-col)]
+         [(> line-pos line-measure) (last-bp-k 'break-line)]
+         [(and ($white? q) (let/cc bp-k (set! last-bp-k bp-k) #f))
+          =>
+          (λ(k-result)
+            (quad-dim-set! q k-result)
+            (case k-result
+              [(break-line) (values page-pos col-pos 0)]
+              [(break-col)  (values page-pos 0 0)]
+              [(break-page) (values 0 0 0)]))]
+         [else (define qpos (quad-dim q))
+               (values (+ page-pos qpos) (+ col-pos qpos) (+ line-pos qpos))])]
+      [else ; fill pass
+       (values page-pos col-pos line-pos)]))
   qs)
 
 (module+ test
   (require "atomize.rkt")
-  (time (typeset (atomize (quad #f "Meg is an ally.")))))
+  (time (typeset (atomize (quad #f "Meg is an ally. Meg is an ally. Meg is an ally. Meg is an ally. Meg is an ally. Meg is an ally.")))))