add `quad/text` and #lang line options

quad/quad/doc.rkt

@@ -0,0 +1,19 @@
+#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)
+  (break-lines xs))
+
+(struct $line (xs) #:transparent)
+(define (break-lines xs)
+  (map (λ(xis) ($line xis)) (slice-at xs 6)))

quad/quad/main.rkt

@@ -1,11 +1,17 @@
 #lang racket/base
-(require "quads.rkt")
-(provide (all-from-out racket/base "quads.rkt"))
+(require "quads.rkt" "doc.rkt" "parse.rkt" "tokenize.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)
 
-(module reader racket/base
-  (require br/reader-utils "parse.rkt" "tokenize.rkt")
-  
-  (define-read-and-read-syntax (source-path input-port)
-    #`(module quad-mod 
-        #,(parse source-path (tokenize input-port)))))
+(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))])))
+
+(module reader syntax/module-reader
+  "main.rkt")

quad/quad/quadlang-test.rkt

@@ -1,3 +1,3 @@
-#lang quad
+#lang quad/text
 
-(quad #f "Meg is an ally." (quad #f 'page-break) "Meg is an ally.")
+Meg is an ally. @(line-break) Meg is an ally.

quad/quad/quads.rkt

@@ -1,6 +1,6 @@
 #lang racket/base
 (provide (all-defined-out))
-(require (for-syntax racket/string))
+(require (for-syntax racket/string racket/base racket/syntax))
 
 (struct $quad (attrs list) #:transparent)
 
@@ -20,6 +20,7 @@ Attrs needed to specify rendered appearance:
 color
 background
 position
+measure (line width)
 
 |#
 (define default-attrs (vector 12 "Courier" 0))
@@ -44,6 +45,19 @@ position
               (vector-set! dest i (vector-ref source i))))
   dest)
 
+(require (for-syntax sugar/debug))
+(define-syntax (define-break stx)
+  (syntax-case stx ()
+    [(_ name)
+     (with-syntax ([BREAK-NAME (string->symbol (string-upcase (symbol->string (syntax->datum #'name))))])
+       #'(define (name) (quad #f 'BREAK-NAME)))]))
+
+(define-break page-break)
+(define-break column-break)
+(define-break block-break)
+(define-break line-break)
+
+
 (module+ test
   (require rackunit)
   (define q (quad #f "bar"))

quad/quad/text.rkt

@@ -0,0 +1,33 @@
+#lang racket/base
+
+#|
+Same semantics as `#lang quad`,
+but substitutes a Scribble-style text-based reader
+|#
+
+(module reader syntax/module-reader
+  "main.rkt"
+  #:read quad-read
+  #:read-syntax quad-read-syntax
+  #:whole-body-readers? #t ;; need this to make at-reader work
+  (require scribble/reader racket/list sugar/list)
+  
+  (define (quad-read p)
+    (syntax->datum (quad-read-syntax (object-name p) p)))
+  
+  (define quad-command-char #\@)
+  
+  (define (quad-read-syntax path-string p)
+    (define quad-at-reader (make-at-reader
+                            #:command-char quad-command-char
+                            #:syntax? #t 
+                            #:inside? #t))
+    (define source-stx (quad-at-reader path-string p))
+    (define source-stx-list (syntax->list source-stx))
+    (define config-line (car source-stx-list))
+    ;; we dump all whitespace lines in plain-text mode, as they have no semantic purpose
+    ;; the at-reader will kindly separate these all-whitespace lines into their own list elements
+    (define source-stx-no-interline-whitespace
+      (filter (λ(stx) (define datum (syntax->datum stx))
+                (and (string? datum) (regexp-match #rx"\\s+" datum))) (cdr source-stx-list)))
+    (datum->syntax source-stx (cons config-line source-stx-no-interline-whitespace) source-stx)))

quad/quad/tokenize.rkt

@@ -6,7 +6,7 @@
   (flatten
    (let loop ([x x][attrs default-attrs])
      (cond
-       [(symbol? x) (token (string->symbol (string-upcase (symbol->string x))) #f)]
+       [(symbol? x) (token x #f)]
        [(string? x)
          (map (λ(xi) (token 'QUAD (quad attrs xi))) (string->list x))]
        [else
@@ -14,6 +14,5 @@
 
 (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.")))
+  (tokenize (quad (attrs #:size 10 #:font "Eq") "ba" (line-break) "r" (quad (attrs #:size 8) "zam") "q\tux"))
+  (tokenize (quad #f "Meg is" (block-break) " an ally.")))