commit 4b3d3a82966398d5e0745400f4ff3130a49f3e5d
parent 3d7ded8a33fe74de912bbf561da2823b5bfe78c2
Author: Jack Firth <jackhfirth@gmail.com>
Date: Sat, 30 May 2020 05:19:30 -0700
Implement support for converting values to GIFs
Implement support for convertible GIFs in the HTML renderer, including
width and height attributes to GIFs created from convertible values.
Diffstat:
3 files changed, 19 insertions(+), 3 deletions(-)
diff --git a/scribble-doc/scribblings/scribble/core.scrbl b/scribble-doc/scribblings/scribble/core.scrbl
@@ -1848,13 +1848,15 @@ For a @racket[part] that corresponds to an HTML page, adds content to
the @tt{<head>} tag.}
-@defstruct[render-convertible-as ([types (listof (or/c 'png-bytes 'svg-bytes))])]{
+@defstruct[render-convertible-as ([types (listof (or/c 'png-bytes 'svg-bytes 'gif-bytes))])]{
For a @racket[part] that corresponds to an HTML page,
controls how objects that subscribe to the @racketmodname[file/convertible]
protocol are rendered.
The alternatives in the @racket[types] field are tried in order
and the first one that succeeds is used in the html output.
+
+ @history[#:changed "1.34" @elem{Added support for @racket['gif-bytes].}]
}
@defstruct[part-link-redirect ([url url?])]{
diff --git a/scribble-lib/scribble/html-properties.rkt b/scribble-lib/scribble/html-properties.rkt
@@ -30,4 +30,4 @@
[link-resource ([path path-string?])]
[head-extra ([xexpr xexpr/c])]
- [render-convertible-as ([types (listof (or/c 'png-bytes 'svg-bytes))])])
+ [render-convertible-as ([types (listof (or/c 'png-bytes 'svg-bytes 'gif-bytes))])])
diff --git a/scribble-lib/scribble/html-render.rkt b/scribble-lib/scribble/html-render.rkt
@@ -107,7 +107,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@2x-bytes png-bytes svg-bytes)))
+(define current-render-convertible-requests (make-parameter '(png@2x-bytes png-bytes svg-bytes gif-bytes)))
(define (url->string* u)
(parameterize ([current-url-encode-mode 'unreserved])
@@ -1496,6 +1496,20 @@
`(img
([src ,(install-file "pict.svg" bstr)]
[type "image/svg+xml"]))))))]
+ [(and (equal? request 'gif-bytes) (convert e 'gif-bytes))
+ =>
+ (lambda (gif-bytes)
+ (define gif-src (install-file "pict.gif" gif-bytes))
+
+ ;; GIFs store their width and height in the first 4 bytes of the logical screen
+ ;; descriptor, which comes after the 6-byte long header block. The width and height are
+ ;; each represented by 2-byte wide little-endian unsigned fields.
+ (define width (+ (bytes-ref gif-bytes 6) (* (bytes-ref gif-bytes 7) 256)))
+ (define height (+ (bytes-ref gif-bytes 8) (* (bytes-ref gif-bytes 9) 256)))
+
+ (define image-tag
+ `(img ([src ,gif-src] [type "image/gif"] [width ,width] [height ,height])))
+ (list image-tag))]
[else #f])))
;; Add padding for a bounding-box conversion reply:
