document header. Apply scaling only once.
* scm/lily-library.scm (modified-font-metric-font-scaling): rename
from font-size.
* lily/paper-outputter-scheme.cc (LY_DEFINE):
ly:outputter-output-scheme, new function.
* scm/output-svg.scm (pango-description-to-svg-font): new function
+2005-03-11 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+ * scm/framework-svg.scm (output-framework): put scaling in
+ document header. Apply scaling only once.
+
+ * scm/lily-library.scm (modified-font-metric-font-scaling): rename
+ from font-size.
+
+ * lily/paper-outputter-scheme.cc (LY_DEFINE):
+ ly:outputter-output-scheme, new function.
+
+ * scm/output-svg.scm (pango-description-to-svg-font): new function
+
2005-03-10 Han-Wen Nienhuys <hanwen@xs4all.nl>
* Documentation/user/GNUmakefile (deep-symlinks): remove outimages
pianoLH = \relative c'' \repeat volta 2\new Voice {
#(set-accidental-style 'modern)
\voiceTwo
- g16(_\p fis a g fis g
+ g16( fis a g fis g
f e d c b
We want a maximal number of shared beams, but if there is choice, we
take the one that is closest to the end of the stem. This is for situations like
- x
- |
- |
+ x
+ |
+ |
|===|
|=
|
anything else is possible here, since we don't know funky-beaming
settings, or X-distances (slopes!) People that want sloped
knee-beams, should set the directions manually.
+
+
+ TODO:
+
+ this routine should take into account the stemlength scoring
+ of a possible knee/nonknee beam.
+
*/
void
Beam::consider_auto_knees (Grob *me)
Grob *common = common_refpoint_of_array (stems, me, Y_AXIS);
Real staff_space = Staff_symbol_referencer::staff_space (me);
- Array<Interval> head_positions_array;
+ Array<Interval> head_extents_array;
for (int i = 0; i < stems.size (); i++)
{
Grob *stem = stems[i];
if (Stem::is_invisible (stem))
continue;
- Interval head_positions = Stem::head_positions (stem);
- if (!head_positions.is_empty ())
+ Interval head_extents = Stem::head_positions (stem);
+ if (!head_extents.is_empty ())
{
- head_positions[LEFT] += -1;
- head_positions[RIGHT] += 1;
- head_positions *= staff_space * 0.5;
+ head_extents[LEFT] += -1;
+ head_extents[RIGHT] += 1;
+ head_extents *= staff_space * 0.5;
/*
We could subtract beam Y position, but this routine only
sets stem directions, a constant shift does not have an
influence.
*/
- head_positions += stem->relative_coordinate (common, Y_AXIS);
+ head_extents += stem->relative_coordinate (common, Y_AXIS);
if (to_dir (stem->get_property ("direction")))
{
Direction stemdir = to_dir (stem->get_property ("direction"));
- head_positions[-stemdir] = -stemdir * infinity_f;
+ head_extents[-stemdir] = -stemdir * infinity_f;
}
}
- head_positions_array.push (head_positions);
+ head_extents_array.push (head_extents);
- gaps.remove_interval (head_positions);
+ gaps.remove_interval (head_extents);
}
Interval max_gap;
if (Stem::is_invisible (stem))
continue;
- Interval head_positions = head_positions_array[j++];
+ Interval head_extents = head_extents_array[j++];
- Direction d = (head_positions.center () < max_gap.center ()) ?
+ Direction d = (head_extents.center () < max_gap.center ()) ?
UP : DOWN;
stem->set_property ("direction", scm_int2num (d));
- head_positions.intersect (max_gap);
- assert (head_positions.is_empty () || head_positions.length () < 1e-6);
+ head_extents.intersect (max_gap);
+ assert (head_extents.is_empty () || head_extents.length () < 1e-6);
}
}
}
po->close ();
return SCM_UNSPECIFIED;
}
+
+
+LY_DEFINE (ly_outputter_output_scheme, "ly:outputter-output-scheme",
+ 2, 0, 0, (SCM outputter, SCM expr),
+ "Eval @var{expr} in module of @var{outputter}.")
+{
+ Paper_outputter *po = unsmob_outputter (outputter);
+ SCM_ASSERT_TYPE (po, outputter, SCM_ARG1, __FUNCTION__, "Paper_outputter");
+
+ po->output_scheme (expr);
+
+ return SCM_UNSPECIFIED;
+}
answer = scm_eval (form, module);
}
else
- answer = scm_primitive_eval (form);
+ {
+ answer = scm_primitive_eval (form);
+ }
}
/* Reset read_buf for scm_ftell.
(define-module (scm framework-svg))
-(use-modules (guile) (lily) (scm output-svg))
-(use-modules (srfi srfi-1) (srfi srfi-2) (srfi srfi-13) (ice-9 regex))
+(use-modules (guile)
+ (lily)
+ (scm output-svg))
-;; FIXME: 0.62 to get paper size right
-(define output-scale (* 0.62 scale-to-unit))
+(use-modules (srfi srfi-1)
+ (srfi srfi-2)
+ (srfi srfi-13)
+ (ice-9 regex))
+
+(if #t
+ (begin
+ (debug-enable 'debug)
+ (debug-enable 'backtrace)
+ (read-enable 'positions)))
(define-public (output-framework basename book scopes fields)
(let* ((filename (format "~a.svg" basename))
(outputter (ly:make-paper-outputter filename
(ly:output-backend)))
- (paper (ly:paper-book-paper book))
+ (dump (lambda (str) (display str (ly:outputter-port outputter))))
+ (paper (ly:paper-book-paper book))
+ (unit-length (ly:output-def-lookup paper 'outputscale))
+ (output-scale (* lily-unit->mm-factor
+ unit-length))
(pages (ly:paper-book-pages book))
(landscape? (eq? (ly:output-def-lookup paper 'landscape) #t))
(page-number (1- (ly:output-def-lookup paper 'firstpagenumber)))
(page-width (inexact->exact (ceiling (* output-scale hsize))))
(page-height (inexact->exact (ceiling (* output-scale vsize))))
(page-set? (or (> page-count 1) landscape?)))
+
+ (ly:outputter-output-scheme outputter
+ `(set! lily-unit-length ,unit-length))
+ (dump (eo 'svg
+ '(xmlns . "http://www.w3.org/2000/svg")
+ '(version . "1.2")
+
+ ;; Argggghhhh: SVG takes the px <-> mm mapping from the windowing system
+ `(width . ,(format #f "~s" page-width))
+ `(height . ,(format #f "~s" page-height))))
- (ly:outputter-dump-string
- outputter
- (eo 'svg
- '(xmlns . "http://www.w3.org/2000/svg")
- '(version . "1.2")
- `(width . ,(format #f "~smm" page-width))
- `(height . ,(format #f "~smm" page-height))))
-
- (ly:outputter-dump-string outputter (dump-fonts outputter paper))
- (ly:outputter-dump-string
- outputter
- (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)))
-
- (for-each
- (lambda (page)
- (set! page-number (1+ page-number))
- (dump-page outputter page page-number page-count landscape? page-set?))
- pages)
-
- (if page-set? (eo 'pageSet) "")
- (ly:outputter-dump-string
- outputter
- (string-append
- (ec 'g)
- (if page-set? (ec 'pageSet) "")
- (ec 'svg)))))
+ (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)))))
+
+ (for-each
+ (lambda (page)
+ (set! page-number (1+ page-number))
+ (dump-page outputter page page-number page-count landscape? page-set?))
+ pages)
+
+ (if page-set? (eo 'pageSet) "")
+ (dump
+ (string-append
+ (ec 'g)
+ (if page-set? (ec 'pageSet) "")
+ (ec 'svg)))))
(define (dump-page outputter page page-number page-count landscape? page-set?)
- (ly:outputter-dump-string
- outputter (comment (format #f "Page: ~S/~S" page-number page-count)))
+ (define (dump str) (display str (ly:outputter-port outputter)))
+
+ (dump (comment (format #f "Page: ~S/~S" page-number page-count)))
(if (or landscape? page-set?)
- (ly:outputter-dump-string
- outputter
- (if landscape? (eo 'page '(page-orientation . "270")) (eo 'page))))
- (ly:outputter-dump-string outputter (string-append (eo 'g)))
+ (dump
+ (if landscape?
+ (eo 'page '(page-orientation . "270"))
+ (eo 'page))))
+
+ (dump (string-append (eo 'g)))
(ly:outputter-dump-stencil outputter page)
- (ly:outputter-dump-string outputter (string-append (ec 'g)))
+ (dump (string-append (ec 'g)))
(if (or landscape? page-set?)
- (ly:outputter-dump-string outputter (ec 'page))))
+ (dump (ec 'page))))
(define (embed-font string)
(let ((start (string-contains string "<defs>"))
(define-public (!= lst r)
(not (= lst r)))
-(define-public scale-to-unit
+(define-public lily-unit->bigpoint-factor
(cond
((equal? (ly:unit) "mm") (/ 72.0 25.4))
((equal? (ly:unit) "pt") (/ 72.0 72.27))
(else (error "unknown unit" (ly:unit)))))
+
+(define-public lily-unit->mm-factor
+ (* 25.4 (/ lily-unit->bigpoint-factor 72)))
+
;;; FONT may be font smob, or pango font string...
(define-public (font-name-style font)
;; FIXME: ughr, (ly:font-name) sometimes also has Style appended.
name-style
(append name-style '("Regular"))))))
-(define-public (font-size font)
+(define-public (modified-font-metric-font-scaling font)
(let* ((designsize (ly:font-design-size font))
(magnification (* (ly:font-magnification font)))
(scaling (* magnification designsize)))
(* 1.85
(if (string? font)
12
- (* output-scale (font-size font)))))
+ (* output-scale (modified-font-metric-font-scaling font)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Wrappers from guile-gnome TLA
;;(define output-scale 2.83464566929134)
-(define scale-to-unit
- (cond
- ((equal? (ly:unit) "mm") (/ 72.0 25.4))
- ((equal? (ly:unit) "pt") (/ 72.0 72.27))
- (else (error "unknown unit" (ly:unit)))
- ))
(define (mul-scale x) (* scale-to-unit output-scale x))
(lily)
(srfi srfi-13))
-;; GLobals
-;; FIXME: 2?
-(define output-scale (* 2 scale-to-unit))
+
+(if #t
+ (begin
+ (debug-enable 'debug)
+ (debug-enable 'backtrace)
+ (read-enable 'positions)))
+(define lily-unit-length 1.75)
(define (dispatch expr)
(let ((keyword (car expr)))
(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-to-svg-font str)
+ (let*
+ ((size 4.0)
+ (family "Helvetica")
+ (style #f)
+ (match (regexp-exec pango-description-regexp str)))
+
+ (if (regexp-match? match)
+ (begin
+ (set! family (match:substring match 1))
+ (if (< 0 (string-length (match:substring match 2)))
+ (set! style (match:substring match 2)))
+ (set! size
+ (string->number (match:substring match 3))))
+
+ (display (format "Cannot decypher Pango description: ~a\n" str)))
+
+ (set! style
+ (if (string? style)
+ (format "font-style:~a;" style)
+ ""))
+
+ (format "font-family:~a;~afont-size:~a;text-anchor:west"
+ family
+ style
+ (/ size lily-unit-length))
+ ))
+
;;; FONT may be font smob, or pango font string
(define (svg-font font)
- (let ((name-style (if (string? font)
- (list font "Regular")
- (font-name-style font)))
- (size (svg-font-size font))
+ (if (string? font)
+ (pango-description-to-svg-font font)
+ (let ((name-style (font-name-style font))
+ (size (modified-font-metric-font-scaling font))
(anchor "west"))
- (format #f "font-family:~a;font-style:~a;font-size:~a;text-anchor:~a;"
- (car name-style) (cadr name-style) size anchor)))
-;;; FONT may be font smob, or pango font string
-(define (svg-font-size font)
- (if (string? font)
- 12
- (* output-scale (font-size font))))
+ (format #f "font-family:~a;font-style:~a;font-size:~a;text-anchor:~a;"
+ (car name-style) (cadr name-style)
+ size anchor))))
(define (fontify font expr)
- (entity 'text expr (cons 'style (svg-font font))))
+ (entity 'text expr (cons 'style (svg-font font))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; stencil outputters
`(width . ,width)
`(height . ,(+ thick (* (abs z) (/ thick 2))))
`(rx . ,(/ blot-diameter 2))
- `(transform . ,(string-append
- (format #f "matrix (1, ~f, 0, 1, 0, 0)" (- z))
- (format #f " scale (~f, ~f)"
- output-scale output-scale))))))
+ `(transform . ,(format #f "matrix (1, ~f, 0, 1, 0, 0)" (- z))
+ ))))
(define (beam width slope thick blot-diameter)
(let* ((b blot-diameter)
(cons (+ w (/ b 2)) (+ h (/ t 2)))
(cons (+ w (/ b 2)) (+ h (- (/ t 2))))
(cons (/ b 2) (- (/ t 2)))))))
- `(transform
- . ,(format #f "scale (~f, -~f)" output-scale output-scale)))))
+ )))
(define (path-beam width slope thick blot-diameter)
(let* ((b blot-diameter)
0 (- t)
(- w) h
0 t))
- `(transform
- . ,(format #f "scale (~f, ~f)" output-scale output-scale)))))
+ )))
(define (bezier-sandwich lst thick)
(let* ((first (list-tail lst 4))
'(fill . "black")
`(d . ,(string-append (svg-bezier first #f)
(svg-bezier second first-c0)))
- `(transform
- . ,(format #f "scale (~f, -~f)" output-scale output-scale)))))
+ )))
(define (char font i)
(dispatch
`(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)
;;(dispatch expr)
expr
`(transform . ,(format #f "translate (~f, ~f)"
- (* output-scale x)
- (- (* output-scale y))))))
+ x
+ (- y)))))
(define (polygon coords blot-diameter)
(entity 'polygon ""
;;'(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 ""
`(width . ,(+ breapth width))
`(height . ,(+ depth height))
`(ry . ,(/ blot-diameter 2))
- `(transform
- . ,(format #f "scale (~f, ~f)" output-scale output-scale))))
+ ))
(define (text font string)
(dispatch `(fontify ,font ,(entity 'tspan (string->entities string)))))
projects / lilypond.git / commitdiff