From 6520faf2a71cc7e4421ff26f5e633fa08c1bc8ed Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 20 Jun 2016 08:29:21 -0700 Subject: [PATCH] improve typeset loop with cols & pages --- quad/quad/typeset.rkt | 36 +++++++++++++++++++++++++----------- 1 file changed, 25 insertions(+), 11 deletions(-) diff --git a/quad/quad/typeset.rkt b/quad/quad/typeset.rkt index 38ebf2b6..4875aab0 100644 --- a/quad/quad/typeset.rkt +++ b/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."))))) \ No newline at end of file + (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."))))) \ No newline at end of file