diff --git a/quad/quad/position.rkt b/quad/quad/position.rkt index e861d9f8..5d42683a 100644 --- a/quad/quad/position.rkt +++ b/quad/quad/position.rkt @@ -27,7 +27,7 @@ [(nw) '(0 0 )] [(n) '(0.5 0 )] [(ne) '(1 0 )] [( w) '(0 0.5)] [(c) '(0.5 0.5)] [( e) '(1 0.5)] [(sw) '(0 1 )] [(s) '(0.5 1 )] [(se) '(1 1 )])) - (pt (coerce-int (* (pt-x (size q)) x-fac)) (coerce-int (* (pt-y (size q)) y-fac)))) + (pt (coerce-int (* (pt-x #R(size q)) x-fac)) (coerce-int (* (pt-y (size q)) y-fac)))) (define/contract (inner-point q) @@ -44,8 +44,9 @@ ((quad?) (point?) . ->* . quad?) (set-origin! q (pt- previous-end-pt (anchor->point q (start q)))) (for/fold ([pt (inner-point q)]) - ([q (in-list (elems q))]) - (end-point (position q pt))) + ([q (in-list (elems q))] + #:when (quad? q)) + (end-point #R(position q pt))) q) diff --git a/quad/quad/qexpr.rkt b/quad/quad/qexpr.rkt index a2d7cad6..efa92749 100644 --- a/quad/quad/qexpr.rkt +++ b/quad/quad/qexpr.rkt @@ -1,5 +1,12 @@ #lang debug racket/base -(require xml racket/contract racket/string racket/match racket/list txexpr "quad.rkt" "generic.rkt") +(require xml + racket/contract + racket/dict + racket/string + racket/match + racket/list + txexpr + "quad.rkt" "generic.rkt" sugar/debug) (provide (all-defined-out)) (module+ test (require rackunit)) @@ -43,13 +50,15 @@ (check-equal? (qexpr '((k "v2")(k "v1")) "foo") '(q ((k "v2")(k "v1")) "foo")) (check-equal? (qexpr #:clean-attrs? #t '((k "v2")(k "v1")) "foo") '(q ((k "v2")) "foo"))) - +(define (hash->qattrs attr-hash) + (for/list ([(k v) (in-dict (hash->list attr-hash))]) + (list k (format "~a" v)))) (define/contract (quad->qexpr q) (quad? . -> . qexpr?) (let loop ([x q]) (cond - [(quad? x) (apply qexpr #:name (quad-name x) #:clean-attrs? #t (hash->attrs (attrs x)) (map loop (elems x)))] + [(quad? x) (apply qexpr #:name (quad-name x) #:clean-attrs? #t (hash->qattrs (attrs x)) (map loop (elems x)))] [else x]))) (define/contract (qml->qexpr x) diff --git a/quad/quad/typewriter.rkt b/quad/quad/typewriter.rkt index ac44527b..94c2bc8e 100644 --- a/quad/quad/typewriter.rkt +++ b/quad/quad/typewriter.rkt @@ -1,5 +1,5 @@ #lang debug br/quicklang -(require racket/promise racket/list "quad.rkt" "atomize.rkt" "wrap.rkt" "qexpr.rkt" "generic.rkt") +(require racket/promise racket/list sugar/debug "quad.rkt" "atomize.rkt" "wrap.rkt" "qexpr.rkt" "generic.rkt" "position.rkt") (provide (rename-out [mb #%module-begin])) (define optional-break? (λ (q) (and (quad? q) (memv (car (elems q)) '(#\space))))) @@ -22,8 +22,8 @@ #:optional-break-proc optional-break? #:size-proc (λ (q) (let ([val (hash-ref (attrs q) 'size (λ () (if (memv (car (elems q)) '(#\space)) - (delay (values 0 1 0)) - (delay (values 1 1 1)))))]) + (delay (values 0 7.2 0)) + (delay (values 7.2 7.2 7.2)))))]) (if (promise? val) (force val) (val)))) #:finish-segment-proc (λ (pcs) (list ($line (hasheq) (map charify pcs)))))) @@ -31,11 +31,11 @@ (wrap xs size debug #:break-val (break #\page) #:optional-break-proc $break? - #:size-proc (λ (q) (force (hash-ref (attrs q) 'size (λ () (delay (values 1 1 1)))))) + #:size-proc (λ (q) (force (hash-ref (attrs q) 'size (λ () (delay (values 12 12 12)))))) #:finish-segment-proc (λ (pcs) (list ($page (hasheq) (filter-not $break? pcs)))))) (define (typeset args) - (quad->qexpr ($doc (hasheq) (filter-not $break? (pbs (lbs (atomize (apply quad #f args)) 3) 2))))) + (quad->qexpr ($doc (hasheq) (map position (filter-not $break? (pbs (lbs (atomize (apply quad #f args)) (* 3 7.2)) (* 2 12))))))) (define-syntax-rule (mb lang-line-config-arg . args) (#%module-begin diff --git a/quad/quad/wrap.rkt b/quad/quad/wrap.rkt index cd2b2150..6d127d6d 100644 --- a/quad/quad/wrap.rkt +++ b/quad/quad/wrap.rkt @@ -10,7 +10,7 @@ #:optional-break-proc [optional-break? (const #f)] #:finish-segment-proc [finish-segment-proc values] #:size-proc [size-proc (const 1)]) - ((any/c) (integer? any/c + ((any/c) (real? any/c #:break-val any/c #:mandatory-break-proc procedure? #:optional-break-proc procedure?