From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sun, 19 Dec 2004 21:42:54 +0000 (+0000)
Subject: (polygon, draw-line, dashed-line): New
X-Git-Tag: release/2.5.14~379
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=413427dd5218dac5ca4627360d45516345632005;p=lilypond.git

(polygon, draw-line, dashed-line): New
function.
---

diff --git a/ChangeLog b/ChangeLog
index 87c48b2dc1..c45649efb8 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2004-12-19  Jan Nieuwenhuizen  <janneke@gnu.org>
+
+	* scm/output-svg.scm (polygon, draw-line, dashed-line): New
+	function.
+
 2004-12-19  Han-Wen Nienhuys  <hanwen@xs4all.nl>
 
 	* scm/output-texstr.scm (placebox): add routine
diff --git a/scm/lily-library.scm b/scm/lily-library.scm
index 3cd59bccda..8cc796b897 100644
--- a/scm/lily-library.scm
+++ b/scm/lily-library.scm
@@ -46,10 +46,9 @@
     (ly:parser-print-book parser book)))
 
 (define-public (print-score-as-book parser score)
-  (let*
-      ((head  (ly:parser-lookup parser '$globalheader))
-       (book (ly:make-book (ly:parser-lookup parser $defaultpaper)
-			   head score)))
+  (let* ((head (ly:parser-lookup parser '$globalheader))
+	 (book (ly:make-book (ly:parser-lookup parser $defaultpaper)
+			     head score)))
     (ly:parser-print-book parser book)))
 
 (define-public (print-score parser score)
@@ -59,10 +58,8 @@
     (ly:parser-print-score parser book)))
 		
 (define-public (collect-scores-for-book  parser score)
-  (let*
-      ((oldval (ly:parser-lookup parser 'toplevel-scores)))
-    (ly:parser-define parser 'toplevel-scores (cons score oldval))
-    ))
+  (let* ((oldval (ly:parser-lookup parser 'toplevel-scores)))
+    (ly:parser-define parser 'toplevel-scores (cons score oldval))))
 
 (define-public (collect-music-for-book parser music)
   (collect-scores-for-book parser (ly:music-scorify music parser)))
@@ -111,16 +108,14 @@ found."
   (if (null?  list)
       '()
       (cons (cons  (caar list) (func (cdar list)))
-	    (map-alist-vals func (cdr list)))
-      ))
+	    (map-alist-vals func (cdr list)))))
 
 (define (map-alist-keys func list)
   "map FUNC over the keys of an alist LIST, leaving the vals. "
   (if (null?  list)
       '()
       (cons (cons (func (caar list)) (cdar list))
-	    (map-alist-keys func (cdr list)))
-      ))
+	    (map-alist-keys func (cdr list)))))
  
 ;;;;;;;;;;;;;;;;
 ;; vector
@@ -128,46 +123,31 @@ found."
   (do
       ((i 0 (1+ i)))
       ((>= i (vector-length vec)) vec)
-    
-    (vector-set! vec i
-		 (proc (vector-ref vec i)))))
+    (vector-set! vec i (proc (vector-ref vec i)))))
 
 ;;;;;;;;;;;;;;;;
 ;; hash
 
-(if (not (defined? 'hash-table?))	; guile 1.6 compat
+(if (not (defined? 'hash-table?)) ;; guile 1.6 compat
     (begin
       (define hash-table? vector?)
 
       (define-public (hash-table->alist t)
 	"Convert table t to list"
-	(apply append
-	       (vector->list t)
-	       )))
+	(apply append (vector->list t))))
 
     ;; native hashtabs.
     (begin
       (define-public (hash-table->alist t)
-
 	(hash-fold (lambda (k v acc) (acons  k v  acc))
-		   '() t)
-	)
-      ))
+		   '() t))))
 
 ;; todo: code dup with C++. 
-(define-public (alist->hash-table l)
+(define-public (alist->hash-table lst)
   "Convert alist to table"
-  (let
-      ((m (make-hash-table (length l))))
-
-    (map (lambda (k-v)
-	   (hashq-set! m (car k-v) (cdr k-v)))
-	 l)
-
+  (let ((m (make-hash-table (length lst))))
+    (map (lambda (k-v) (hashq-set! m (car k-v) (cdr k-v))) lst)
     m))
-       
-
-
 
 ;;;;;;;;;;;;;;;;
 ; list
@@ -178,105 +158,91 @@ found."
       '()
       (if (pair? (car lst))
 	  (append (flatten-list (car lst)) (flatten-list  (cdr lst)))
-	  (cons (car lst) (flatten-list (cdr lst))))
-  ))
+	  (cons (car lst) (flatten-list (cdr lst))))))
 
 (define (list-minus a b)
   "Return list of elements in A that are not in B."
   (lset-difference eq? a b))
 
-
 ;; TODO: use the srfi-1 partition function.
-(define-public (uniq-list l)
+(define-public (uniq-list lst)
   
-  "Uniq LIST, assuming that it is sorted"
-  (define (helper acc l) 
-    (if (null? l)
+  "Uniq LST, assuming that it is sorted"
+  (define (helper acc lst) 
+    (if (null? lst)
 	acc
-	(if (null? (cdr l))
-	    (cons (car l) acc)
-	    (if (equal? (car l) (cadr l))
-		(helper acc (cdr l))
-		(helper (cons (car l) acc)  (cdr l)))
-	    )))
-  (reverse! (helper '() l) '()))
-
-
-(define (split-at-predicate predicate l)
- "Split L = (a_1 a_2 ... a_k b_1 ... b_k)
-into L1 = (a_1 ... a_k ) and L2 =(b_1 .. b_k) 
-Such that (PREDICATE a_i a_{i+1}) and not (PREDICATE a_k b_1).
-L1 is copied, L2 not.
-
-(split-at-predicate (lambda (x y) (= (- y x) 2))  '(1 3 5 9 11) (cons '() '()))"
-;; "
-
-;; KUT EMACS MODE.
-
-  (define (inner-split predicate l acc)
-  (cond
-   ((null? l) acc)
-   ((null? (cdr l))
-    (set-car! acc (cons (car l) (car acc)))
-    acc)
-   ((predicate (car l) (cadr l))
-    (set-car! acc (cons (car l) (car acc)))
-    (inner-split predicate (cdr l) acc))
-   (else
-    (set-car! acc (cons (car l) (car acc)))
-    (set-cdr! acc (cdr l))
-    acc)
-
-  ))
- (let*
-    ((c (cons '() '()))
-     )
-  (inner-split predicate l  c)
-  (set-car! c (reverse! (car c))) 
-  c)
-)
-
-
-(define-public (split-list l sep?)
-"
-(display (split-list '(a b c / d e f / g) (lambda (x) (equal? x '/))) )
-=>
-((a b c) (d e f) (g))
-
-"
-;; " KUT EMACS.
-
-(define (split-one sep?  l acc)
-  "Split off the first parts before separator and return both parts."
-  (if (null? l)
-      (cons acc '())
-      (if (sep? (car l))
-	  (cons acc (cdr l))
-	  (split-one sep? (cdr l) (cons (car l) acc))
-	  )
-      ))
-
-(if (null? l)
-    '()
-    (let* ((c (split-one sep? l '())))
-      (cons (reverse! (car c) '()) (split-list (cdr c) sep?))
-      )))
-
+	(if (null? (cdr lst))
+	    (cons (car lst) acc)
+	    (if (equal? (car lst) (cadr lst))
+		(helper acc (cdr lst))
+		(helper (cons (car lst) acc)  (cdr lst))))))
+  (reverse! (helper '() lst) '()))
+
+(define (split-at-predicate predicate lst)
+ "Split LST = (a_1 a_2 ... a_k b_1 ... b_k)
+  into L1 = (a_1 ... a_k ) and L2 =(b_1 .. b_k) 
+  Such that (PREDICATE a_i a_{i+1}) and not (PREDICATE a_k b_1).
+  L1 is copied, L2 not.
+
+  (split-at-predicate (lambda (x y) (= (- y x) 2)) '(1 3 5 9 11) (cons '() '()))"
+ ;; " Emacs is broken
+
+ (define (inner-split predicate lst acc)
+   (cond
+    ((null? lst) acc)
+    ((null? (cdr lst))
+     (set-car! acc (cons (car lst) (car acc)))
+     acc)
+    ((predicate (car lst) (cadr lst))
+     (set-car! acc (cons (car lst) (car acc)))
+     (inner-split predicate (cdr lst) acc))
+    (else
+     (set-car! acc (cons (car lst) (car acc)))
+     (set-cdr! acc (cdr lst))
+     acc))
+   (let* ((c (cons '() '())))
+     (inner-split predicate lst  c)
+     (set-car! c (reverse! (car c)))
+     c)))
+
+(define-public (split-list lst sep?)
+  "(display (split-list '(a b c / d e f / g) (lambda (x) (equal? x '/))) )
+   =>
+   ((a b c) (d e f) (g))
+  "
+  ;; " Emacs is broken
+  (define (split-one sep?  lst acc)
+    "Split off the first parts before separator and return both parts."
+    (if (null? lst)
+	(cons acc '())
+	(if (sep? (car lst))
+	    (cons acc (cdr lst))
+	    (split-one sep? (cdr lst) (cons (car lst) acc)))))
+  
+  (if (null? lst)
+      '()
+      (let* ((c (split-one sep? lst '())))
+	(cons (reverse! (car c) '()) (split-list (cdr c) sep?)))))
 
 (define-public (offset-add a b)
   (cons (+ (car a) (car b))
 	(+ (cdr a) (cdr b)))) 
 
+(define-public (ly:list->offsets accum coords)
+  (if (null? coords)
+      accum
+      (cons (cons (car coords) (cadr coords))
+	    (ly:list->offsets accum (cddr coords)))))
+
 (define-public (interval-length x)
   "Length of the number-pair X, when an interval"
-  (max 0 (- (cdr x) (car x)))
-  )
+  (max 0 (- (cdr x) (car x))))
+
 (define-public interval-start car)
 (define-public interval-end cdr)
 
 (define (other-axis a)
   (remainder (+ a 1) 2))
-  
 
 (define-public (interval-widen iv amount)
    (cons (- (car iv) amount)
@@ -286,19 +252,16 @@ L1 is copied, L2 not.
    (cons (min (car i1) (car i2))
 	 (max (cdr i1) (cdr i2))))
 
-
 (define-public (write-me message x)
   "Return X.  Display MESSAGE and write X.  Handy for debugging,
 possibly turned off."
   (display message) (write x) (newline) x)
 ;;  x)
 
-
 (define-public (stderr string . rest)
   (apply format (cons (current-error-port) (cons string rest)))
   (force-output (current-error-port)))
 
-
 (define (index-cell cell dir)
   (if (equal? dir 1)
       (cdr cell)
@@ -308,14 +271,12 @@ possibly turned off."
   "map F to contents of X"
   (cons (f (car x)) (f (cdr x))))
 
-
 (define-public (list-insert-separator lst between)
   "Create new list, inserting BETWEEN between elements of LIST"
   (define (conc x y )
     (if (eq? y #f)
 	(list x)
-	(cons x  (cons between y))
-	))
+	(cons x  (cons between y))))
   (fold-right conc #f lst))
 
 ;;;;;;;;;;;;;;;;
@@ -325,12 +286,11 @@ possibly turned off."
       0
       (if (< x 0) -1 1)))
 
-(define-public (symbol<? l r)
-  (string<? (symbol->string l) (symbol->string r)))
-
-(define-public (!= l r)
-  (not (= l r)))
+(define-public (symbol<? lst r)
+  (string<? (symbol->string lst) (symbol->string r)))
 
+(define-public (!= lst r)
+  (not (= lst r)))
 
 (define-public scale-to-unit
   (cond
@@ -347,4 +307,3 @@ possibly turned off."
 	  ;;(stderr "font-name: ~S\n" (ly:font-name font))
 	  ;;(stderr "font-file-name: ~S\n" (ly:font-file-name font))
 	  (ly:font-file-name font)))))
-
diff --git a/scm/output-gnome.scm b/scm/output-gnome.scm
index a29fc395a1..08f092b06d 100644
--- a/scm/output-gnome.scm
+++ b/scm/output-gnome.scm
@@ -6,6 +6,7 @@
 
 ;;; TODO:
 ;;;
+;;;  * check: blot+scaling
 ;;;  * Figure out and fix font scaling and character placement
 ;;;  * EC font package: add missing X font directories and AFMs
 ;;;  * User-interface, keybindings
@@ -104,12 +105,6 @@ lilypond -fgnome input/simple-song.ly
   (if #f
       (apply stderr (cons string rest))))
 
-(define (list->offsets accum coords)
-  (if (null? coords)
-      accum
-      (cons (cons (car coords) (cadr coords))
-	    (list->offsets accum (cddr coords)))))
-
 (define (utf8 i)
   (cond
    ((< i #x80) (list (integer->char i)))
@@ -285,6 +280,22 @@ lilypond -fgnome input/simple-song.ly
 (define (char font i)
   (text font (ly:font-index-to-charcode font i)))
 
+(define (dashed-line thick on off dx dy)
+  (draw-line thick 0 0 dx dy))
+
+(define (draw-line thick x1 y1 x2 y2)
+  (let* ((def (make <gnome-canvas-path-def>))
+	 (props (make <gnome-canvas-bpath>
+		  #:parent (canvas-root)
+		  #:fill-color "black"
+		  #:outline-color "black"
+		  #:width-units thick)))
+    (reset def)
+    (moveto def x1 (- y1))
+    (lineto def x2 (- y2))
+    (set-path-def props def)
+    props))
+
 ;; FIXME: naming
 (define (filledbox breapth width depth height)
   (make <gnome-canvas-rect>
@@ -311,48 +322,27 @@ lilypond -fgnome input/simple-song.ly
 	  item)
 	#f)))
 
-(define (dashed-line thick on off dx dy)
-  (draw-line thick 0 0 dx dy)) 
-
-(define (draw-line thick fx fy tx ty)
-  (let*
-      ((def (make <gnome-canvas-path-def>))
-       (props (make <gnome-canvas-bpath>
-		   #:parent (canvas-root)
-		   #:fill-color "black"
-		   #:outline-color "black"
-		   #:width-units thick)))
-    
-    (reset def)
-    (moveto def fx (- fy))
-    (lineto def tx (- ty))
-    (set-path-def props def)
-    props))
-
 (define (named-glyph font name)
   (text font (ly:font-glyph-name-to-charcode font name)))
 
-(define (polygon coords blotdiameter)
-  (let*
-      ((def (make <gnome-canvas-path-def>))
-       (props (make <gnome-canvas-bpath>
-		   #:parent (canvas-root)
-		   #:fill-color "black"
-		   #:outline-color "black"
-		   #:width-units blotdiameter))
-       (points (list->offsets '() coords))
-       (last-point (car (last-pair points))))
-
+(define (polygon coords blot-diameter)
+  (let* ((def (make <gnome-canvas-path-def>))
+	 (props (make <gnome-canvas-bpath>
+		  #:parent (canvas-root)
+		  #:fill-color "black"
+		  #:outline-color "black"
+		  #:join-style 'round)
+		  #:width-units blot-diameter)
+	 (points (ly:list->offsets '() coords))
+	 (last-point (car (last-pair points))))
+    
     (reset def)
     (moveto def (car last-point) (cdr last-point))
-    (for-each (lambda (x)
-		(lineto def (car x) (cdr x))
-		) points)
+    (for-each (lambda (x) (lineto def (car x) (cdr x))) points)
     (closepath def)
     (set-path-def props def)
     props))
     
-
 (define (round-filled-box breapth width depth height blot-diameter)
   (let ((r (/ blot-diameter 2)))
     (make <gnome-canvas-rect>
diff --git a/scm/output-svg.scm b/scm/output-svg.scm
index 03155dbf39..96dbfd1aa2 100644
--- a/scm/output-svg.scm
+++ b/scm/output-svg.scm
@@ -7,9 +7,10 @@
 ;;;; http://www.w3.org/TR/SVG11
 
 ;;;; TODO:
-;;;;  * missing stencils: line, dashed-line ...
-;;;;  * rounded corners on stencils: rect, bezier (inkscape bug?)
+;;;;  * check: blot+scaling
 ;;;;  * inkscape page/pageSet support
+;;;;  * inkscape SVG-font support
+;;;;    - use fontconfig/fc-cache for now, see output-gnome.scm
 
 (debug-enable 'backtrace)
 (define-module (scm output-svg))
@@ -18,27 +19,13 @@
 (use-modules
  (guile)
  (ice-9 regex)
- (lily))
+ (lily)
+ (srfi srfi-13))
 
 ;; GLobals
 ;; FIXME: 2?
 (define output-scale (* 2 scale-to-unit))
 
-(define indent-level 0)
-(define (indent s . add) s)
-
-;;(define (indentation indent str)
-;;   (regexp-substitute/global #f "\(\n\)[ \t]*" str 'pre 1 indent 'post))
-
-(define (indent s . add)
-  (let ((before indent-level)
-	(after (apply + (cons indent-level add)))
-	(after? (and (not (null? add)) (> (car add) 0))))
-    (set! indent-level after)
-    (if after?
-      (string-append (make-string before #\ ) s)
-      (string-append (make-string after #\ ) s))))
-
 (define (debugf string . rest)
   (if #f
       (apply stderr (cons string rest))))
@@ -63,13 +50,13 @@
 	      attributes-alist)))
 
 (define-public (eo entity . attributes-alist)
-  (indent (format #f "<~S~a>\n" entity (attributes attributes-alist)) 2))
+  (format #f "<~S~a>\n" entity (attributes attributes-alist)))
 
 (define-public (eoc entity . attributes-alist)
-  (indent (format #f "<~S~a/>\n" entity (attributes attributes-alist))))
+  (format #f "<~S~a/>\n" entity (attributes attributes-alist)))
 
 (define-public (ec entity)
-  (indent (format #f "</~S>\n" entity) -2))
+  (format #f "</~S>\n" entity))
 
 (define-public (entity entity string . attributes-alist)
   (if (equal? string "")
@@ -77,34 +64,18 @@
       (string-append
        (apply eo (cons entity attributes-alist)) string (ec entity))))
 
-(define (control->list c)
-  (list (car c) (cdr c)))
-
-(define (control->string c)
-  (string-append
-   (number->string (car c)) ","
-   ;; lose the -1
-   (number->string (* -1 (cdr c))) " "))
-
-(define (control-flip-y c)
-  (cons (car c) (* -1 (cdr c))))
-
-(define (ly:numbers->string lst)
-  (string-append
-   (number->string (car lst))
-   (if (null? (cdr lst))
-       ""
-       (string-append "," (ly:numbers->string (cdr lst))))))
+(define (offset->point o)
+  (format #f " ~S,~S" (car o) (cdr o)))
 
 (define (svg-bezier lst close)
   (let* ((c0 (car (list-tail lst 3)))
 	 (c123 (list-head lst 3)))
     (string-append
      (if (not close) "M " "L ")
-     (control->string c0)
-     "C " (apply string-append (map control->string c123))
+     (offset->point c0)
+     "C " (apply string-append (map offset->point c123))
      (if (not close) "" (string-append
-			 "L " (control->string close))))))
+			 "L " (offset->point close))))))
 
 (define (sqr x)
   (* x x))
@@ -170,33 +141,44 @@
       (ly:all-stencil-expressions)
       (ly:all-output-backend-commands)))
 
-(define (beam width slope thick blot)
+(define (beam width slope thick blot-diameter)
   (let* ((x width)
 	 (y (* slope width))
 	 (z (sqrt (+ (sqr x) (sqr y)))))
     (entity 'rect ""
-	    `(style . ,(format "stroke-linejoin:round;stroke-linecap:round;stroke-width:~f;" blot))
-	    `(x . "0")
-	    `(y . ,(number->string (* output-scale (- 0 (/ thick 2)))))
-	    `(width . ,(number->string (* output-scale width)))
-	    `(height . ,(number->string (* output-scale thick)))
-	    `(ry . ,(number->string (* output-scale (/ blot 2))))
-	    `(transform .
-			,(format #f "matrix (~f, ~f, 0, 1, 0, 0) scale (~f, ~f)"
-				 (/ x z)
-				 (* -1 (/ y z))
-				 1 1)))))
+	    ;; 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 (* slope blot-diameter)))
+	    `(height . ,thick)
+	    `(rx . ,(/ blot-diameter 2))
+	    `(transform . ,(string-append
+			    (format #f "matrix (~f, ~f, 0, 1, 0, 0)"
+				    (/ x z) (* -1 (/ y z)))
+			    (format #f " scale (~f, ~f)"
+				    output-scale output-scale))))))
 
 (define (bezier-sandwich lst thick)
   (let* ((first (list-tail lst 4))
 	 (first-c0 (car (list-tail first 3)))
 	 (second (list-head lst 4)))
     (entity 'path ""
-	    `(style . ,(format "stroke-linejoin:round;stroke-linecap:round;stroke-width:~f;" thick))
-	    `(transform . ,(format #f "scale (~f, ~f)"
-				   output-scale output-scale))
+	    '(stroke-linejoin . "round")
+	    '(stroke-linecap . "round")
+	    `(stroke-width . ,thick)
+	    '(stroke . "black")
+	    '(fill . "black")
 	    `(d . ,(string-append (svg-bezier first #f)
-				  (svg-bezier second first-c0))))))
+				  (svg-bezier second first-c0)))
+	  `(transform
+	    . ,(format #f "scale (~f, -~f)" output-scale output-scale)))))
 
 (define (char font i)
   (dispatch
@@ -205,6 +187,27 @@
 (define-public (comment s)
   (string-append "<!-- " s " !-->\n"))
 
+(define (dashed-line thick on off dx dy)
+  (draw-line thick 0 0 dx dy))
+
+(define (draw-line thick x1 y1 x2 y2)
+  (entity 'line ""
+	  '(stroke-linejoin . "round")
+	  '(stroke-linecap . "round")
+	  `(stroke-width . ,thick)
+	  '(stroke . "black")
+	  ;;'(fill . "black")
+	  `(x1 . ,x1)
+	  `(y1 . ,y1)
+	  `(x2 . ,x2)
+	  `(y2 . ,y2)
+	  `(transform
+	    . ,(format #f "scale (~f, -~f)" output-scale output-scale))))
+
+;; 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))
 
@@ -221,20 +224,38 @@
 	  expr
 	  `(transform . ,(format #f "translate (~f, ~f)"
 				 (* output-scale x)
-				 (- 0 (* output-scale y))))))
+				 (- (* output-scale 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))))
+	  `(transform
+	    . ,(format #f "scale (~f, -~f)" output-scale output-scale))))
 
 (define (round-filled-box breapth width depth height blot-diameter)
   (entity 'rect ""
-	  `(style . ,(format "stroke-linejoin:round;stroke-linecap:round;stroke-width:~f;" blot-diameter))
-	  `(x . ,(number->string (* output-scale (- 0 breapth))))
-	  `(y . ,(number->string (* output-scale (- 0 height))))
-	  `(width . ,(number->string (* output-scale (+ breapth width))))
-	  `(height . ,(number->string (* output-scale (+ depth height))))
-	  `(ry . ,(number->string (/ blot-diameter 2)))))
+	  ;; 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)
+	  ;;'(stroke . "red")
+	  ;;'(fill . "orange")
+
+	  `(x . ,(- breapth))
+	  `(y . ,(- height))
+	  `(width . ,(+ breapth width))
+	  `(height . ,(+ depth height))
+	  `(ry . ,(/ blot-diameter 2))
+	  ;;`(transform . ,(scale))))
+	  `(transform
+	    . ,(format #f "scale (~f, ~f)" output-scale output-scale))))
 
 (define (text font string)
   (dispatch `(fontify ,font ,(entity 'tspan (string->entities string)))))
-
-;; WTF is this in every backend?
-(define (horizontal-line x1 x2 th)
-  (filledbox (- x1) (- x2 x1) (* .5 th) (* .5 th)))