scribble: fix HTML scaling of GIFs

Even without scaling, declare the size of a PNG or GIF in HTML
output.

original commit: 3f3e6e4cb421e8004c4e0c5ee5944718bdd686a3
This commit is contained in:
Matthew Flatt 2014-05-12 20:12:18 -06:00
parent 96fc0407d0
commit b5e473c5d9

View File

@ -18,6 +18,7 @@
net/uri-codec net/uri-codec
net/base64 net/base64
scheme/serialize scheme/serialize
racket/draw/gif
(prefix-in xml: xml/xml) (prefix-in xml: xml/xml)
(for-syntax scheme/base) (for-syntax scheme/base)
"search.rkt" "search.rkt"
@ -1211,11 +1212,13 @@
(let* ([src (collects-relative->path (image-element-path e))] (let* ([src (collects-relative->path (image-element-path e))]
[suffixes (image-element-suffixes e)] [suffixes (image-element-suffixes e)]
[scale (image-element-scale e)] [scale (image-element-scale e)]
[to-num [to-scaled-num
(lambda (s) (lambda (s)
(number->string (number->string
(inexact->exact (inexact->exact
(floor (* scale (integer-bytes->integer s #f #t))))))] (floor (* scale (if (number? s)
s
(integer-bytes->integer s #f #t)))))))]
[src (select-suffix src suffixes '(".png" ".gif" ".svg"))] [src (select-suffix src suffixes '(".png" ".gif" ".svg"))]
[svg? (regexp-match? #rx#"[.]svg$" (if (path? src) (path->bytes src) src))] [svg? (regexp-match? #rx#"[.]svg$" (if (path? src) (path->bytes src) src))]
[sz (cond [sz (cond
@ -1242,7 +1245,6 @@
(if (and w h) (if (and w h)
`([width ,w][height ,h]) `([width ,w][height ,h])
null)))))] null)))))]
[(= 1.0 scale) null]
[else [else
;; Try to extract file size: ;; Try to extract file size:
(call-with-input-file* (call-with-input-file*
@ -1250,8 +1252,12 @@
(lambda (in) (lambda (in)
(cond (cond
[(regexp-try-match #px#"^\211PNG.{12}" in) [(regexp-try-match #px#"^\211PNG.{12}" in)
`([width ,(to-num (read-bytes 4 in))] `([width ,(to-scaled-num (read-bytes 4 in))]
[height ,(to-num (read-bytes 4 in))])] [height ,(to-scaled-num (read-bytes 4 in))])]
[(regexp-try-match #px#"^(?=GIF8)" in)
(define-values (w h rows) (gif->rgba-rows in))
`([width ,(to-scaled-num w)]
[height ,(to-scaled-num h)])]
[else [else
null])))])]) null])))])])
(let ([srcref (let ([p (install-file src)]) (let ([srcref (let ([p (install-file src)])