get flat

quad/quad/atomize.rkt

@@ -0,0 +1,22 @@
+#lang quad/dev
+(require racket/vector)
+(provide (all-defined-out))
+
+(define (atomize x)
+  (flatten
+   (let loop ([x x][loop-attrs default-attrs])
+     (cond
+       [(symbol? x) ($shim (attrs #:posn 0) x)]
+       [(string? x)
+        (for/list ([c (in-string x)])
+                  (cons ($shim (attrs #:posn 0) 0)
+                        (case c
+                          [(#\space #\newline #\return) ($white (vector-copy loop-attrs) c)]
+                          [else ($black (vector-copy loop-attrs) c)])))]
+       [else
+        (map (λ(xi) (loop xi ((quad-attrs x) . override-with . loop-attrs))) (quad-val x))]))))
+
+(module+ test
+  (require rackunit)
+  (atomize (quad (attrs #:size 10 #:font "Eq") "ba" (line-break) "r" (quad (attrs #:size 8) "zam") "q\tux"))
+  (atomize (quad #f "Meg is " (line-break) "\nan ally.")))

quad/quad/doc.rkt

@@ -1,19 +0,0 @@
-#lang quad/dev
-(require sugar/list)
-(provide (all-defined-out))
-
-(struct $doc (xs) #:transparent)
-(define (doc . xs) ($doc xs))
-
-(define (multipage . xs) xs)
-
-(define (multicolumn . xs) xs)
-
-(define (multiblock . xs) xs)
-
-(define (multiline . xs)
-  (wrap-lines xs))
-
-(struct $line $quad () #:transparent)
-(define (wrap-lines xs)
-  (map (λ(xis) ($line (gather-common-attrs xis) xis)) (slice-at xs 6)))

quad/quad/main.rkt

@@ -1,17 +1,15 @@
 #lang racket/base
-(require "quads.rkt" "doc.rkt" "parse.rkt" "tokenize.rkt" racket/list racket/string)
+(require "quads.rkt" "typeset.rkt" "atomize.rkt" racket/list racket/string)
 (provide (except-out (all-from-out racket/base "quads.rkt") #%module-begin)
          (rename-out [~module-begin #%module-begin]))
 
-(define-namespace-anchor ns)
-
 (define-syntax-rule (~module-begin lang-line-config-arg . args)
   (#%module-begin
    (define main-quad (quad #f . args))
    ;; branch on config-arg to allow debug / inspection options on #lang line
    (case (string-trim lang-line-config-arg)
-     [("#:atoms") (tokenize main-quad)]
-     [else (eval (parse (tokenize main-quad)) (namespace-anchor->namespace ns))])))
+     [("#:atoms") (atomize main-quad)]
+     [else (typeset (atomize main-quad))])))
 
 (module reader syntax/module-reader
   "main.rkt")

quad/quad/measure.rkt

@@ -0,0 +1,6 @@
+#lang quad/dev
+(provide (all-defined-out))
+
+(define (measure! q)
+  (when (or ($black? q) ($white? q))
+       (quad-posn-set! q 12)))

quad/quad/parse.rkt

@@ -1,11 +0,0 @@
-#lang brag
-
-doc : multipage [/PAGE-BREAK multipage]*
-
-multipage : multicolumn [/COLUMN-BREAK multicolumn]*
-
-multicolumn : multiblock [/BLOCK-BREAK multiblock]*
-
-multiblock : multiline [/LINE-BREAK multiline]*
-
-multiline : /QUAD-WHITE* (QUAD [QUAD-WHITE+ QUAD]*)* /QUAD-WHITE* 

quad/quad/quadlang-test.rkt

@@ -1,3 +1,3 @@
 #lang quad/text
 
-Meg is an ally. ;; @(line-break) Meg is an ally.
+Meg is an ally. @;{@(line-break) Meg is an ally.}

quad/quad/quads.rkt

@@ -2,13 +2,16 @@
 (provide (all-defined-out))
 (require (for-syntax racket/string racket/base racket/syntax))
 
-(struct $quad (attrs list) #:transparent)
-(struct $quad-white $quad () #:transparent)
+(struct $quad (attrs val) #:transparent #:mutable)
+(struct $black $quad () #:transparent #:mutable)
+(struct $white $quad () #:transparent #:mutable)
+(struct $skip $quad () #:transparent #:mutable)
+(struct $shim $quad () #:transparent #:mutable)
 
 (define quad? $quad?)
 
 (define quad-attrs $quad-attrs)
-(define quad-list $quad-list)
+(define quad-val $quad-val)
 
 (define (quad-attrs? x) (list? x))
 
@@ -33,19 +36,12 @@ measure (line width)
                #:posn [posn #f])
   (vector size font posn))
 
-(define (gather-common-attrs xs)
-  (define reference-attrs (quad-attrs (car xs)))
-  (for/vector ([idx (in-range (vector-length default-attrs))])
-              (if (for/and ([x (in-list (cdr xs))])
-                           (equal? (vector-ref reference-attrs idx) (vector-ref (quad-attrs x) idx)))
-                  (vector-ref reference-attrs idx)
-                  #f)))
 
+(define (quad-posn q)
+  (vector-ref ($quad-attrs q) 2))
 
-(define (attr-size a) (vector-ref a 0))
-(define (attr-font a) (vector-ref a 1))
-(define (attr-x a) (vector-ref a 2))
-(define (attr-y a) (vector-ref a 3))
+(define (quad-posn-set! q val)
+  (vector-set! ($quad-attrs q) 2 val))
 
 (define (override-with dest source)
   ;; replace missing values in dest with values from source
@@ -73,4 +69,4 @@ measure (line width)
   (check-true (quad? q))
   (check-false (quad? 42))
   (check-equal? (quad-attrs q) (attrs))
-  (check-equal? (quad-list q) '("bar")))
+  (check-equal? (quad-val q) '("bar")))

quad/quad/tokenize.rkt

@@ -1,21 +0,0 @@
-#lang quad/dev
-(require brag/support)
-(provide (all-defined-out))
-
-(define (tokenize x)
-  (flatten
-   (let loop ([x x][attrs default-attrs])
-     (cond
-       [(symbol? x) (token x #f)]
-       [(string? x)
-        (for/list ([c (in-string x)])
-                  (case c
-                    [(#\space #\newline #\return) (token 'QUAD-WHITE ($quad-white attrs c))]
-                    [else (token 'QUAD (quad attrs c))]))]
-       [else
-        (map (λ(xi) (loop xi ((quad-attrs x) . override-with . attrs))) (quad-list x))]))))
-
-(module+ test
-  (require rackunit "parse.rkt")
-  (tokenize (quad (attrs #:size 10 #:font "Eq") "ba" (line-break) "r" (quad (attrs #:size 8) "zam") "q\tux"))
-  (syntax->datum (parse (tokenize (quad #f "Meg is " (line-break) "\nan ally.")))))

quad/quad/typeset.rkt

@@ -1,19 +1,22 @@
 #lang quad/dev
 (provide (all-defined-out))
-(require "tokenize.rkt" "parse.rkt")
+(require "measure.rkt")
 
-#;(define (typeset x)
-    (pages->doc
-     (append*
-      (for/list ([multipage (in-list (input->nested-blocks x))])
-                (columns->pages
-                 (append*
-                  (for/list ([multicolumn (in-list multipage)])
-                            (lines->columns
-                             (append*
-                              (for/list ([block-quads (in-list multicolumn)])
-                                        (block-quads->lines block-quads)))))))))))
+(define line-start-k #f)
 
+(define (typeset qs)
+  (for-each measure! qs)
+  (for/fold ([line-pos 0])
+            ([q (in-list qs)])
+    (unless line-start-k
+      (let/cc here-k (set! line-start-k here-k)))
+    (define next-line-pos (+ line-pos (quad-posn q)))
+    (if (and (> next-line-pos 84) ($white? q))
+        (begin (quad-posn-set! q 'break-line) 0)
+        next-line-pos))
+  qs)
 
-(define input (quad #f "Meg is an ally." (quad #f 'page-break) "Meg is an ally."))
-(syntax->datum (parse (tokenize input)))
+(module+ test
+  (require "atomize.rkt")
+  (define qs (atomize (quad #f "Meg is an ally.")))
+  (typeset qs))