From e97414b7bfc5182702c946dc7fcd024a19f7b191 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 27 Nov 2010 07:36:12 -0700 Subject: [PATCH] bitmap% convertible to 'png-bytes; more Scribble Latex; pict in Slideshow docs --- collects/racket/draw/private/bitmap.rkt | 14 ++++- collects/scribble/latex-render.rkt | 6 ++ collects/scribble/racket.rkt | 4 +- collects/scribblings/draw/bitmap-class.scrbl | 3 + .../scribblings/slideshow/pict-diagram.rkt | 63 +++++++++++++++++++ collects/scribblings/slideshow/picts.scrbl | 14 +---- 6 files changed, 91 insertions(+), 13 deletions(-) create mode 100644 collects/scribblings/slideshow/pict-diagram.rkt diff --git a/collects/racket/draw/private/bitmap.rkt b/collects/racket/draw/private/bitmap.rkt index c567b45ac5..13114daf0f 100644 --- a/collects/racket/draw/private/bitmap.rkt +++ b/collects/racket/draw/private/bitmap.rkt @@ -1,6 +1,7 @@ #lang scheme/base (require scheme/class scheme/unsafe/ops + file/convertible "syntax.rkt" "hold.rkt" "../unsafe/bstr.rkt" @@ -62,8 +63,19 @@ (define fx+ unsafe-fx+) (define fx* unsafe-fx*) +(define png-convertible<%> + (interface* () + ([prop:convertible + (lambda (bm format default) + (case format + [(png-bytes) + (let ([s (open-output-bytes)]) + (send bm save-file s 'png) + (get-output-bytes s))] + [else default]))]))) + (define bitmap% - (class object% + (class* object% (png-convertible<%>) ;; We support three kinds of bitmaps: ;; * Color with alpha channel; diff --git a/collects/scribble/latex-render.rkt b/collects/scribble/latex-render.rkt index 459deac0d5..7fa0e56b98 100644 --- a/collects/scribble/latex-render.rkt +++ b/collects/scribble/latex-render.rkt @@ -253,6 +253,12 @@ => (lambda (bstr) (let ([fn (install-file "pict.pdf" bstr)]) (printf "\\includegraphics{~a}" fn)))] + [(and (convertible? e) + (not (disable-images)) + (convert e 'png-bytes)) + => (lambda (bstr) + (let ([fn (install-file "pict.png" bstr)]) + (printf "\\includegraphics{~a}" fn)))] [else (parameterize ([rendering-tt (or tt? (rendering-tt))]) (super render-content e part ri))]))] diff --git a/collects/scribble/racket.rkt b/collects/scribble/racket.rkt index 0636420895..a42247c8c7 100644 --- a/collects/scribble/racket.rkt +++ b/collects/scribble/racket.rkt @@ -1099,7 +1099,9 @@ (vector? v) (and (struct? v) (or (and qq - ;; Watch out for partially transparent subtypes of `element': + ;; Watch out for partially transparent subtypes of `element' + ;; or convertible values: + (not (convertible? v)) (not (element? v))) (prefab-struct-key v)))) (let ([orig-ht (unbox ht)] diff --git a/collects/scribblings/draw/bitmap-class.scrbl b/collects/scribblings/draw/bitmap-class.scrbl index dfccaf6923..9d2cd6783a 100644 --- a/collects/scribblings/draw/bitmap-class.scrbl +++ b/collects/scribblings/draw/bitmap-class.scrbl @@ -12,6 +12,9 @@ Sometimes, a bitmap object creation fails in a low-level manner. In the bitmap cannot be supplied to methods that consume or operate on bitmaps (otherwise, @|MismatchExn|). +A bitmap is convertible to @racket['png-bytes] through the +@racketmodname[file/convertible] protocol. + @defconstructor*/make[(([width exact-positive-integer?] [height exact-positive-integer?] diff --git a/collects/scribblings/slideshow/pict-diagram.rkt b/collects/scribblings/slideshow/pict-diagram.rkt new file mode 100644 index 0000000000..c651669c37 --- /dev/null +++ b/collects/scribblings/slideshow/pict-diagram.rkt @@ -0,0 +1,63 @@ +#lang racket/base +(require slideshow/pict + racket/class + racket/draw) + +(provide pict-diagram) + +(define pict-diagram + (parameterize ([dc-for-text-size (make-object bitmap-dc% + (make-bitmap 1 1))]) + (let ([t (lambda (s) + (text s `(italic . roman) 12))]) + (let ([top + (hc-append (vline 0 10) + (hline 30 0) + (inset (t "w") 1 0) + (hline 30 0) + (vline 0 10))] + [right + (vc-append (hline 10 0) + (vline 0 25) + (inset (t "h") 0 1) + (vline 0 25) + (hline 10 0))]) + (inset + (vl-append + 2 + top + (hc-append + 2 + (frame (let* ([line (hline (pict-width top) 0 #:segment 5)] + [top-line (launder line)] + [bottom-line (launder line)] + [top-edge (launder (ghost line))] + [bottom-edge (launder (ghost line))] + [p (vc-append + (/ (pict-height right) 4) + top-edge + top-line + (blank) + bottom-line + bottom-edge)] + [p (pin-arrows-line + 4 p + top-edge ct-find + top-line ct-find)] + [p (pin-arrows-line + 4 p + bottom-edge ct-find + bottom-line ct-find)] + [a (t "a")] + [p (let-values ([(dx dy) (ct-find p top-line)]) + (pin-over p (+ dx 5) (/ (- dy (pict-height a)) 2) a))] + [d (t "d")] + [p (let-values ([(dx dy) (ct-find p bottom-line)]) + (pin-over p + (+ dx 5) + (+ dy (/ (- (- (pict-height p) dy) (pict-height d)) 2)) + d))]) + p)) + right)) + 1))))) + diff --git a/collects/scribblings/slideshow/picts.scrbl b/collects/scribblings/slideshow/picts.scrbl index d7add187ca..fa6e744b52 100644 --- a/collects/scribblings/slideshow/picts.scrbl +++ b/collects/scribblings/slideshow/picts.scrbl @@ -1,5 +1,6 @@ #lang scribble/doc @(require "ss.ss" + "pict-diagram.rkt" (for-label racket/gui slideshow/code slideshow/flash @@ -34,16 +35,7 @@ offset of an embedded pict in a larger pict. In addition to its drawing part, a pict has the following @deftech{bounding box} structure: -@verbatim[#:indent 7]{ - w - ------------------ - | | a \ - |------------------| | - | | | h - |----------last----| | - | | d / - ------------------ -} +@centerline[pict-diagram] That is, the bounding box has a width @math{w} and a height @math{h}. For a single text line, @math{d} is descent below the @@ -65,7 +57,7 @@ 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] +A pict is a convertible datatype through the @racketmodname[file/convertible] protocol. Supported conversions include @racket['png-bytes], @racket['eps-bytes], and @racket['pdf-bytes].