diff --git a/quad2/draw.rkt b/quad2/draw.rkt index 8ee08a65..05039e17 100644 --- a/quad2/draw.rkt +++ b/quad2/draw.rkt @@ -17,7 +17,7 @@ (for/list ([q (in-list qs)]) (cond [(quad? q) - (list ($move (quad-posn q)) ($text (char->integer (quad-char q))))] + (list ($move (quad-posn q)) ($text (char->integer (car (string->list (car (quad-elems q)))))))] [else (error 'render-unknown-thing)])) ($page 'end) ($doc 'end)))) diff --git a/quad2/layout.rkt b/quad2/layout.rkt index 87d1d4bb..63902495 100644 --- a/quad2/layout.rkt +++ b/quad2/layout.rkt @@ -16,8 +16,6 @@ (quad? . -> . $size?) ($size 1 0)) - - (define (min-x rect) ($point-x ($rect-origin rect))) (define (width rect) ($size-width ($rect-size rect))) (define (max-x rect) (+ (min-x rect) (width rect))) diff --git a/quad2/linearize.rkt b/quad2/linearize.rkt index 03886cf0..9096752a 100644 --- a/quad2/linearize.rkt +++ b/quad2/linearize.rkt @@ -50,9 +50,7 @@ [(null? head) e0] [else (define qs-to-merge (cons e0 head)) - (make-quad #:tag (quad-tag e0) - #:attrs (quad-attrs e0) - #:elems (list (string-join (append-map quad-elems qs-to-merge) "")))]) + (struct-copy quad e0 [elems (list (string-join (append-map quad-elems qs-to-merge) ""))])]) (merge tail))]))) (module+ test @@ -69,17 +67,26 @@ (for/list ([q (in-list qs)]) (match (quad-elems q) [(list (? string? str)) - (define tag (quad-tag q)) - (define attrs (quad-attrs q)) ;; the "gaps" (parts that don't match pattern) are guaranteed to be at even indexes ;; If string starts with a "gap", a zero-length separator is appended to the start. ;; so we just ignore those. (for/list ([(substr idx) (in-indexed (regexp-match* whitespace-pat str #:gap-select? #t))] #:unless (zero? (string-length substr))) - (make-quad #:tag tag - #:attrs attrs - #:elems (list (if (even? idx) substr word-space))))] + (struct-copy quad q [elems (list (if (even? idx) substr word-space))]))] [_ (list q)])))) (module+ test - (split-whitespace mlqs)) + (define smlqs (split-whitespace mlqs))) + +(define-pass (mark-text-runs qs) + #:pre (list-of simple-quad?) + #:post (list-of simple-quad?) + (for ([q (in-list qs)] + #:when (match (quad-elems q) + [(list (? string?) ..1) #t] + [_ #false])) + (set-quad-tag! q 'text-run)) + qs) + +(module+ test + (mark-text-runs smlqs)) \ No newline at end of file diff --git a/quad2/main.rkt b/quad2/main.rkt index 4053938d..c80c650f 100644 --- a/quad2/main.rkt +++ b/quad2/main.rkt @@ -6,10 +6,11 @@ "linearize.rkt" "layout.rkt" "draw.rkt" + "struct.rkt" racket/string racket/match) -(define-pass (bootstrap x) +(define-pass (bootstrap-input x) #:pre values #:post quad? (match x @@ -17,37 +18,35 @@ [(and (list (? quad?) ...) qs) (make-quad #:elems qs)] [other (make-quad #:elems (list other))])) -(define-pass (make-weirdo-char-quads qs) +(define-pass (single-char-quads qs) #:pre (list-of simple-quad?) #:post (list-of simple-quad?) (apply append (for/list ([q (in-list qs)]) (match q - [(quad _ _ (list (? string? str))) + [(quad _ _ (list (? string? str)) _) (for/list ([c (in-string str)]) - (define new-attrs (make-hasheq (cons (cons 'char c) (hash->list (quad-attrs q))))) - (make-quad #:tag (quad-tag q) - #:attrs new-attrs - #:elems null))] + (struct-copy quad q [elems (list (string c))]))] [_ (list q)])))) (define quad-compile (make-pipeline (list - bootstrap + bootstrap-input linearize + mark-text-runs merge-adjacent-strings split-whitespace - make-weirdo-char-quads + single-char-quads layout make-drawing-insts stackify))) -(define drawing-insts (parameterize ([current-wrap-width 13]) +(define insts (parameterize ([current-wrap-width 13]) (quad-compile "Hello this is the earth"))) -(displayln drawing-insts) +(displayln insts) -(render drawing-insts #:using text-renderer) -(render drawing-insts #:using drr-renderer) - -#;(render-to-html drawing-insts) -#;(render-to-pdf drawing-insts) \ No newline at end of file +(when (string? insts) + (render insts #:using text-renderer) + (render insts #:using drr-renderer) + #;(render-to-html drawing-insts) + #;(render-to-pdf drawing-insts)) diff --git a/quad2/quad.rkt b/quad2/quad.rkt index 63c5534c..d23e1ff8 100644 --- a/quad2/quad.rkt +++ b/quad2/quad.rkt @@ -14,16 +14,16 @@ (define (list-of proc) (λ (x) (and (list? x) (andmap proc x)))) -(struct quad (tag attrs elems) #:transparent #:mutable +(struct quad (tag attrs elems posn) #:transparent #:mutable #:constructor-name quad-constructor - #:guard (λ (tag attrs elems name) + #:guard (λ (tag attrs elems posn name) (unless (match (list tag attrs elems) [(list (? quad-tag?) (? quad-attrs?) (? quad-elems?)) #true] [_ #false]) (error 'no-dice)) - (values tag attrs elems))) + (values tag attrs elems posn))) (define (quad-tag? x) (match x [(or (? symbol?) #false) #true] @@ -42,7 +42,7 @@ #:attrs [attrs (make-quad-attrs null)] #:elems [elems null]) (() (#:tag quad-tag? #:attrs quad-attrs? #:elems quad-elems?) . ->* . quad?) - (quad-constructor tag attrs elems)) + (quad-constructor tag attrs elems #false)) (define (quad-ref q key [default-val #false]) (hash-ref (quad-attrs q) key default-val)) @@ -58,8 +58,7 @@ (define (GETTER q) (quad-ref q 'FIELD)) (define (SETTER q val) (quad-set! q 'FIELD val))))])) -(define-quad-field posn) -(define-quad-field char) +#;(define-quad-field posn) (define (has-no-position? q) (not (has-position? q))) (define (has-position? q) (quad-posn q)) diff --git a/quad2/render.rkt b/quad2/render.rkt index c9f64872..cc65600e 100644 --- a/quad2/render.rkt +++ b/quad2/render.rkt @@ -36,7 +36,7 @@ (for/list ([x (in-range xmax)]) (hash-ref char-pos-table (make-rectangular x y) (char->integer #\space)))))) "\n")) (set! results (cons str results))) - (λ (charint) (hash-set! char-pos-table current-loc charint)) + (λ (str) (hash-set! char-pos-table current-loc str)) (λ (x y) (set! current-loc (make-rectangular x y))) (λ () (unless (pair? results)