considerations

quad/main.rkt

@@ -45,12 +45,12 @@
             (quad->string line)
             (quad-attr-ref line world:line-looseness-key))))
 (require racket/trace)
-(define+provide/contract (block->lines b-in)
-  (block? . -> . lines?)
-  (define b (if (ormap string? (quad-list b-in))
-                (quads->block (split-quad b-in))
-                b-in))
-  (define quality (quad-attr-ref/parameter b world:quality-key))
+(define+provide/contract (block->lines token-refs)
+  ((listof integer?) . -> . lines?)
+
+  (define quality (report (calc-attrs (car token-refs))))
+  (error 'zam)
+  (define b #f)
   (define (wrap-quads qs)
     (define wrap-proc (cond
                         [(>= quality world:max-quality) wrap-best] 
@@ -214,33 +214,14 @@
     [else x]))
 
 
-(define-syntax-rule (cons-reverse x y)
-  (cons (reverse x) y))
-
 ;; page breaks > column breaks > block breaks > line breaks
-(define/contract (typeset2 x)
+(define/contract (typeset2 q)
   (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)))))))
-        
+  (input->current-tokens q)
+  (define mps (current-tokens->multipages))
+  (for* ([mp (in-list (reverse mps))][mc (in-list mp)][b (in-list mc)])
+    (block->lines (report b))))
+
 
 (module+ main
   (require "render.rkt" racket/class profile)
@@ -249,6 +230,6 @@
   (parameterize ([world:quality-default world:draft-quality]
                  [world:paper-width-default 600]
                  [world:paper-height-default 700])
-    (define ti (block '(measure 54 leading 18) "Meg is" (block-break) " ally."))
+    (define ti (block '(measure 54 quality 0) "Meg is an ally."))
     (define j (jude0))
     (time (typeset2 ti))))

quad/quads.rkt

@@ -10,8 +10,8 @@
                      [(define write-proc (λ(b port mode)
                                            (display (format "(~a)" (string-join (filter-not void? (list
                                                                                                    (~a (quad-name b)) 
-                                                                                                   (if (and (hash? (quad-attrs b)) (> (length (hash-keys (quad-attrs b))) 0)) (~v (flatten (hash->list (quad-attrs b)))) (void))
-                                                                                                   (if (> (length (quad-list b)) 0) (~a (string-join (map ~v (quad-list b)) "")) (void)))) " ")) port)))]
+                                                                                                   (~a (quad-attrs b))
+                                                                                                   (if (> (length (quad-list b)) 0) (~a (string-join (map ~v (quad-list b)) " ")) (void)))) " ")) port)))]
                      #:property prop:sequence (λ(q) (quad-list q)))
 
 
@@ -52,10 +52,11 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(define (token-ref? x) (integer? x))
 (define (quad-name? x) (symbol? x))
 (define (hashable-list? x) (and (list? x) (even? (length x))))
-(define (quad-attrs? x) (or (false? x) (hash? x)))
-(define (quad-list? x) (and (list? x) (andmap (λ(xi) (or (quad? xi) (and (string? xi) (< 0 (string-length xi))))) x)))
+(define (quad-attrs? x) (or (false? x) (token-ref? x)))
+(define (quad-list? x) (and (list? x) (andmap (λ(xi) (or (quad? xi) (token-ref? xi) (and (string? xi) (< 0 (string-length xi))))) x)))
 (define (quads? x) (and (list? x) (andmap quad? x)))
 (define (lists-of-quads? x) (and (list? x) (andmap quads? x)))
 
@@ -169,7 +170,8 @@
            ;; but don't put a separate contract on struct, because it's superfluous.
            (define/contract (id [attrs #f] . xs)
              (() ((or/c quad-attrs? hashable-list?)) #:rest quad-list? . ->* . id?)
-             (quad 'id (and attrs (if (hash? attrs) attrs (apply hash attrs))) xs))
+             (with-handlers ([exn:fail? (λ(exn) (error 'id "constructor failure with args: ~v ~v" attrs xs))])
+               (quad 'id attrs xs)))
            ;; quad list predicate and list-of-list predicate.
            ;; These are faster than the listof contract combinator.
            (define (ids? x)

quad/tokenize.rkt

@@ -49,22 +49,43 @@
   (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+provide (quad->current-tokens q)
+(define+provide (input->current-tokens q)
   (define-values (tokens attrs) (make-tokens-and-attrs q))
   (current-tokens tokens)
   (current-token-attrs attrs))
 
+(define+provide (token-ref i) (vector-ref (current-tokens) i))
+
+(define+provide (print-token-tree x)
+  (cond
+    [(list? x) (map print-token-tree x)]
+    [else (format "~a" (token-ref x))]))
+
 ;(filter (λ(idx) (box? (vector-ref tokens idx))) (range (vector-length tokens)))
 
 (define (attr-ref-hash a) (vector-ref a 0))
 (define (attr-ref-start a) (vector-ref a 1))
 (define (attr-ref-end a) (vector-ref a 2))
 
-(define (calc-attrs tref)
+
+(define-syntax-rule (cons-reverse x y)
+  (cons (reverse x) y))
+
+(define+provide (current-tokens->multipages)
+  (define-values (mps mcs bs b)
+    (for/fold ([multipages empty][multicolumns empty][blocks empty][block-acc empty])
+              ([(token tidx) (in-indexed (current-tokens))])
+      (cond
+        [(or (page-break? token) (eof? token)) (values (cons-reverse (cons-reverse (cons-reverse block-acc blocks) multicolumns) multipages) empty empty empty)]
+        [(column-break? token) (values multipages (cons-reverse (cons-reverse block-acc blocks) multicolumns) empty empty)]
+        [(block-break? token) (values multipages multicolumns (cons-reverse block-acc blocks) empty)]
+        [else (values multipages multicolumns blocks (cons tidx block-acc))])))
+  (reverse mps))
+
+(define+provide (calc-attrs tref)
   (map attr-ref-hash (filter (λ(attr) (<= (attr-ref-start attr) tref (sub1 (attr-ref-end attr)))) (current-token-attrs))))