Added pict to svg conversion. Added parameter to Scribble's html renderer to control choice between png and svg.
This commit is contained in:
parent
cfcc3dc852
commit
5ed686d991
|
@ -3,10 +3,13 @@
|
||||||
(require racket/class)
|
(require racket/class)
|
||||||
|
|
||||||
(require racket/draw/draw-sig
|
(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"
|
(require "mrpict-sig.rkt"
|
||||||
"common-sig.rkt")
|
"common-sig.rkt")
|
||||||
|
|
||||||
|
|
||||||
(import draw^
|
(import draw^
|
||||||
texpict-common^
|
texpict-common^
|
||||||
|
@ -579,6 +582,27 @@
|
||||||
(send dc end-page)
|
(send dc end-page)
|
||||||
(send dc end-doc))
|
(send dc end-doc))
|
||||||
(get-output-bytes s))]
|
(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]))
|
[else default]))
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -6,13 +6,14 @@
|
||||||
"decode-struct.rkt"
|
"decode-struct.rkt"
|
||||||
"html-properties.rkt"
|
"html-properties.rkt"
|
||||||
"tag.rkt"
|
"tag.rkt"
|
||||||
|
"parameters.rkt"
|
||||||
scheme/list
|
scheme/list
|
||||||
scheme/class
|
scheme/class
|
||||||
racket/contract/base
|
racket/contract/base
|
||||||
racket/contract/combinator
|
racket/contract/combinator
|
||||||
(for-syntax scheme/base))
|
(for-syntax scheme/base))
|
||||||
|
|
||||||
(provide (all-from-out "tag.rkt"))
|
(provide (all-from-out "tag.rkt" "parameters.rkt"))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
|
|
|
@ -1,5 +1,4 @@
|
||||||
#lang scheme/base
|
#lang scheme/base
|
||||||
|
|
||||||
(require "core.rkt"
|
(require "core.rkt"
|
||||||
"private/render-utils.rkt"
|
"private/render-utils.rkt"
|
||||||
"html-properties.rkt"
|
"html-properties.rkt"
|
||||||
|
@ -1092,7 +1091,8 @@
|
||||||
(cond
|
(cond
|
||||||
[(string? e) (super render-content e part ri)] ; short-cut for common case
|
[(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
|
[(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))
|
(convert e 'png-bytes))
|
||||||
=> (lambda (bstr)
|
=> (lambda (bstr)
|
||||||
(let ([w (integer-bytes->integer (subbytes bstr 16 20) #f #t)]
|
(let ([w (integer-bytes->integer (subbytes bstr 16 20) #f #t)]
|
||||||
|
@ -1101,6 +1101,13 @@
|
||||||
[alt "image"]
|
[alt "image"]
|
||||||
[width ,(number->string w)]
|
[width ,(number->string w)]
|
||||||
[height ,(number->string h)])))))]
|
[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)
|
[(image-element? e)
|
||||||
(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)]
|
||||||
|
|
4
pkgs/scribble-pkgs/scribble-lib/scribble/parameters.rkt
Normal file
4
pkgs/scribble-pkgs/scribble-lib/scribble/parameters.rkt
Normal file
|
@ -0,0 +1,4 @@
|
||||||
|
#lang racket/base
|
||||||
|
(provide current-html-render-pict-as)
|
||||||
|
|
||||||
|
(define current-html-render-pict-as (make-parameter 'png))
|
Loading…
Reference in New Issue
Block a user