From 5ed686d9911b9f0d1cb1d5cb58d6950e33b9d17c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jens=20Axel=20S=C3=B8gaard?= <jensaxel@soegaard.net>
Date: Mon, 14 Oct 2013 16:41:42 +0200
Subject: [PATCH] Added pict to svg conversion. Added parameter to Scribble's
 html renderer to control choice between png and svg.

---
 .../pict-lib/texpict/private/mrpict-extra.rkt | 26 ++++++++++++++++++-
 .../scribble-lib/scribble/base.rkt            |  3 ++-
 .../scribble-lib/scribble/html-render.rkt     | 11 ++++++--
 .../scribble-lib/scribble/parameters.rkt      |  4 +++
 4 files changed, 40 insertions(+), 4 deletions(-)
 create mode 100644 pkgs/scribble-pkgs/scribble-lib/scribble/parameters.rkt

diff --git a/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-extra.rkt b/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-extra.rkt
index 6690ba74a8..a4058783d1 100644
--- a/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-extra.rkt
+++ b/pkgs/pict-pkgs/pict-lib/texpict/private/mrpict-extra.rkt
@@ -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]))
 
              
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/base.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/base.rkt
index ab8da3cc5c..5f0757a8bd 100644
--- a/pkgs/scribble-pkgs/scribble-lib/scribble/base.rkt
+++ b/pkgs/scribble-pkgs/scribble-lib/scribble/base.rkt
@@ -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"))
 
 ;; ----------------------------------------
 
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt
index 3e6b6ee3af..b440664e01 100644
--- a/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt
+++ b/pkgs/scribble-pkgs/scribble-lib/scribble/html-render.rkt
@@ -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)]
diff --git a/pkgs/scribble-pkgs/scribble-lib/scribble/parameters.rkt b/pkgs/scribble-pkgs/scribble-lib/scribble/parameters.rkt
new file mode 100644
index 0000000000..461f42cb86
--- /dev/null
+++ b/pkgs/scribble-pkgs/scribble-lib/scribble/parameters.rkt
@@ -0,0 +1,4 @@
+#lang racket/base
+(provide current-html-render-pict-as)
+
+(define current-html-render-pict-as (make-parameter 'png))