From eda4f357463fc8803726881f57cdd1cec6822660 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Mon, 6 Jan 2014 18:52:51 -0700 Subject: [PATCH] file/convertible: declare 'png@2x-bytes conversion variant The 'png@2x-bytes variant is like 'png-bytes, but where the decoded bytes are intended to be scaled by 1/2. Consumers: - DrRacket's print handler - Scribble's HTML renderer Producers: - `bitmap%`s where the scaling factor is 2 - picts Examples: Quick docs, docs for `images/icons/misc`, DrRacket interactions for results of `images/icons/misc` functions. --- .../draw-lib/racket/draw/private/bitmap.rkt | 6 ++++++ .../drracket/drracket/private/language.rkt | 13 ++++++++++--- .../images-doc/images/scribblings/icons.scrbl | 2 +- .../pict-lib/texpict/private/mrpict-extra.rkt | 7 ++++--- .../file/scribblings/convertible.scrbl | 4 +++- .../scribble-lib/scribble/html-render.rkt | 17 +++++++++++------ 6 files changed, 35 insertions(+), 14 deletions(-) diff --git a/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt b/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt index 3a04db927d..80bdad1812 100644 --- a/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt +++ b/pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt @@ -136,6 +136,12 @@ (let ([s (open-output-bytes)]) (send bm save-file s 'png) (get-output-bytes s))] + [(png@2x-bytes) + (if (= 2 (send bm get-backing-scale)) + (let ([s (open-output-bytes)]) + (send bm save-file s 'png #:unscaled? #t) + (get-output-bytes s)) + default)] [else default]))]))) (define (get-empty-surface) diff --git a/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt b/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt index d5aeeed010..30822c63db 100644 --- a/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt +++ b/pkgs/drracket-pkgs/drracket/drracket/private/language.rkt @@ -444,11 +444,17 @@ ;; this handler can be called multiple times per value ;; avoid building the png bytes more than once 1] + [(and (file:convertible? value) + (file:convert value 'png@2x-bytes #f)) + => + (λ (converted) + (hash-set! convert-table value (list 2 converted)) + 1)] [(and (file:convertible? value) (file:convert value 'png-bytes #f)) => (λ (converted) - (hash-set! convert-table value converted) + (hash-set! convert-table value (list 1 converted)) 1)] [else (oh value display? port)])))] [pretty-print-print-hook @@ -489,10 +495,11 @@ (write-special (value->snip value) port)] [(hash-ref convert-table value #f) => - (λ (bytes) + (λ (backing-scale+bytes) (write-special (make-object image-snip% - (read-bitmap (open-input-bytes bytes))) + (read-bitmap (open-input-bytes (cadr backing-scale+bytes)) + #:backing-scale (car backing-scale+bytes))) port))] [else (oh value display? port)])))] [print-graph diff --git a/pkgs/images-pkgs/images-doc/images/scribblings/icons.scrbl b/pkgs/images-pkgs/images-doc/images/scribblings/icons.scrbl index 96e8c81de3..4ca0a94dd9 100644 --- a/pkgs/images-pkgs/images-doc/images/scribblings/icons.scrbl +++ b/pkgs/images-pkgs/images-doc/images/scribblings/icons.scrbl @@ -1,5 +1,5 @@ #lang scribble/manual - + @(require scribble/eval unstable/latent-contract/defthing (for-label racket racket/draw 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 53842b9a62..7d649a806b 100644 --- a/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-extra.rkt +++ b/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-extra.rkt @@ -553,16 +553,17 @@ (define (convert-pict/bytes p format default) (case format - [(png-bytes) + [(png-bytes png@2x-bytes) (let* ([bm (make-bitmap (max 1 (inexact->exact (ceiling (pict-width p)))) - (max 1 (inexact->exact (ceiling (pict-height p)))))] + (max 1 (inexact->exact (ceiling (pict-height p)))) + #:backing-scale (if (eq? format 'png@2x-bytes) 2 1))] [dc (make-object bitmap-dc% bm)]) (send dc set-smoothing 'aligned) (draw-pict p dc 0 0) (send dc set-bitmap #f) (let ([s (open-output-bytes)]) - (send bm save-file s 'png) + (send bm save-file s 'png #:unscaled? #t) (get-output-bytes s)))] [(eps-bytes pdf-bytes) (let ([s (open-output-bytes)] diff --git a/pkgs/racket-pkgs/racket-doc/file/scribblings/convertible.scrbl b/pkgs/racket-pkgs/racket-doc/file/scribblings/convertible.scrbl index 5d808b7f5b..43ae94d728 100644 --- a/pkgs/racket-pkgs/racket-doc/file/scribblings/convertible.scrbl +++ b/pkgs/racket-pkgs/racket-doc/file/scribblings/convertible.scrbl @@ -22,6 +22,7 @@ should be considered standard: @item{@racket['text] --- a string for human-readable text} @item{@racket['gif-bytes] --- a byte string containing a GIF image encoding} @item{@racket['png-bytes] --- a byte string containing a PNG image encoding} + @item{@racket['png@2x-bytes] --- like @racket['png-bytes], but intended drawing at @racket[1/2] scale} @item{@racket['svg-bytes] --- a byte string containing a SVG image encoding} @item{@racket['ps-bytes] --- a byte string containing a PostScript document} @item{@racket['eps-bytes] --- a byte string containing an Encapsulated PostScript document} @@ -49,7 +50,8 @@ Returns @racket[#t] if @racket[v] supports the conversion protocol, @defproc[(convert [v convertible?] [request symbol?] [default any/c #f]) (case request [(text) (or/c string? (λ (x) (eq? x default)))] - [(gif-bytes png-bytes ps-bytes eps-bytes pdf-bytes svg-bytes) + [(gif-bytes png-bytes png@2x-bytes + ps-bytes eps-bytes pdf-bytes svg-bytes) (or/c bytes? (λ (x) (eq? x default)))] [(pdf-bytes+bounds) (or/c (list/c bytes? (and/c real? (not/c negative?)) diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt index 888c3f6697..991a13ca14 100644 --- a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt +++ b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt @@ -105,7 +105,7 @@ (define extra-breaking? (make-parameter #f)) (define current-version (make-parameter (version))) (define current-part-files (make-parameter #f)) -(define current-render-convertible-requests (make-parameter '(png-bytes svg-bytes))) +(define current-render-convertible-requests (make-parameter '(png@2x-bytes png-bytes svg-bytes))) (define (url->string* u) (parameterize ([current-url-encode-mode 'unreserved]) @@ -1295,16 +1295,21 @@ (define/private (render-as-convertible e requests) (for/or ([request (in-list requests)]) (cond - [(and (equal? request 'png-bytes) - (convert e 'png-bytes)) + [(and (or (equal? request 'png-bytes) + (equal? request 'png@2x-bytes)) + (convert e request)) => (lambda (bstr) (let ([w (integer-bytes->integer (subbytes bstr 16 20) #f #t)] - [h (integer-bytes->integer (subbytes bstr 20 24) #f #t)]) + [h (integer-bytes->integer (subbytes bstr 20 24) #f #t)] + [scale (lambda (v) + (if (equal? request 'png@2x-bytes) + (/ v 2.0) + v))]) `((img ([src ,(install-file "pict.png" bstr)] [alt "image"] - [width ,(number->string w)] - [height ,(number->string h)])))))] + [width ,(number->string (scale w))] + [height ,(number->string (scale h))])))))] [(and (equal? request 'svg-bytes) (convert e 'svg-bytes)) => (lambda (bstr)