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.

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)

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

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

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

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?))

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)
+          [(and (or (equal? request 'png-bytes)
-                (convert e '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)]
+                       [width ,(number->string (scale w))]
-                       [height ,(number->string h)])))))]
+                       [height ,(number->string (scale h))])))))]
           [(and (equal? request 'svg-bytes)
                 (convert e 'svg-bytes))
            => (lambda (bstr)