suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

file/convertible: declare 'png@2x-bytes conversion variant

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2014-01-06 18:52:51 -07:00
parent 75dade2818
commit eda4f35746
6 changed files with 35 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
pkgs/draw-pkgs/draw-lib/racket/draw/private/bitmap.rkt
View File

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

13
pkgs/drracket-pkgs/drracket/drracket/private/language.rkt
View File

@ -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

2
pkgs/images-pkgs/images-doc/images/scribblings/icons.scrbl
View File

@ -1,5 +1,5 @@
#lang scribble/manual
@(require scribble/eval
unstable/latent-contract/defthing
(for-label racket racket/draw

7
pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-extra.rkt
View File

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

4
pkgs/racket-pkgs/racket-doc/file/scribblings/convertible.scrbl
View File

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

17
pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt
View File

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