From c4a58dc4a5b67d16320b0761ff234a940be6dbae Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 27 Jun 2014 16:58:03 +0100 Subject: [PATCH] pict: implement 'pdf-bytes+bounds8, etc. conversions Also, add a `convert-bounds-padding` parameter that defaults to adding 3 units (= pixels, usually) on each side of a pict when converting to a format that supports padding. Combined with changes to Scribble to use the new formatting, the extra padding solves the long-standing problem of rendering picts and having an edge (especially the bottom and right) cut off due to rounding effects. For example, see `file-icon` in section 7.1 of the `pict` documentation. The choice of 3 pixels is more or less arbitrary; it covers the case of edge pixels and italic fonts for typical font sizes, but it obviously won't cover all drawing outside of a bounding box, as for the documentation example `(desktop-machine 1 '(devil plt))`. --- .../pict-doc/pict/scribblings/pict.scrbl | 9 +++ pkgs/pict-pkgs/pict-lib/texpict/mrpict.rkt | 1 + .../pict-lib/texpict/private/mrpict-extra.rkt | 80 ++++++++++++++----- .../pict-lib/texpict/private/mrpict-sig.rkt | 1 + 4 files changed, 71 insertions(+), 20 deletions(-) diff --git a/pkgs/pict-pkgs/pict-doc/pict/scribblings/pict.scrbl b/pkgs/pict-pkgs/pict-doc/pict/scribblings/pict.scrbl index d0cd4c4be9..962791935f 100644 --- a/pkgs/pict-pkgs/pict-doc/pict/scribblings/pict.scrbl +++ b/pkgs/pict-pkgs/pict-doc/pict/scribblings/pict.scrbl @@ -986,6 +986,15 @@ drawing contexts, so the default value of @racket[dc-for-text-size] is a @racket[bitmap-dc%] that draws to a 1-by-1 bitmap.} +@defparam[convert-bounds-padding padding (list/c (>=/c 0) (>=/c 0) (>=/c 0) (>=/c 0))]{ + +A parameter that determines an amount of padding added to each edge of +a @tech{pict} when converting to a format like @racket['png@2x-bytes+bounds8] +(see @racketmodname[file/convertible]). The default value of the parameter +is @racket['(3 3 3 3)], which adds three pixels to each edge to accomodate +a small amount of drawing outside the pict's @tech{bounding box}.} + + @defproc[(draw-pict [pict pict?] [dc (is-a?/c dc<%>)] [x real?] diff --git a/pkgs/pict-pkgs/pict-lib/texpict/mrpict.rkt b/pkgs/pict-pkgs/pict-lib/texpict/mrpict.rkt index cfec52317d..4636009a35 100644 --- a/pkgs/pict-pkgs/pict-lib/texpict/mrpict.rkt +++ b/pkgs/pict-pkgs/pict-lib/texpict/mrpict.rkt @@ -21,6 +21,7 @@ (provide-signature-elements texpict-common^) (provide dc-for-text-size + convert-bounds-padding show-pict caps-text current-expected-text-scale dc diff --git a/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-extra.rkt b/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-extra.rkt index 9a7ec11622..92a7a91a58 100644 --- a/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-extra.rkt +++ b/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-extra.rkt @@ -1,6 +1,7 @@ #lang scheme/unit - (require racket/class) + (require racket/class + racket/list) (require racket/draw/draw-sig racket/gui/dynamic @@ -73,9 +74,20 @@ (lambda (x) (unless (or (not x) (is-a? x dc<%>)) - (raise-type-error 'dc-for-parameter "dc<%> object or #f" x)) + (raise-argument-error 'dc-for-parameter "(or/c (is-a?/c dc<%>) #f)" x)) x))) + (define convert-bounds-padding + (make-parameter + (list 3 3 3 3) + (lambda (x) + (unless (and (list? x) (= 4 (length x)) (andmap real? x) + (andmap (lambda (i) (not (negative? i))) x)) + (raise-argument-error 'convert-bounds-padding + "(list/c (>=/c 0) (>=/c 0) (>=/c 0) (>=/c 0))" + x)) + x))) + (define dc (case-lambda [(f w h a d) @@ -538,22 +550,53 @@ (define (draw-pict p dc dx dy) ((make-pict-drawer p) dc dx dy)) - - (define (convert-pict p format default) + (define (convert-pict p format default #:pad? [pad? #t]) (cond - [(member format '(pdf-bytes+bounds eps-bytes+bounds)) - (define xscale (box 1.0)) - (define yscale (box 1.0)) - (send (current-ps-setup) get-scaling xscale yscale) - (list (convert-pict/bytes p - (if (equal? format 'pdf-bytes+bounds) - 'pdf-bytes - 'eps-bytes) + [(member format '(pdf-bytes+bounds8 eps-bytes+bounds8 + png-bytes+bounds8 png@2x-bytes+bounds8 + svg-bytes+bounds8)) + (define xscale (box 1)) + (define yscale (box 1)) + (case format + [(pdf-bytes+bounds8 eps-bytes+bounds8) + (send (current-ps-setup) get-scaling xscale yscale)]) + (define-values (pad-l pad-t pad-r pad-b) + (if pad? + (apply values (convert-bounds-padding)) + (values 0 0 0 0))) + (define pad-p (inset p pad-l pad-t pad-r pad-b)) + (list (convert-pict/bytes pad-p + (case format + [(pdf-bytes+bounds8) 'pdf-bytes] + [(eps-bytes+bounds8) 'eps-bytes] + [(png-bytes+bounds8) 'png-bytes] + [(png@2x-bytes+bounds8) 'png@2x-bytes] + [(svg-bytes+bounds8) 'svg-bytes] + [else (error "internal error" format)]) default) - (* (unbox xscale) (pict-width p)) - (* (unbox yscale) (pict-height p)) - (* (unbox yscale) (pict-descent p)) - 0)] + (* (unbox xscale) (pict-width pad-p)) + (* (unbox yscale) (pict-height pad-p)) + (* (unbox yscale) (pict-descent pad-p)) + 0 + (* (unbox xscale) pad-l) + (* (unbox yscale) pad-t) + (* (unbox xscale) pad-r) + (* (unbox yscale) pad-b))] + [(member format '(pdf-bytes+bounds eps-bytes+bounds + png-bytes+bounds + png@2x-bytes+bounds + svg-bytes+bounds)) + (take (convert-pict p + (case format + [(pdf-bytes+bounds) 'pdf-bytes+bounds8] + [(eps-bytes+bounds) 'eps-bytes+bounds8] + [(png-bytes+bounds) 'png-bytes+bounds8] + [(png@2x-bytes+bounds) 'png@2x-bytes+bounds8] + [(svg-bytes+bounds) 'svg-bytes+bounds8] + [else (error "internal error" format)]) + default + #:pad? #f) + 5)] [else (convert-pict/bytes p format default)])) @@ -606,8 +649,5 @@ (λ (all w h) (define (rem x) (bytes->string/utf-8 (regexp-replace "pt" x ""))) (string->bytes/utf-8 - (string-append "width=\"" (rem w) "\" height=\"" (rem h) "\"")))) - (get-output-bytes s))] + (string-append "width=\"" (rem w) "\" height=\"" (rem h) "\"")))))] [else default])) - - diff --git a/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-sig.rkt b/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-sig.rkt index 37e61fa579..02bcc3154c 100644 --- a/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-sig.rkt +++ b/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-sig.rkt @@ -5,6 +5,7 @@ (provide mrpict-extra^) (define-signature mrpict-extra^ (dc-for-text-size + convert-bounds-padding show-pict text caps-text current-expected-text-scale dc