From 6ecd6eee90e2e0eb9f4190eedfa46bf83aa130f6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 19 Aug 2019 15:19:54 -0700 Subject: [PATCH] refac --- quad/qtest/mydraw.rkt | 16 ++++++++ quad/quadwriter/layout.rkt | 81 +++++++++++++++++++++----------------- 2 files changed, 61 insertions(+), 36 deletions(-) create mode 100644 quad/qtest/mydraw.rkt diff --git a/quad/qtest/mydraw.rkt b/quad/qtest/mydraw.rkt new file mode 100644 index 00000000..3dcde4d9 --- /dev/null +++ b/quad/qtest/mydraw.rkt @@ -0,0 +1,16 @@ +#lang quadwriter + +'(q ((page-width "4in")(page-height "4in")) + +"Hello world" + +(q ((position "absolute") + (draw "line") +(x1 "10") (y1 "10") +(x1 "100") (y1 "100")) "duh") + +(q ((break "page"))) + +"Goodbye fools" + +) \ No newline at end of file diff --git a/quad/quadwriter/layout.rkt b/quad/quadwriter/layout.rkt index 1cb914e5..2161e264 100644 --- a/quad/quadwriter/layout.rkt +++ b/quad/quadwriter/layout.rkt @@ -99,43 +99,52 @@ [else 0])) (list string-size (quad-ref q :line-height (current-line-height pdf))))) +(define (maybe-do-image-quad? q) + (define path-string (quad-ref q :image-file)) + (and path-string + (let () + (unless (file-exists? path-string) + (raise-argument-error 'create-image-quad "image path that exists" path-string)) + (define img-obj (open-image (current-pdf) path-string)) + (define img-width ($img-width img-obj)) + (define img-height ($img-height img-obj)) + (match-define (list layout-width layout-height) + (match (list (quad-ref q :image-width) (quad-ref q :image-height)) + [(list (? number? w) (? number? h)) (list w h)] + [(list #false (? number? h)) + (define ratio (/ h img-height)) + (list (* ratio img-width) h)] + [(list (? number? w) #false) + (define ratio (/ w img-width)) + (list w (* ratio img-height))] + [(list #false #false) (list img-width img-height)])) + (struct-copy + image-quad q:image + [attrs #:parent quad (let ([h (hash-copy (quad-attrs q))]) + ;; defeat 'bi 'bo positioning by removing font reference + (hash-set! h font-path-key #false) + ;; save the img-obj for later + (hash-set! h :image-object img-obj) + h)] + [size #:parent quad (pt layout-width layout-height)])))) + +(define (maybe-do-line-break-quad? q) + (and (line-break-quad? q) q)) + +(define (do-string-quad q) + (struct-copy + string-quad q:string + [attrs #:parent quad (let ([attrs (quad-attrs q)]) + (hash-ref! attrs :font-size default-font-size) + attrs)] + [elems #:parent quad (quad-elems q)] + [size #:parent quad (make-size-promise q)])) + (define (generic->typed-quad q) - (cond - [(line-break-quad? q) q] - [(match (quad-ref q :image-file) - [#false #false] - [(? file-exists? path-string) - (define img-obj (open-image (current-pdf) path-string)) - (define img-width ($img-width img-obj)) - (define img-height ($img-height img-obj)) - (match-define (list layout-width layout-height) - (match (list (quad-ref q :image-width) (quad-ref q :image-height)) - [(list (? number? w) (? number? h)) (list w h)] - [(list #false (? number? h)) - (define ratio (/ h img-height)) - (list (* ratio img-width) h)] - [(list (? number? w) #false) - (define ratio (/ w img-width)) - (list w (* ratio img-height))] - [(list #false #false) (list img-width img-height)])) - (struct-copy - image-quad q:image - [attrs #:parent quad (let ([h (hash-copy (quad-attrs q))]) - ;; defeat 'bi 'bo positioning by removing font reference - (hash-set! h font-path-key #false) - ;; save the img-obj for later - (hash-set! h :image-object img-obj) - h)] - [size #:parent quad (pt layout-width layout-height)])] - [bad-path (raise-argument-error 'quadwriter "image path that exists" bad-path)])] - [else - (struct-copy - string-quad q:string - [attrs #:parent quad (let ([attrs (quad-attrs q)]) - (hash-ref! attrs :font-size default-font-size) - attrs)] - [elems #:parent quad (quad-elems q)] - [size #:parent quad (make-size-promise q)])])) + (or + (maybe-do-line-break-quad? q) + (maybe-do-image-quad? q) + (do-string-quad q))) (define (draw-debug q doc [fill-color "#f99"] [stroke-color "#fcc"] [stroke-width 0.5])