tokenize & parse

quad/quad/dev.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
-(require (for-syntax racket/base) racket/list sugar/debug)
+(require (for-syntax racket/base) racket/list sugar/debug "quads.rkt")
 (provide (except-out (all-from-out racket/base) #%module-begin)
-         (all-from-out racket/list sugar/debug)
+         (all-from-out racket/list sugar/debug "quads.rkt")
          (rename-out [~module-begin #%module-begin])
          (for-syntax (all-from-out racket/base)))
 

quad/quad/foo.rkt

@@ -1,2 +0,0 @@
-#lang quad
-(q:zoo #f "hi" "there" "America")

quad/quad/parse.rkt

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

quad/quad/quads.rkt

@@ -1,41 +1,53 @@
-#lang quad/dev
+#lang racket/base
 (provide (all-defined-out))
 (require (for-syntax racket/string))
 
+(struct $quad (attrs list) #:transparent)
 
-(define (quad-attrs q) (vector-ref q 1))
-(define (quad-list q) (vector-ref q 0))
+(define quad? $quad?)
 
-
-(define (quad? x)
-  (and (vector? x)
-       (vector? (quad-attrs x))
-       (list? (quad-list x))))
+(define quad-attrs $quad-attrs)
+(define quad-list $quad-list)
 
 (define (quad-attrs? x) (list? x))
 
 
-(define default-attrs (vector 12 "Courier" 0 0))
-(define (quad attrs . xs)
-  (vector-immutable xs attrs))
+#|
+Attrs needed to specify rendered appearance:
+(font) family
+(font) style 
+(font) size
+color
+background
+position
+
+|#
+(define default-attrs (vector 12 "Courier" 0))
+(define (quad attr . xs)
+  ($quad (or attr (attrs)) xs))
 
-(define (make-quad-attrs #:size [size #f]
-              #:font [font #f]
-              #:x [x #f]
-              #:y [y #f])
-  (vector size font x y))
+(define (attrs #:size [size #f]
+               #:font [font #f]
+               #:posn [posn #f])
+  (vector size font posn))
 
-(define attrs '(size font x y))
 
 (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 (override-with dest source)
+  ;; replace missing values in dest with values from source
+  (for ([i (in-range (vector-length source))])
+            (unless (vector-ref dest i)
+              (vector-set! dest i (vector-ref source i))))
+  dest)
+
 (module+ test
   (require rackunit)
-  (define q (quad "bar"))
+  (define q (quad #f "bar"))
   (check-true (quad? q))
   (check-false (quad? 42))
-  (check-equal? (quad-attrs q) default-attrs)
+  (check-equal? (quad-attrs q) (attrs))
   (check-equal? (quad-list q) '("bar")))

quad/quad/split.rkt

@@ -1,16 +0,0 @@
-#lang quad/dev
-(require "quads.rkt")
-
-(define (split-quad x)
-  (flatten
-   (let loop ([x x][attrs default-attrs])
-     (cond
-       [(string? x) (map (λ(xi) (quad attrs xi)) (string->list x))]
-       [else
-        (define x-attrs (quad-attrs x))
-        (for ([i (in-range (vector-length attrs))])
-             (unless (vector-ref x-attrs i)
-               (vector-set! x-attrs i (vector-ref attrs i))))
-        (map (λ(xi) (loop xi x-attrs)) (quad-list x))]))))
-
-(split-quad (quad (make-quad-attrs #:size 10 #:font "Eq") "ba\nr" (quad (make-quad-attrs #:size 8) "zam") "q\tux"))

quad/quad/tokenize.rkt

@@ -0,0 +1,19 @@
+#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 (string->symbol (string-upcase (symbol->string x))) #f)]
+       [(string? x)
+         (map (λ(xi) (token 'QUAD (quad attrs xi))) (string->list x))]
+       [else
+         (map (λ(xi) (loop xi ((quad-attrs x) . override-with . attrs))) (quad-list x))]))))
+
+(module+ test
+  (require rackunit)
+  (tokenize (quad (attrs #:size 10 #:font "Eq") "ba" (quad #f 'line-break) "r" (quad (attrs #:size 8) "zam") "q\tux"))
+
+  (tokenize (quad #f "Meg is" (quad #f 'line-break) " an ally.")))

quad/quad/top.rkt

@@ -1,12 +0,0 @@
-#lang quad/dev
-(provide (all-defined-out))
-(require "quads.rkt" (for-syntax racket/string racket/syntax))
-
-(define-syntax (~top stx)
-  (syntax-case stx ()
-    [(_ . id)
-     (let ([id-str (format "~a" (syntax->datum #'id))])
-       (if (id-str . string-prefix? . "q:")
-           (with-syntax ([new-id (format-id #'id "~a" (string-trim id-str "q:" #:right? #f))])
-             #'(λ args (apply quad 'new-id args)))
-           #'(#%top . id)))]))

quad/quad/typeset.rkt

@@ -0,0 +1,19 @@
+#lang quad/dev
+(provide (all-defined-out))
+(require "tokenize.rkt" "parse.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 input (quad #f "Meg is" (quad #f 'line-break) " an ally."))
+(syntax->datum (parse (tokenize input)))