suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

pict: implement 'pdf-bytes+bounds8, etc. conversions

Browse Source 
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))`.
This commit is contained in:
Matthew Flatt 2014-06-27 16:58:03 +01:00
parent 37af1c8ef0
commit c4a58dc4a5
4 changed files with 71 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/pict-pkgs/pict-doc/pict/scribblings/pict.scrbl
View File

@ -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?]

1
pkgs/pict-pkgs/pict-lib/texpict/mrpict.rkt
View File

@ -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

80
pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-extra.rkt
View File

@ -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]))

1
pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-sig.rkt
View File

@ -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