diff --git a/quad/main.rkt b/quad/main.rkt index 57b35c80..a0cf4fc6 100644 --- a/quad/main.rkt +++ b/quad/main.rkt @@ -1,6 +1,6 @@ #lang racket/base (require racket/list sugar racket/contract racket/function math/flonum) -(require "quads.rkt" "utils.rkt" "wrap.rkt" "measure.rkt" "world.rkt" "logger.rkt") +(require "quads.rkt" "utils.rkt" "wrap.rkt" "measure.rkt" "world.rkt" "logger.rkt" "tokenize.rkt") (provide typeset) (define+provide/contract (input->multipages i) @@ -213,9 +213,34 @@ [(block? x) (map typeset (block->lines x))] ; about 2/3 of running time [else x])) -(define (para ht . xs) - (apply box ht `(,(block-break) ,@xs ,(block-break)))) +(define-syntax-rule (cons-reverse x y) + (cons (reverse x) y)) + +;; page breaks > column breaks > block breaks > line breaks +(define/contract (typeset2 x) + (coerce/input? . -> . any) + (quad->current-tokens x) + (define-values (mps mcs mbs b) + (for/fold ([multipages empty][multicolumns empty][multiblocks empty][block empty]) + ([token (in-vector (current-tokens))]) + (cond + [(or (page-break? token) (eof? token)) (values (cons (cons (cons block multiblocks) multicolumns) multipages) empty empty empty)] + [(column-break? token) (values multipages (cons (cons block multiblocks) multicolumns) empty empty)] + [(block-break? token) (values multipages multicolumns (cons block multiblocks) empty)] + [else (values multipages multicolumns multiblocks (cons token block))]))) + mps) + +(define/contract (typeset3 x) + (coerce/input? . -> . any) + (quad->current-tokens x) + (for/last ([token (in-vector (current-tokens))]) + (for/list ([mp (in-naturals)]) + (for/list ([mc (in-naturals)] #:break (or (page-break? token) (eof? token))) + (for/list ([mb (in-naturals)] #:break (column-break? token)) + (for/list ([b (in-naturals)] #:break (block-break? token)) + (report token))))))) + (module+ main (require "render.rkt" racket/class profile) @@ -224,5 +249,6 @@ (parameterize ([world:quality-default world:draft-quality] [world:paper-width-default 600] [world:paper-height-default 700]) - (define to (begin (time (typeset (jude0))))) - (time (send (new pdf-renderer%) render-to-file to "foo.pdf")))) + (define ti (block '(measure 54 leading 18) "Meg is" (block-break) " ally.")) + (define j (jude0)) + (time (typeset2 ti)))) \ No newline at end of file diff --git a/quad/experimental.rkt b/quad/tokenize.rkt similarity index 85% rename from quad/experimental.rkt rename to quad/tokenize.rkt index 64d827bf..56d6b952 100644 --- a/quad/experimental.rkt +++ b/quad/tokenize.rkt @@ -2,7 +2,7 @@ (require racket/list sugar/define) (require "samples.rkt" "quads.rkt" "utils.rkt") -(define ti (block '(measure 54 leading 18) "Meg is " (box '(foo 42)) " ally.")) + (define tib (block '(measure 240 font "Equity Text B" leading 16 size 13.5 x-align justify x-align-last-line left) (block #f (block '(weight bold font "Equity Caps B") "Hello") (block-break) (box '(width 15))))) ;ti @@ -39,19 +39,26 @@ (define-values (exploded-chars last-idx-of-exploded-chars) (for/fold ([chars empty][last-idx #f])([(c i) (in-indexed item)]) (values (cons c chars) i))) ; fold manually to get reversed items & length at same time - (values (cons exploded-chars token-acc) subattr-acc (+ tidx (add1 last-idx-of-exploded-chars)))]))) + (values (cons exploded-chars token-acc) subattr-acc (+ tidx last-idx-of-exploded-chars 1))]))) (values tokens-from-fold (let ([current-quad-attrs (quad-attrs current-quad)]) (if current-quad-attrs (cons (vector current-quad-attrs starting-tidx ending-tidx-from-fold) subattrs-from-fold) subattrs-from-fold)) ending-tidx-from-fold)]))) - (values (list->vector (reverse (flatten all-tokens))) (flatten all-attrs))) + (values (list->vector (reverse (cons (current-eof) (flatten all-tokens)))) (flatten all-attrs))) + + +(define+provide current-tokens (make-parameter #f)) +(define+provide current-token-attrs (make-parameter #f)) +(define+provide current-eof (make-parameter (gensym))) +(define+provide (eof? x) (equal? x (current-eof))) -(define-values (tokens attrs) (make-tokens-and-attrs (ti5))) -(define+provide current-tokens (make-parameter tokens)) -(define+provide current-token-attrs (make-parameter attrs)) +(define+provide (quad->current-tokens q) + (define-values (tokens attrs) (make-tokens-and-attrs q)) + (current-tokens tokens) + (current-token-attrs attrs)) ;(filter (λ(idx) (box? (vector-ref tokens idx))) (range (vector-length tokens)))