;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 1998--2002 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 2002--2003 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; NOTE:
;;;;
-;;;; * Get mftrace 1.0.12 or newer
+;;;; * Get mftrace 1.0.12 or newer to create the .pfa fonts:
+;;;;
+;;;; make -C mf clean
+;;;; make -C mf pfa
;;;;
;;;; * Get sodipodi-0.28 or newer
;;;;
;;;; * Link/copy mf/out/private-fonts to ~/.sodipodi/private-fonts
+;;;; http://www.w3.org/TR/SVG11/paths.html
(debug-enable 'backtrace)
-
(define-module (scm sodipodi))
(define this-module (current-module))
(guile)
(lily))
-
-
-
;;; Lily output interface --- cleanup and docme
;;; Bare minimum interface for \score { \notes c } }
;;; comment
;;; stop-last-system
-
-
;; Module entry
;;(define-public (sodipodi-output-expression expr port)
;; (display (eval expr this-module) port))
(define-public (sodipodi-output-expression expr port)
(display (dispatch expr) port))
-
(define (dispatch expr)
(let ((keyword (car expr)))
(cond
(define output-scale 1)
(define system-y 0)
-(define line-thickness 0.1)
+;; huh?
+(define urg-line-thickness 0)
+(define line-thickness 0.001)
(define half-lt (/ line-thickness 2))
""
(string-append "," (numbers->string (cdr l))))))
-(define (svg-bezier l)
+(define (svg-bezier l close)
(let* ((c0 (car (list-tail l 3)))
(c123 (list-head l 3)))
(string-append
- "M " (control->string c0)
- "C " (apply string-append (map control->string c123)))))
+ (if (not close) "M " "L ")
+ (control->string c0)
+ "C " (apply string-append (map control->string c123))
+ (if (not close) "" (string-append
+ "L " (control->string close))))));; " Z")))))
-;; URG
-(define (svg-close l)
- (let* ((c0 (car (list-tail l 3))))
- (string-append
- "M " (control->string c0))))
-
-
(define xml-header
"<?xml version='1.0' standalone='no'?>
<!DOCTYPE svg PUBLIC '-//W3C//DTD SVG 20010904//EN'
(define (sqr x)
(* x x))
-(define (beam width slope thick)
+;; transform=scale and stroke don't play nice together...
+(define (XXXbeam width slope thick)
(let* ((x width)
(y (* slope width))
(z (sqrt (+ (sqr x) (sqr y)))))
(tagify "rect" ""
+ ;; '(style . "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-opacity:1;stroke-width:0.1;stroke-linejoin:miter;stroke-linecap:butt;")
+ ;;'(style . "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-opacity:1;stroke-width:0.000001;stroke-linejoin:miter;stroke-linecap:butt;")
+ `(style . ,(format "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-opacity:1;stroke-width:~f;stroke-linejoin:miter;stroke-linecap:butt;" line-thickness))
+ ;;`(x . ,(number->string half-lt))
+ `(x . "0")
+ ;;`(y . ,(number->string (- half-lt (/ thick 2))))
+ `(y . ,(number->string (- 0 (/ thick 2))))
+ `(width . ,(number->string width))
+ `(height . ,(number->string thick))
+ `(ry . ,(number->string half-lt))
+ `(transform . ,(format #f "matrix(~f,~f,0,1,0,0) scale (~f,~f)"
+ (/ x z)
+ (* -1 (/ y z))
+ output-scale output-scale)))))
- '(style . "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-opacity:1;stroke-width:1pt;stroke-linejoin:miter;stroke-linecap:butt;")
- `(x . ,(number->string half-lt))
- `(y . ,(number->string (- half-lt (/ thick 2))))
- `(width . ,(number->string width))
- `(height . ,(number->string thick))
- `(ry . ,(number->string line-thickness))
- `(transform . ,(format #f "matrix(~f,~f,0,1,0,0) scale (~f,~f)"
- (/ x z)
- (* -1 (/ y z))
- output-scale output-scale)))))
+(define (beam width slope thick)
+ (let* ((x width)
+ (y (* slope width))
+ (z (sqrt (+ (sqr x) (sqr y)))))
+ (tagify "rect" ""
+ `(style . ,(format "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-opacity:1;stroke-width:~f;stroke-linejoin:miter;stroke-linecap:butt;" line-thickness))
+ `(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 half-lt)))
+ `(transform . ,(format #f "matrix(~f,~f,0,1,0,0) scale (~f,~f)"
+ (/ x z)
+ (* -1 (/ y z))
+ 1 1)))))
;; TODO: bezier-ending, see ps.scm
-(define (bezier-bow l thick)
- (bezier-sandwich l thick))
+(define (bezier-bow urg-l thick)
+
+ (define (bezier-ending z0 z1 z2)
+ (let ((x0 (car z0))
+ (y0 (cdr z0))
+ (x1 (car z1))
+ (y1 (cdr z1))
+ (x2 (car z2))
+ (y2 (cdr z2)))
+ (let ((r (/ (sqrt (+ (* (- x1 x2) (- x1 x2))
+ (* (- y1 y2) (- y1 y2)))) 2)))
+ (tagify "circle" ""
+ `(fill . "#000000;")
+ `(cx . ,(number->string (* output-scale x0)))
+ `(cy . ,(number->string (* output-scale (- 0 y0))))
+ `(r . ,(number->string (* output-scale r)))))))
+
+ (let ((l (eval urg-l this-module)))
+ (string-append
+ (bezier-sandwich l thick)
+ (bezier-ending (list-ref l 3) (list-ref l 0) (list-ref l 5))
+ (bezier-ending (list-ref l 7) (list-ref l 0) (list-ref l 5)))))
(define (bezier-sandwich l thick)
- (let* ((urg (eval l this-module))
- (first (list-tail urg 4))
- (second (list-head urg 4)))
+ (let* (;;(l (eval urg-l this-module))
+ (first (list-tail l 4))
+ (first-c0 (car (list-tail first 3)))
+ (second (list-head l 4)))
(tagify "path" ""
- `(style . ,(format #f "stroke-width:~f;" line-thickness))
+ `(stroke . "#000000")
+ `(stroke-width . ,(number->string line-thickness))
`(transform . ,(format #f "scale (~f,~f)"
output-scale output-scale))
- `(d . ,(string-append (svg-bezier first)
- (svg-bezier second)
- (svg-close first))))))
+ `(d . ,(string-append (svg-bezier first #f)
+ (svg-bezier second first-c0))))))
(define (char i)
(if #t
(roundfilledbox breapth width depth height line-thickness))
(define font-cruft
- "fill:black;stroke:none;font-style:normal;font-weight:normal;text-anchor:start;writing-mode:lr;")
+ "fill:black;stroke:none;text-anchor:start;writing-mode:lr;font-weight:normal;")
;; FIXME
(define font-alist
`(
("cmr8" . ,(string-append
font-cruft
- "font-family:cmr;font-size:8;"))
+ "font-family:cmr;font-style:normal;font-size:8;"))
("feta13" . ,(string-append
font-cruft
- "font-family:LilyPond-Feta;font-size:13;"))
+ "font-family:LilyPond-Feta;font-style:-Feta;font-size:13;"))
("feta-nummer10" . ,(string-append
font-cruft
- "font-family:LilyPond-Feta-nummer;font-size:10;"))
+ "font-family:LilyPond-feta-nummer;font-style:-feta-nummer;font-size:10;"))
("feta20" . ,(string-append
font-cruft
- "font-family:LilyPond-Feta;font-size:20;"))
+ "font-family:LilyPond-feta;font-style:-feta;font-size:20;"))
("parmesan20" . ,(string-append
font-cruft
- "font-family:LilyPond-Parmesan;font-size:20;"))))
+ "font-family:LilyPond-Parmesan;font-style:-Parmesan;font-size:20;"))))
(define (get-font name-mag-pair)
;; name-mag-pair: (quote ("feta20" . 0.569055118110236))"feta20"(quote ("feta20" . 0.569055118110236))
(define (lily-def key val)
- (if (equal? key "lilypondpaperoutputscale")
- ;; ugr
- ;; If we just use transform scale (output-scale),
- ;; all fonts come out scaled too (ie, much too big)
- ;; So, we manually scale all other stuff.
- (set! output-scale (* scale-to-unit (string->number val))))
+ (cond
+ ((equal? key "lilypondpaperoutputscale")
+ ;; ugr
+ ;; If we just use transform scale (output-scale),
+ ;; all fonts come out scaled too (ie, much too big)
+ ;; So, we manually scale all other stuff.
+ (set! output-scale (* scale-to-unit (string->number val))))
+ ((equal? key "lilypondpaperlinethickness")
+ (set! urg-line-thickness (* scale-to-unit (string->number val)))))
"")
(define (no-origin)
(define (roundfilledbox breapth width depth height blot-diameter)
(tagify "rect" ""
-
- '(style . "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-opacity:1;stroke-width:1pt;stroke-linejoin:miter;stroke-linecap:butt;")
+ ;;'(style . "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:none;stroke-opacity:1;stroke-width:1pt;stroke-linejoin:miter;stroke-linecap:butt;")
+ `(style . ,(format "fill:#000000;fill-opacity:1;fill-rule:evenodd;stroke:#000000;stroke-opacity:1;stroke-width:~f;stroke-linejoin:miter;stroke-linecap:butt;" line-thickness))
`(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 (* output-scale half-lt)))
- `(ry . ,(number->string blot-diameter))))
+ `(ry . ,(number->string (/ blot-diameter 2)))))
projects / lilypond.git / blobdiff