X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-svg.scm;h=b6bdb2721c56abc52ee406bf07c4a4bb900e2ec5;hb=5b4b0d6e9a197e8f9eb085b7c2ad78b8be3e5cfc;hp=2e953a94b29591dc8236c33d23b3e6f18eb95cbd;hpb=3512ac1f9e6ac4d96f0a486ba8f5968ccf0ce507;p=lilypond.git

diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index 2e953a94b2..b6bdb2721c 100644
--- a/scm/output-svg.scm
+++ b/scm/output-svg.scm
@@ -2,7 +2,7 @@
 ;;;;
 ;;;;  source file of the GNU LilyPond music typesetter
 ;;;;
-;;;; (c) 2002--2006 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 2002--2008 Jan Nieuwenhuizen <janneke@gnu.org>
 
 ;;;; http://www.w3.org/TR/SVG11
 ;;;; http://www.w3.org/TR/SVG12/ -- page, pageSet in draft
@@ -23,10 +23,13 @@
 (use-modules
  (guile)
  (ice-9 regex)
+ (ice-9 format)
  (lily)
  (srfi srfi-1)
  (srfi srfi-13))
 
+(define fancy-format format)
+(define format ergonomic-simple-format)
 
 (define lily-unit-length 1.75)
 
@@ -45,20 +48,20 @@
 ;; Helper functions
 (define-public (attributes attributes-alist)
   (apply string-append
-	 (map (lambda (x) (format #f " ~s=\"~a\"" (car x) (cdr x)))
+	 (map (lambda (x) (format " ~s=\"~a\"" (car x) (cdr x)))
 	      attributes-alist)))
 
 (define-public (eo entity . attributes-alist)
   "o = open"
-  (format #f "<~S~a>\n" entity (attributes attributes-alist)))
+  (format "<~S~a>\n" entity (attributes attributes-alist)))
 
 (define-public (eoc entity . attributes-alist)
   " oc = open/close"
-  (format #f "<~S~a/>\n" entity (attributes attributes-alist)))
+  (format "<~S~a/>\n" entity (attributes attributes-alist)))
 
 (define-public (ec entity)
   "c = close"
-  (format #f "</~S>\n" entity))
+  (format "</~S>\n" entity))
 
 
 
@@ -69,7 +72,7 @@
        (apply eo (cons entity attributes-alist)) string (ec entity))))
 
 (define (offset->point o)
-  (format #f " ~S,~S" (car o)  (- (cdr o))))
+  (format " ~S,~S" (car o)  (- (cdr o))))
 
 (define (number-list->point lst)
   (define (helper lst)
@@ -95,7 +98,7 @@
   (* x x))
 
 (define (integer->entity integer)
-  (format #f "&#x~x;" integer))
+  (fancy-format "&#x~x;" integer))
 
 (define (char->entity char)
   (integer->entity (char->integer char)))
@@ -105,10 +108,10 @@
 	 (map (lambda (x) (char->entity x)) (string->list string))))
 
 (define pango-description-regexp-comma
-  (make-regexp "^([^,]+), ?([-a-zA-Z_]*) ([0-9.]+)$"))
+  (make-regexp "([^,]+), ?([-a-zA-Z_]*) ([0-9.]+)$"))
 
 (define pango-description-regexp-nocomma
-  (make-regexp "^([^ ]+) ([-a-zA-Z_]*) ?([0-9.]+)$"))
+  (make-regexp "([^ ]+) ([-a-zA-Z_]*) ?([0-9.]+)$"))
 
 (define (pango-description-to-svg-font str)
   (let*
@@ -129,7 +132,7 @@
 	  (set! size
 		(string->number (match:substring match 3))))
 
-	(ly:warning (_ "can't decypher Pango description: ~a") str))
+	(ly:warning (_ "cannot decypher Pango description: ~a") str))
 
     (set! style
 	  (if (string? style)
@@ -150,7 +153,7 @@
 	    (size (modified-font-metric-font-scaling font))
 	    (anchor "west"))
 
-	(format #f "font-family:~a;font-style:~a;font-size:~a;text-anchor:~a;"
+	(format "font-family:~a;font-style:~a;font-size:~a;text-anchor:~a;"
 		(car name-style) (cadr name-style)
 		size anchor))))
 
@@ -281,7 +284,7 @@
 	  expr
 	  ;; FIXME: Not using GNU coding standards [translate ()] here
 	  ;; to work around a bug in Microsoft Internet Explorer 6.0
-	  `(transform . ,(format #f "translate(~f, ~f)"
+	  `(transform . ,(ly:format "translate(~f, ~f)"
 				 x (- y)))))
 
 (define (polygon coords blot-diameter is-filled)
@@ -333,6 +336,37 @@
    `(stroke-width . ,thick)
    `(r . ,radius)))
 
+(define (ellipse x-radius y-radius thick is-filled)
+  (entity
+   'ellipse ""
+   '(stroke-linejoin . "round")
+   '(stroke-linecap . "round")
+   `(fill . ,(if is-filled "currentColor" "none"))
+   `(stroke . "currentColor")
+   `(stroke-width . ,thick)
+   `(rx . ,x-radius)
+   `(ry . ,y-radius)))
+
+(define (oval x-radius y-radius thick is-filled)
+  (let ((x-max x-radius)
+        (x-min (- x-radius))
+        (y-max y-radius)
+        (y-min (- y-radius)))
+    (entity
+     'path ""
+     '(stroke-linejoin . "round")
+     '(stroke-linecap . "round")
+     `(fill . ,(if is-filled "currentColor" "none"))
+     `(stroke . "currentColor")
+     `(stroke-width . ,thick)
+     `(d . ,(ly:format "M~4f,~4f C~4f,~4f  ~4f,~4f ~4f,~4f S~4f,~4f ~4f,~4f" 
+               x-max 0
+               x-max y-max
+               x-min y-max
+               x-min 0
+               x-max y-min
+               x-max 0)))))
+
 (define (text font string)
   (dispatch `(fontify ,font ,(entity 'tspan (string->entities string)))))