diff --git a/quad/quad/dev.rkt b/quad/quad/dev.rkt index 8950e709..1d87a808 100644 --- a/quad/quad/dev.rkt +++ b/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))) diff --git a/quad/quad/foo.rkt b/quad/quad/foo.rkt deleted file mode 100644 index fa7ef132..00000000 --- a/quad/quad/foo.rkt +++ /dev/null @@ -1,2 +0,0 @@ -#lang quad -(q:zoo #f "hi" "there" "America") \ No newline at end of file diff --git a/quad/quad/parse.rkt b/quad/quad/parse.rkt new file mode 100644 index 00000000..f2e31a47 --- /dev/null +++ b/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* \ No newline at end of file diff --git a/quad/quad/quads.rkt b/quad/quad/quads.rkt index a550e749..e48057d5 100644 --- a/quad/quad/quads.rkt +++ b/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"))) \ No newline at end of file diff --git a/quad/quad/split.rkt b/quad/quad/split.rkt deleted file mode 100644 index f4b83473..00000000 --- a/quad/quad/split.rkt +++ /dev/null @@ -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")) \ No newline at end of file diff --git a/quad/quad/tokenize.rkt b/quad/quad/tokenize.rkt new file mode 100644 index 00000000..56cb3d99 --- /dev/null +++ b/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."))) diff --git a/quad/quad/top.rkt b/quad/quad/top.rkt deleted file mode 100644 index 7d635fc1..00000000 --- a/quad/quad/top.rkt +++ /dev/null @@ -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)))])) \ No newline at end of file diff --git a/quad/quad/typeset.rkt b/quad/quad/typeset.rkt new file mode 100644 index 00000000..5f50452e --- /dev/null +++ b/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)))