From bf256b06cd11a7c7b554cf981e76c7f22b9f8d5e Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Fri, 11 Mar 2005 13:48:12 +0000 Subject: [PATCH] * scm/output-svg.scm (dashed-line): new function body. * GNUmakefile.in: create .htaccess. --- GNUmakefile.in | 4 ++-- scm/framework-svg.scm | 7 +++--- scm/output-svg.scm | 56 ++++++++++++++++++++++++++----------------- 3 files changed, 40 insertions(+), 27 deletions(-) diff --git a/GNUmakefile.in b/GNUmakefile.in index e6bd49b4d6..896371532d 100644 --- a/GNUmakefile.in +++ b/GNUmakefile.in @@ -77,7 +77,7 @@ local-WWW-post: AddCharset utf-8 .html\ AddCharset utf-8 .en\ AddCharset utf-8 .nl\ -AddCharset utf-8 .txt' > .htaccess +AddCharset utf-8 .txt' > $(builddir)/.htaccess $(PYTHON) $(buildscript-dir)/mutopia-index.py -o $(builddir)/examples.html ./ cd $(builddir) && $(FIND) . -name '*.html' -print | $(footifymail) xargs $(footify) @@ -87,7 +87,7 @@ AddCharset utf-8 .txt' > .htaccess > $(outdir)/weblist echo '' > $(builddir)/index.html echo 'Redirecting to the documentation index...' >> $(builddir)/index.html - cd $(builddir) && ls *.html >> $(outdir)/weblist + cd $(builddir) && ls .htaccess *.html >> $(outdir)/weblist cat $(outdir)/weblist | (cd $(builddir); GZIP=-9v tar -czf $(outdir)/web.tar.gz -T -) tree-prefix = $(builddir)/share/lilypond/$(TOPLEVEL_VERSION) diff --git a/scm/framework-svg.scm b/scm/framework-svg.scm index d2948e9014..c514619daa 100644 --- a/scm/framework-svg.scm +++ b/scm/framework-svg.scm @@ -44,13 +44,14 @@ `(width . ,(format #f "~s" page-width)) `(height . ,(format #f "~s" page-height)))) - (dump (dump-fonts outputter paper)) +; (dump (dump-fonts outputter paper)) (dump (string-append ;; FIXME: only use pages if there are more than one, pageSet is ;; not supported by all SVG applications yet. (if page-set? (eo 'pageSet) "") - (eo 'g `(transform . ,(format "scale(~a,~a)" output-scale output-scale))))) + (eo 'g `(transform . ,(format "scale(~a, ~a) " + output-scale output-scale))))) (for-each (lambda (page) @@ -75,7 +76,7 @@ (eo 'page '(page-orientation . "270")) (eo 'page)))) - (dump (string-append (eo 'g))) + (dump (string-append (eo 'g ))) (ly:outputter-dump-stencil outputter page) (dump (string-append (ec 'g))) (if (or landscape? page-set?) diff --git a/scm/output-svg.scm b/scm/output-svg.scm index cecb165d67..3da3cda684 100644 --- a/scm/output-svg.scm +++ b/scm/output-svg.scm @@ -65,7 +65,7 @@ (apply eo (cons entity attributes-alist)) string (ec entity)))) (define (offset->point o) - (format #f " ~S,~S" (car o) (cdr o))) + (format #f " ~S,~S" (car o) (- (cdr o)))) (define (svg-bezier lst close) (let* ((c0 (car (list-tail lst 3))) @@ -90,15 +90,23 @@ (apply string-append (map (lambda (x) (char->entity x)) (string->list string)))) -(define pango-description-regexp - (make-regexp "^([^,]+)+, ?([-a-zA-Z_]*) ([0-9.]+)$")) +(define pango-description-regexp-comma + (make-regexp "^([^,]+), ?([-a-zA-Z_]*) ([0-9.]+)$")) + +(define pango-description-regexp-nocomma + (make-regexp "^([^ ]+) ([-a-zA-Z_]*) ?([0-9.]+)$")) (define (pango-description-to-svg-font str) (let* ((size 4.0) (family "Helvetica") (style #f) - (match (regexp-exec pango-description-regexp str))) + (match-1 (regexp-exec pango-description-regexp-comma str)) + (match-2 (regexp-exec pango-description-regexp-nocomma str)) + (match (if match-1 + match-1 + match-2)) + ) (if (regexp-match? match) (begin @@ -134,7 +142,9 @@ size anchor)))) (define (fontify font expr) - (entity 'text expr (cons 'style (svg-font font)))) + (entity 'text expr + `(style . ,(svg-font font)) + )) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; stencil outputters @@ -166,7 +176,7 @@ `(width . ,width) `(height . ,(+ thick (* (abs z) (/ thick 2)))) `(rx . ,(/ blot-diameter 2)) - `(transform . ,(format #f "matrix (1, ~f, 0, 1, 0, 0)" (- z)) + `(transform . ,(format #f "matrix (1, ~f, 0, 1, 0, 0)" z) )))) (define (beam width slope thick blot-diameter) @@ -228,21 +238,23 @@ (define-public (comment s) (string-append "\n")) -(define (dashed-line thick on off dx dy) - (draw-line thick 0 0 dx dy)) +(define (draw-line thick x1 y1 x2 y2 . alist) + + (apply entity 'line "" + (append + `((stroke-linejoin . "round") + (stroke-linecap . "round") + (stroke-width . ,thick) + (stroke . "black") + ;;'(fill . "black") + (x1 . ,x1) + (y1 . ,y1) + (x2 . ,x2) + (y2 . ,y2)) + alist))) -(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) - )) +(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) @@ -263,8 +275,8 @@ ;;(dispatch expr) expr `(transform . ,(format #f "translate (~f, ~f)" - x - (- y))))) + x (- y))))) + (define (polygon coords blot-diameter) (entity 'polygon "" -- 2.39.5