X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Foutput-svg.scm;h=786a37ca177deb434518e3b5e2d650053dba97bd;hb=b3cf2199183a184c7eef9a9f8f3c9a691db1f0ad;hp=830bba9ab274e73ed358793d29d7c765c0e8c2d8;hpb=57be7394ffa2e7d7ba6d60548dba563f3409d472;p=lilypond.git

diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index 830bba9ab2..786a37ca17 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--2005 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 2002--2006 Jan Nieuwenhuizen <janneke@gnu.org>
 
 ;;;; http://www.w3.org/TR/SVG11
 ;;;; http://www.w3.org/TR/SVG12/ -- page, pageSet in draft
@@ -59,6 +59,8 @@
   "c = close"
   (format #f "</~S>\n" entity))
 
+
+
 (define-public (entity entity string . attributes-alist)
   (if (equal? string "")
       (apply eoc entity attributes-alist)
@@ -144,6 +146,7 @@
 (define (fontify font expr)
   (entity 'text expr
 	  `(style . ,(svg-font font))
+	  '(fill . "currentColor")
 	  ))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -182,64 +185,6 @@
   "")
 
 
-(define (rect-beam width slope thick blot-diameter)
-  (let* ((x width)
-	 (y (* slope width))
-	 (z (/ y x)))
-    (entity 'rect ""
-	    ;; The stroke will stick out.  To use stroke,
-	    ;; the stroke-width must be subtracted from all other dimensions.
-	    ;;'(stroke-linejoin . "round")
-	    ;;'(stroke-linecap . "round")
-	    ;;`(stroke-width . ,blot-diameter)
-	    ;;'(stroke . "red")
-	    ;;'(fill . "orange")
-
-	    `(x . 0)
-	    `(y . ,(- (/ thick 2)))
-	    `(width . ,width)
-	    `(height . ,(+ thick (* (abs z) (/ thick 2))))
-	    `(rx . ,(/ blot-diameter 2))
-	    `(transform . ,(format #f "matrix (1, ~f, 0, 1, 0, 0)"  z)
-			))))
-
-(define (beam width slope thick blot-diameter)
-  (let* ((b blot-diameter)
-	 (t (- thick b))
-	 (w (- width b))
-	 (h (* w slope)))
-    (entity 'polygon ""
-	    '(stroke-linejoin . "round")
-	    '(stroke-linecap . "round")
-	    `(stroke-width . ,blot-diameter)
-	    '(stroke . "black")
-	    '(fill . "black")
-	    `(points . ,(string-join
-			 (map offset->point
-			      (list (cons (/ b 2) (/ t 2))
-				    (cons (+ w (/ b 2)) (+ h (/ t 2)))
-				    (cons (+ w (/ b 2)) (+ h (- (/ t 2))))
-				    (cons (/ b 2) (- (/ t 2)))))))
-	    )))
-
-(define (path-beam width slope thick blot-diameter)
-  (let* ((b blot-diameter)
-	 (t (- thick b))
-	 (w (- width b))
-	 (h (* w slope)))
-    (entity 'path ""
-	    '(stroke-linejoin . "round")
-	    '(stroke-linecap . "round")
-	    `(stroke-width . ,blot-diameter)
-	    '(stroke . "black")
-	    '(fill . "black")
-	    `(d . ,(format #f "M ~S,~S l ~S,~S l ~S,~S l ~S,~S l ~S,~S"
-			   (/ b 2) (/ t 2)
-			   w (- h)
-			   0 (- t)
-			   (- w) h
-			   0 t))
-	    )))
 
 (define (bezier-sandwich lst thick)
   (let* ((first (list-tail lst 4))
@@ -249,8 +194,8 @@
 	    '(stroke-linejoin . "round")
 	    '(stroke-linecap . "round")
 	    `(stroke-width . ,thick)
-	    '(stroke . "black")
-	    '(fill . "black")
+	    '(stroke . "currentColor")
+	    '(fill . "currentColor")
 	    `(d . ,(string-append (svg-bezier first #f)
 				  (svg-bezier second first-c0)))
 	    )))
@@ -269,24 +214,16 @@
 	  `((stroke-linejoin . "round")
 	    (stroke-linecap . "round")
 	    (stroke-width . ,thick)
-	    (stroke . "black")
-	    ;;'(fill . "black")
+	    (stroke . "currentColor")
 	    (x1 . ,x1)
-	    (y1 . ,y1)
+	    (y1 . ,(- y1))
 	    (x2 . ,x2)
-	    (y2 . ,y2))
+	    (y2 . ,(- y2)))
 	  alist)))
 
 (define (dashed-line thick on off dx dy)
   (draw-line thick 0 0 dx dy `(style . ,(format "stroke-dasharray:~a,~a;" on off))))
 
-;; WTF is this in every backend?
-(define (horizontal-line x1 x2 th)
-  (filledbox (- x1) (- x2 x1) (* .5 th) (* .5 th)))
-
-(define (filledbox breapth width depth height)
-  (round-filled-box breapth width depth height 0))
-
 (define (named-glyph font name)
   (dispatch
    `(fontify ,font ,(entity 'tspan
@@ -295,23 +232,33 @@
 
 (define (placebox x y expr)
   (entity 'g
-	  ;; FIXME -- JCN
-	  ;;(dispatch expr)
 	  expr
-	  `(transform . ,(format #f "translate (~f, ~f)"
+	  ;; 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)"
 				 x (- y)))))
 
-
-(define (polygon coords blot-diameter)
-  (entity 'polygon ""
-	  '(stroke-linejoin . "round")
-	  '(stroke-linecap . "round")
-	  `(stroke-width . ,blot-diameter)
-	  '(stroke . "black")
-	  ;;'(fill . "black")
-	  `(points . ,(string-join
-		       (map offset->point (ly:list->offsets '() coords))))
-  ))
+(define (polygon coords blot-diameter is-filled)
+  (entity
+   'polygon ""
+   '(stroke-linejoin . "round")
+   '(stroke-linecap . "round")
+   `(stroke-width . ,blot-diameter)
+   `(fill . ,(if is-filled "currentColor" "none"))
+   '(stroke . "currentColor")
+   `(points . ,(string-join
+		(map offset->point (ly:list->offsets '() coords))))
+   ))
+
+;; rotate around given point
+(define (setrotation ang x y)
+  (format "<g transform=\"rotate(~a,~a,~a)\">"
+    (number->string (* -1 ang))
+    (number->string x)
+    (number->string (* -1 y))))
+
+(define (resetrotation ang x y)
+  "</g>")
 
 (define (round-filled-box breapth width depth height blot-diameter)
   (entity 'rect ""
@@ -330,8 +277,28 @@
 	  `(ry . ,(/ blot-diameter 2))
 	  ))
 
+(define (circle radius thick is-filled)
+  (entity
+   'circle ""
+   '(stroke-linejoin . "round")
+   '(stroke-linecap . "round")
+   `(fill . ,(if is-filled "currentColor" "none"))
+   `(stroke . "currentColor")
+   `(stroke-width . ,thick)
+   `(r . ,radius)))
+
 (define (text font string)
   (dispatch `(fontify ,font ,(entity 'tspan (string->entities string)))))
 
-(define (utf8-string pango-font-description string)
+(define (utf-8-string pango-font-description string)
   (dispatch `(fontify ,pango-font-description ,(entity 'tspan string))))
+
+
+
+(define (setcolor r g b)
+  (format "<g color=\"rgb(~a%,~a%,~a%)\">"
+	  (* 100 r) (* 100 g) (* 100 b)
+	  ))
+
+(define (resetcolor)
+  "</g>")