diff --git a/pkgs/pict-pkgs/pict-doc/pict/scribblings/pict.scrbl b/pkgs/pict-pkgs/pict-doc/pict/scribblings/pict.scrbl index e4012422d5..b215512959 100644 --- a/pkgs/pict-pkgs/pict-doc/pict/scribblings/pict.scrbl +++ b/pkgs/pict-pkgs/pict-doc/pict/scribblings/pict.scrbl @@ -70,10 +70,15 @@ include @racket['png-bytes], @racket['eps-bytes], @racket['pdf-bytes], @racket['svg-bytes], and variants such as @racket['png-bytes+bounds] and @racket['png-bytes+bounds8]. +A pict is serializable via @racketmodname[racket/serialize], but +serialization loses sub-pict information (preserving only the pict's +drawing and bounding box). + @history[#:changed "1.2" @elem{Added support for @racket['png-bytes+bounds], @racket['png-bytes+bounds8] and similar - variants.}] + variants.} + #:changed "1.3" @elem{Enabled serialization.}] @defstruct[pict ([draw any/c] diff --git a/pkgs/pict-pkgs/pict-lib/pict/private/pict.rkt b/pkgs/pict-pkgs/pict-lib/pict/private/pict.rkt index 7949f751f2..d48f1c2071 100644 --- a/pkgs/pict-pkgs/pict-lib/pict/private/pict.rkt +++ b/pkgs/pict-pkgs/pict-lib/pict/private/pict.rkt @@ -1,6 +1,7 @@ #lang racket/base (require racket/draw racket/gui/dynamic + racket/serialize (except-in racket/list drop) racket/contract/base racket/class @@ -157,7 +158,14 @@ #:mutable #:property prop:pict-convertible (λ (v) v) #:property file:prop:convertible (lambda (v mode default) - (convert-pict v mode default))) + (convert-pict v mode default)) + #:property prop:serializable (make-serialize-info + (lambda (p) + (convert-pict-to-vector p)) + #'pict-deserialize-info + #f + (or (current-load-relative-directory) + (current-directory)))) (define-struct child (pict dx dy sx sy syx sxy)) (define-struct bbox (x1 y1 x2 y2 ay dy)) @@ -1852,3 +1860,34 @@ (string->bytes/utf-8 (string-append "width=\"" (rem w) "\" height=\"" (rem h) "\"")))))] [else default])) + +(define (convert-pict-to-vector p) + (define dc (new record-dc% + [width (pict-width p)] + [height (pict-height p)])) + (draw-pict p dc 0 0) + (vector (send dc get-recorded-datum) + (pict-width p) + (pict-height p) + (pict-ascent p) + (pict-descent p))) + +(define (deserialize-pict datum w h d a) + (define draw (recorded-datum->procedure datum)) + (make-pict `(prog ,(lambda (dc x y) + (define t (send dc get-transformation)) + (send dc translate x y) + (draw dc) + (send dc set-transformation t)) + ,h) + w h d a + null + #f + #f)) + +(define pict-deserialize-info + (make-deserialize-info deserialize-pict + (lambda () (error "no cycles")))) + +(module+ deserialize-info + (provide pict-deserialize-info))