Added pict to svg conversion. Added parameter to Scribble's html renderer to control choice between png and svg.

This commit is contained in:
Jens Axel Søgaard 2013-10-14 16:41:42 +02:00
parent cfcc3dc852
commit 5ed686d991
4 changed files with 40 additions and 4 deletions

View File

@ -3,10 +3,13 @@
(require racket/class)
(require racket/draw/draw-sig
racket/gui/dynamic)
racket/gui/dynamic
(only-in racket/file make-temporary-file)
(only-in racket/port copy-port))
(require "mrpict-sig.rkt"
"common-sig.rkt")
(import draw^
texpict-common^
@ -579,6 +582,27 @@
(send dc end-page)
(send dc end-doc))
(get-output-bytes s))]
[(svg-bytes)
(let ([s (open-output-bytes)])
(define tmp (make-temporary-file "rkttmp~a.svg"))
(delete-file tmp)
(define dc (new svg-dc%
[width (pict-width p)]
[height (pict-height p)]
[output tmp]))
(send dc start-doc "Generating svg")
(send dc start-page)
(draw-pict p dc 0 0)
(send dc end-page)
(send dc end-doc)
(call-with-input-file tmp (λ (from) (copy-port from s)))
(regexp-replace "width=\"(.*pt)\" height=\"(.*pt)\""
(get-output-bytes s)
(λ (all w h)
(define (rem x) (bytes->string/utf-8 (regexp-replace "pt" x "")))
(string->bytes/utf-8
(string-append "width=\"" (rem w) "\" height=\"" (rem h) "\""))))
(get-output-bytes s))]
[else default]))

View File

@ -6,13 +6,14 @@
"decode-struct.rkt"
"html-properties.rkt"
"tag.rkt"
"parameters.rkt"
scheme/list
scheme/class
racket/contract/base
racket/contract/combinator
(for-syntax scheme/base))
(provide (all-from-out "tag.rkt"))
(provide (all-from-out "tag.rkt" "parameters.rkt"))
;; ----------------------------------------

View File

@ -1,5 +1,4 @@
#lang scheme/base
(require "core.rkt"
"private/render-utils.rkt"
"html-properties.rkt"
@ -1092,7 +1091,8 @@
(cond
[(string? e) (super render-content e part ri)] ; short-cut for common case
[(list? e) (super render-content e part ri)] ; also a short-cut
[(and (convertible? e)
[(and (equal? (current-html-render-pict-as) 'png)
(convertible? e)
(convert e 'png-bytes))
=> (lambda (bstr)
(let ([w (integer-bytes->integer (subbytes bstr 16 20) #f #t)]
@ -1101,6 +1101,13 @@
[alt "image"]
[width ,(number->string w)]
[height ,(number->string h)])))))]
[(and (equal? (current-html-render-pict-as) 'svg)
(convertible? e)
(convert e 'svg-bytes))
=> (lambda (bstr)
`((object
([data ,(install-file "pict.svg" bstr)]
[type "image/svg+xml"]))))]
[(image-element? e)
(let* ([src (collects-relative->path (image-element-path e))]
[suffixes (image-element-suffixes e)]

View File

@ -0,0 +1,4 @@
#lang racket/base
(provide current-html-render-pict-as)
(define current-html-render-pict-as (make-parameter 'png))