diff --git a/quad/quad/doc.rkt b/quad/quad/doc.rkt new file mode 100644 index 00000000..73f3cbb1 --- /dev/null +++ b/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))) diff --git a/quad/quad/main.rkt b/quad/quad/main.rkt index 7675a093..523e5ab0 100644 --- a/quad/quad/main.rkt +++ b/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") \ No newline at end of file diff --git a/quad/quad/quadlang-test.rkt b/quad/quad/quadlang-test.rkt index 5a7092d0..22665385 100644 --- a/quad/quad/quadlang-test.rkt +++ b/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.") \ No newline at end of file +Meg is an ally. @(line-break) Meg is an ally. diff --git a/quad/quad/quads.rkt b/quad/quad/quads.rkt index e48057d5..d155371d 100644 --- a/quad/quad/quads.rkt +++ b/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")) diff --git a/quad/quad/text.rkt b/quad/quad/text.rkt new file mode 100644 index 00000000..e14225dc --- /dev/null +++ b/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))) \ No newline at end of file diff --git a/quad/quad/tokenize.rkt b/quad/quad/tokenize.rkt index 56cb3d99..4d22b45b 100644 --- a/quad/quad/tokenize.rkt +++ b/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.")))