DECLARE_SMOBS (Paper_outputter);
public:
- SCM file () const;
+ Paper_outputter (SCM port, string format);
+
+ void close ();
SCM dump_string (SCM);
+ SCM file () const;
+ SCM module () const;
void output_scheme (SCM scm);
- Paper_outputter (SCM port, string format);
- SCM scheme_to_string (SCM);
void output_stencil (Stencil);
- void close ();
+ SCM scheme_to_string (SCM);
};
Paper_outputter *get_paper_outputter (string, string);
return SCM_UNSPECIFIED;
}
+
+LY_DEFINE (ly_outputter_module, "ly:outputter-module",
+ 1, 0, 0, (SCM outputter),
+ "Return output module of @var{outputter}.")
+{
+ LY_ASSERT_SMOB (Paper_outputter, outputter, 1);
+
+ Paper_outputter *po = unsmob_outputter (outputter);
+ return po->module ();
+}
return scm_eval (scm, output_module_);
}
+SCM
+Paper_outputter::module () const
+{
+ return output_module_;
+}
+
void
Paper_outputter::output_scheme (SCM scm)
{
"%" "_" name)))
"m" (string-encode-integer (inexact->exact (round (* 1000 magnify)))))))
+(define (ps-define-pango-pf pango-pf font-name scaling)
+ "")
+
(define (ps-define-font font font-name scaling)
(string-append
"/" (ps-font-command font)
(define (setup-variables paper)
(string-append
"\n"
- (define-fonts paper ps-define-font)
+ (define-fonts paper ps-define-font ps-define-pango-pf)
(output-variables paper)))
(define (cff-font? font)
(ec 'svg))
(define (svg-define-font font font-name scaling)
- (string-append
- "@font-face {
+ (let* ((file-name (if (list? font) (pango-pf-file-name font)
+ (ly:font-file-name font)))
+ (lower-name (string-downcase font-name)))
+ ;; only embed emmentaler for now
+ (if (equal? (substring lower-name 0 (min (string-length lower-name) 10)) "emmentaler")
+ (string-append
+ "@font-face {
font-family: '"
- font-name
-"';
+ font-name
+ "';
font-weight: normal;
font-style: normal;
src: url('"
(string-downcase font-name)
".woff');
}
-"))
+")
+ "")))
(define (woff-header paper)
"TODO:
(eo 'style '(text . "style/css"))
"<![CDATA[
"
- (define-fonts paper svg-define-font)
+ (define-fonts paper svg-define-font svg-define-font)
"]]>
"
(ec 'style)
(page-width (* output-scale device-width))
(page-height (* output-scale device-height)))
+ (if (ly:get-option 'svg-woff)
+ (module-define! (ly:outputter-module outputter) 'paper paper))
(dump (svg-begin page-width page-height
0 0 device-width device-height))
(if (ly:get-option 'svg-woff)
(svg-width (* output-scale device-width))
(svg-height (* output-scale device-height)))
+ (if (ly:get-option 'svg-woff)
+ (module-define! (ly:outputter-module outputter) 'paper paper))
(dump (svg-begin svg-width svg-height
left-x (- top-y) device-width device-height))
(if (ly:get-option svg-woff)
(define-public (laissez-vibrer::print grob)
(ly:tie::print grob))
-(define-public (define-fonts paper define-font)
- "Return a string of all fonts used in PAPER, invoking the function
-DEFINE-FONT for procuding the actual font definition."
-
- (define font-list (ly:paper-fonts paper))
+(define (filter-out pred? lst)
+ (filter (lambda (x) (not (pred? x))) lst))
+
+(define-public (font-name-split font-name)
+ "Return (FONT-NAME . DESIGN-SIZE) from FONT-NAME string or #f."
+ (let ((match (regexp-exec (make-regexp "(.*)-([0-9]*)") font-name)))
+ (if (regexp-match? match)
+ (cons (match:substring match 1) (match:substring match 2))
+ (cons font-name-designsize #f))))
+
+;; Example of a pango-physical-font
+;; ("Emmentaler-11" "/home/janneke/vc/lilypond/out/share/lilypond/current/fonts/otf/emmentaler-11.otf" 0)
+(define-public (pango-pf-font-name pango-pf)
+ "Return the font-name of the pango physical font PANGO-PF."
+ (list-ref pango-pf 0))
+(define-public (pango-pf-file-name pango-pf)
+ "Return the file-name of the pango physical font PANGO-PF."
+ (list-ref pango-pf 1))
+(define-public (pango-pf-fontindex pango-pf)
+ "Return the fontindex of the pango physical font PANGO-PF."
+ (list-ref pango-pf 2))
+
+(define (pango-font-name pango-font)
+ (pango-pf-font-name (car (ly:pango-font-physical-fonts pango-font))))
+
+(define-public (define-fonts paper define-font define-pango-pf)
+ "Return a string of all fonts used in PAPER, invoking the functions
+DEFINE-FONT DEFINE-PANGO-PF for producing the actual font definition."
+
+ (let* ((font-list (ly:paper-fonts paper))
+ (pango-fonts (filter ly:pango-font? font-list))
+ (other-fonts (filter-out ly:pango-font? font-list))
+ (other-font-names (map ly:font-name other-fonts))
+ (pango-only-fonts
+ (filter-out (lambda (x)
+ (member (pango-font-name x) other-font-names))
+ pango-fonts)))
(define (font-load-command font)
(let* ((font-name (ly:font-name font))
(display (list font font-name)))
(define-font font font-name scaling)))
- (apply string-append
- (map (lambda (x) (font-load-command x))
- (filter (lambda (x) (not (ly:pango-font? x)))
- font-list))))
+ (define (pango-font-load-command pango-font)
+ (let* ((pango-pf (car (ly:pango-font-physical-fonts pango-font)))
+ (font-name (pango-pf-font-name pango-pf))
+ (scaling (ly:output-def-lookup paper 'output-scale)))
+ (if (equal? font-name "unknown")
+ (display (list pango-font font-name)))
+ (define-pango-pf pango-pf font-name scaling)))
+
+ (string-append
+ (apply string-append (map font-load-command other-fonts))
+ (apply string-append (map pango-font-load-command pango-only-fonts)))))
(define-module (scm output-svg))
(define this-module (current-module))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; globals
+
+;;; set by framework-gnome.scm
+(define paper #f)
+
(use-modules
(guile)
(ice-9 regex)
(set! next-horiz-adv 0.0)
path)
-(define (woff-glyph-string font size cid glyphs)
- (if (list? glyphs)
- (named-glyph font (last (car glyphs)))
- (named-glyph font glyphs)))
+(define (woff-glyph-string font-name size cid? w-x-y-named-glyphs)
+ (let* ((name-style (font-name-style font-name))
+ (family-designsize (regexp-exec (make-regexp "(.*)-([0-9]*)")
+ font-name))
+ (family (if (regexp-match? family-designsize)
+ (match:substring family-designsize 1)
+ font-name))
+ (design-size (if (regexp-match? family-designsize)
+ (match:substring family-designsize 2)
+ #f))
+ (scaled-size (/ size lily-unit-length))
+ (font (ly:paper-get-font paper `(((font-family . ,family)
+ ,(if design-size
+ `(design-size . design-size)))))))
+ (define (glyph-spec w x y g)
+ (let* ((charcode (ly:font-glyph-name-to-charcode font g))
+ (char-lookup (format #f "&#~S;" charcode))
+ (glyph-by-name (eoc 'altglyph `(glyphname . ,g)))
+ (apparently-broken
+ (comment "XFIXME: how to select glyph by name, altglyph is broken?")))
+ ;; what is W?
+ (ly:format
+ "<text~a font-family=\"~a\" font-size=\"~a\">~a</text>"
+ (if (or (> (abs x) 0.00001)
+ (> (abs y) 0.00001))
+ (ly:format " transform=\"translate(~4f,~4f)\"" x y)
+ " ")
+ name-style scaled-size
+ (string-regexp-substitute
+ "\n" ""
+ (string-append glyph-by-name apparently-broken char-lookup)))))
+
+ (string-join (map (lambda (x) (apply glyph-spec x))
+ (reverse w-x-y-named-glyphs)) "\n")))
(define glyph-string
(if (not (ly:get-option 'svg-woff)) embedded-glyph-string woff-glyph-string))