diff --git a/collects/file/scribblings/convertible.scrbl b/collects/file/scribblings/convertible.scrbl index 7f73554127..40b9bbf39f 100644 --- a/collects/file/scribblings/convertible.scrbl +++ b/collects/file/scribblings/convertible.scrbl @@ -23,6 +23,7 @@ should be considered standard: @item{@scheme['gif-bytes] --- a byte string containing a GIF image encoding} @item{@scheme['png-bytes] --- a byte string containing a PNG image encoding} @item{@scheme['ps-bytes] --- a byte string containing a PostScript document} + @item{@scheme['eps-bytes] --- a byte string containing an Encapsulated PostScript document} @item{@scheme['pdf-bytes] --- a byte string containing a PDF document} ] diff --git a/collects/scribblings/slideshow/picts.scrbl b/collects/scribblings/slideshow/picts.scrbl index 37b4927a9e..d7add187ca 100644 --- a/collects/scribblings/slideshow/picts.scrbl +++ b/collects/scribblings/slideshow/picts.scrbl @@ -65,6 +65,10 @@ picts. The functions @racket[pict-width], @racket[pict-height], @racket[pict-descent], and @racket[pict-ascent] extract bounding-box information from a pict. +A pict is a convertible datatype through the @racket[file/convertible] +protocol. Supported conversions include @racket['png-bytes], +@racket['eps-bytes], and @racket['pdf-bytes]. + @defstruct[pict ([draw any/c] [width real?] diff --git a/collects/texpict/private/common-sig.rkt b/collects/texpict/private/common-sig.rkt index ac0d1e52b7..ed1029b527 100644 --- a/collects/texpict/private/common-sig.rkt +++ b/collects/texpict/private/common-sig.rkt @@ -123,7 +123,8 @@ (provide texpict-common-setup^) (define-signature texpict-common-setup^ (connect - ~connect)) + ~connect + convert-pict)) (provide texpict-internal^) (define-signature texpict-internal^ diff --git a/collects/texpict/private/common-unit.rkt b/collects/texpict/private/common-unit.rkt index bb764d09c6..66afc4c0ff 100644 --- a/collects/texpict/private/common-unit.rkt +++ b/collects/texpict/private/common-unit.rkt @@ -2,7 +2,8 @@ (require racket/draw racket/class - racket/list) + racket/list + file/convertible) (require "common-sig.ss") @@ -20,7 +21,9 @@ children ; list of child records panbox ; panorama box, computed on demand last) ; a descendent for the bottom-right - #:mutable) + #:mutable + #:property prop:convertible (lambda (v mode default) + (convert-pict v mode default))) (define-struct child (pict dx dy sx sy)) (define-struct bbox (x1 y1 x2 y2 ay dy)) diff --git a/collects/texpict/private/mrpict-extra.rkt b/collects/texpict/private/mrpict-extra.rkt index 4e6fd12930..dad3ec4b66 100644 --- a/collects/texpict/private/mrpict-extra.rkt +++ b/collects/texpict/private/mrpict-extra.rkt @@ -442,3 +442,30 @@ (define (draw-pict p dc dx dy) ((make-pict-drawer p) dc dx dy)) + + + (define (convert-pict p format default) + (case format + [(png-bytes) + (let* ([bm (make-bitmap (max 1 (pict-width p)) (max 1 (pict-height p)))] + [dc (make-object bitmap-dc% bm)]) + (draw-pict p dc 0 0) + (send dc set-bitmap #f) + (let ([s (open-output-bytes)]) + (send bm save-file s 'png) + (get-output-bytes s)))] + [(eps-bytes pdf-bytes) + (let ([s (open-output-bytes)]) + (let ([dc (new (if (eq? format 'eps-bytes) post-script-dc% pdf-dc%) + [interactive #f] + [as-eps #t] + [output s])]) + (send dc start-doc "pict") + (send dc start-page) + (draw-pict p dc 0 0) + (send dc end-page) + (send dc end-doc)) + (get-output-bytes s))] + [else default])) + + diff --git a/collects/texpict/private/texpict-extra.rkt b/collects/texpict/private/texpict-extra.rkt index 30c427e952..1697f89853 100644 --- a/collects/texpict/private/texpict-extra.rkt +++ b/collects/texpict/private/texpict-extra.rkt @@ -466,3 +466,5 @@ [else (error 'pict->string "bad tag: ~s" tag)]))))) (define pict->commands pict->command-list) + + (define (convert-pict p v d) d)