;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 2002--2003 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; (c) 2002--2004 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; NOTE:
;;;;
;;; and should intercept:
;;;
-;;; fontify
;;; lily-def
;;; header-end
;;; define-fonts
;;; no-origin
;;; start-system
-;;; end-output
;;; header
;;; comment
;;; stop-last-system
(cond
((eq? keyword 'some-func) "")
;;((eq? keyword 'placebox) (dispatch (cadddr expr)))
- ;;((eq? keyword 'fontify) (dispatch (caddr expr)))
(else
(if (module-defined? this-module keyword)
(apply (eval keyword this-module) (cdr expr))
;; Global vars
-(define output-scale 1)
+;;; Global vars
+(define page-count 0)
+(define page-number 0)
+
+;;(define output-scale 2.83464566929134)
+(define output-scale (* 2 2.83464566929134))
(define system-y 0)
;; huh?
(define urg-line-thickness 0)
((equal? (ly:unit) "pt") (/ 72.0 72.27))
(else (error "unknown unit" (ly:unit)))))
-;; alist containing fontname -> fontcommand assoc (both strings)
-;;(define font-name-alist '())
-
;; Helper functions
-
-
(define (tagify tag string . attribute-alist)
(string-append
"<" tag
(define (control-flip-y c)
(cons (car c) (* -1 (cdr c))))
-(define (numbers->string l)
+(define (ly:numbers->string l)
(string-append
(number->string (car l))
(if (null? (cdr l))
""
- (string-append "," (numbers->string (cdr l))))))
+ (string-append "," (ly:numbers->string (cdr l))))))
(define (svg-bezier l close)
(let* ((c0 (car (list-tail l 3)))
sodipodi:docname='/tmp/x'>
<defs
id='defs3' />
- <podi:namedview
+ <sodipodi:namedview
id='base' />
<g transform='translate(10,10) scale (1.0)'>
")
(* -1 (/ y z))
1 1)))))
-;; TODO: bezier-ending, see ps.scm
-(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* (;;(l (eval urg-l this-module))
`(d . ,(string-append (svg-bezier first #f)
(svg-bezier second first-c0))))))
-(define (char i)
- (if #t
- ;;(tagify "tspan" (format #f "à~2,'0x;" i))
- (tagify "tspan" (ascii->upm-string i))
- (begin
- (format #t "can't display char: ~x\n" i)
- " ")))
+(define (char font i)
+ (tagify "tspan"
+ (dispatch `(fontify ,font ,(ascii->upm-string i)))))
+(define (nchar font i)
+ (format (current-error-port) "can't display char: ~x\n" i)
+ " ")
(define (comment s)
(string-append "<!-- " s " -->\n"))
-(define (define-fonts internal-external-name-mag-pairs)
- (comment (format #f "Fonts used: ~S" internal-external-name-mag-pairs)))
-
-(define (end-output)
- "</g></svg>")
-
-;;TODO
-;(define (horizontal-line x1 x2 th)
-; (draw-line th x1 0 x2 0))
+(define (define-fonts layout font-list)
+ (comment (format #f "Fonts used: ~S" font-list)))
(define (filledbox breapth width depth height)
- (roundfilledbox breapth width depth height line-thickness))
+ (round-filled-box breapth width depth height line-thickness))
(define font-cruft
"fill:black;stroke:none;text-anchor:start;writing-mode:lr;font-weight:normal;")
("cmr8" . ,(string-append
font-cruft
"font-family:cmr;font-style:normal;font-size:8;"))
+ ("ecrm10" . ,(string-append
+ font-cruft
+ "font-family:ecmr;font-style:normal;font-size:10;"))
("feta13" . ,(string-append
font-cruft
"font-family:LilyPond-Feta;font-style:-Feta;font-size:13;"))
font-cruft
"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))
- (let ((f (assoc (caadr name-mag-pair) font-alist)))
- (if (pair? f)
- (cdr f)
- (begin
- (format #t "font not found: ~s\n" (caadr name-mag-pair))
- (cdr (assoc "feta20" font-alist))))))
-
-(define (fontify name-mag-pair expr)
- (string-append
- (tagify "text" (dispatch expr) (cons 'style (get-font name-mag-pair)))))
+(define (get-font font)
+ (let* ((name (ly:font-filename font))
+ (magnify (ly:font-magnification font)))
+ ;; name-mag-pair: (quote ("feta20" . 0.569055118110236))"feta20"(quote ("feta20" . 0.569055118110236))
+ (let ((font-string (assoc-get name font-alist)))
+ (if (not font-string)
+ (begin
+ (format #t "font not found: ~S\n" font)
+ (cdr (assoc "feta20" font-alist)))
+ font-string))))
(define (header-end)
(comment "header-end"))
-(define (header creator generate)
+(define (header creator time-stamp layout page-count- classic?)
(string-append
xml-header
(comment creator)
- (comment generate)
+ (comment time-stamp)
svg-header))
+;; FIXME: duplicated in other output backends
+;; FIXME: silly interface name
+(define (output-scopes layout scopes fields basename)
+ (format (current-error-port) "TODO: FIX ps/tex/interface\n"))
+
+;; FIXME: duplictates output-scopes, duplicated in other backends
+;; FIXME: silly interface name
+(define (output-layout-def pd)
+ (format (current-error-port) "TODO: FIX ps/tex/interface\n"))
(define (lily-def key val)
(cond
(define (placebox x y expr)
- (tagify "g" (dispatch expr)
+ (tagify "g"
+ ;; FIXME -- JCN
+ ;;(dispatch expr)
+ expr
`(transform .
,(string-append
"translate("
(number->string (- 0 (* output-scale y)))
")"))))
-(define (roundfilledbox breapth width depth height blot-diameter)
+(define (round-filled-box 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 . ,(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))
;; TODO: use height, set scaling?
-(define (start-system width height)
+(define (start-system origin dim)
+;;(define (start-system width height)
(let ((y system-y))
- ;;"<g transform='translate(50,-250)'>
- (set! system-y (+ system-y height))
- ;;(format #f "<g transform='translate(0,~1,'~f)'>" y)))
+ (set! system-y (+ system-y (cdr dim)))
(string-append
"\n"
(comment "start-system")
(format #f "<g transform='translate(0.0,~f)'>\n" (* output-scale y)))))
-(define (stop-system)
+(define (stop-system last?)
(string-append
"\n"
(comment "stop-system")
"</g>\n"))
-(define stop-last-system stop-system)
-
-(define (text s)
+(define (fontify font expr)
+ (string-append
+;; (tagify "text" (dispatch expr) (cons 'style (get-font font)))))
+ (tagify "text" expr (cons 'style (get-font font)))))
+
+(define (text font s)
+ (tagify "tspan"
+ (apply string-append
+ (map (lambda (x) (ascii->upm-string (char->integer x)))
+ (string->list s)))
+ (cons 'style (get-font font))))
+
+(define (ntext font s)
+ ;; (fontify font
;; to unicode or not?
- (if #t
- (tagify "tspan" s)
- (tagify "tspan"
- (apply string-appendb
- (map (lambda (x) (ascii->upm-string (char->integer x)))
- (string->list s))))))
+ (tagify "tspan" (dispatch `(fontify ,font ,s))))
+
+(define (start-page)
+ (set! page-number (+ page-number 1))
+ (comment "start-page"))
+
+(define (stop-page last?)
+ (comment "stop-page"))
+
+;; WTF is this in every backend?
+(define (horizontal-line x1 x2 th)
+;; (draw-line th x1 0 x2 0))
+ (filledbox (- x1) (- x2 x1) (* .5 th) (* .5 th)))
+
projects / lilypond.git / blobdiff