tokenize & parse
parent
7e64eea4d7
commit
d4aa40528b
@ -1,2 +0,0 @@
|
|||||||
#lang quad
|
|
||||||
(q:zoo #f "hi" "there" "America")
|
|
@ -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*
|
@ -1,41 +1,53 @@
|
|||||||
#lang quad/dev
|
#lang racket/base
|
||||||
(provide (all-defined-out))
|
(provide (all-defined-out))
|
||||||
(require (for-syntax racket/string))
|
(require (for-syntax racket/string))
|
||||||
|
|
||||||
|
(struct $quad (attrs list) #:transparent)
|
||||||
|
|
||||||
(define (quad-attrs q) (vector-ref q 1))
|
(define quad? $quad?)
|
||||||
(define (quad-list q) (vector-ref q 0))
|
|
||||||
|
|
||||||
|
(define quad-attrs $quad-attrs)
|
||||||
(define (quad? x)
|
(define quad-list $quad-list)
|
||||||
(and (vector? x)
|
|
||||||
(vector? (quad-attrs x))
|
|
||||||
(list? (quad-list x))))
|
|
||||||
|
|
||||||
(define (quad-attrs? x) (list? x))
|
(define (quad-attrs? x) (list? x))
|
||||||
|
|
||||||
|
|
||||||
(define default-attrs (vector 12 "Courier" 0 0))
|
#|
|
||||||
(define (quad attrs . xs)
|
Attrs needed to specify rendered appearance:
|
||||||
(vector-immutable xs attrs))
|
(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]
|
(define (attrs #:size [size #f]
|
||||||
#:font [font #f]
|
#:font [font #f]
|
||||||
#:x [x #f]
|
#:posn [posn #f])
|
||||||
#:y [y #f])
|
(vector size font posn))
|
||||||
(vector size font x y))
|
|
||||||
|
|
||||||
(define attrs '(size font x y))
|
|
||||||
|
|
||||||
(define (attr-size a) (vector-ref a 0))
|
(define (attr-size a) (vector-ref a 0))
|
||||||
(define (attr-font a) (vector-ref a 1))
|
(define (attr-font a) (vector-ref a 1))
|
||||||
(define (attr-x a) (vector-ref a 2))
|
(define (attr-x a) (vector-ref a 2))
|
||||||
(define (attr-y a) (vector-ref a 3))
|
(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
|
(module+ test
|
||||||
(require rackunit)
|
(require rackunit)
|
||||||
(define q (quad "bar"))
|
(define q (quad #f "bar"))
|
||||||
(check-true (quad? q))
|
(check-true (quad? q))
|
||||||
(check-false (quad? 42))
|
(check-false (quad? 42))
|
||||||
(check-equal? (quad-attrs q) default-attrs)
|
(check-equal? (quad-attrs q) (attrs))
|
||||||
(check-equal? (quad-list q) '("bar")))
|
(check-equal? (quad-list q) '("bar")))
|
@ -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"))
|
|
@ -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.")))
|
@ -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)))]))
|
|
@ -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)))
|
Loading…
Reference in New Issue