+2004-11-16 Jan Nieuwenhuizen <janneke@gnu.org>
+
+ * scm/lily-library.scm (char->unicode-index): New function.
+
+ * scm/output-gnome.scm:
+ * scm/output-svg.scm: Cleanup. Map custom fonts to PUA.
+
+ * Proper naming of file name throughout; s/filename/file[-_]name/.
+
+ * lily/modified-font-metric.cc ("ly:font-encoding"): New function.
+
+ * lily/pangofc-afm-decoder.cc (pango_fc_afm_get_glyph): Map onto PUA.
+
2004-11-16 Werner Lemberg <wl@gnu.org>
* scripts/lilypond-book.py: The Lord has commanded me to use only
SCM val;
if (!afm_p_dict_->try_retrieve (sname, &val))
{
- String filename;
+ String file_name;
- if (filename.is_empty ())
- filename = search_path_.find (name + ".afm");
+ if (file_name.is_empty ())
+ file_name = search_path_.find (name + ".afm");
- if (filename.is_empty ())
+ if (file_name.is_empty ())
{
String p = kpathsea_find_afm (name.to_str0 ());
if (p.length ())
- filename = p;
+ file_name = p;
}
- if (filename.is_empty ())
+ if (file_name.is_empty ())
return 0;
if (verbose_global_b)
- progress_indication ("[" + filename);
- val = read_afm_file (filename);
- unsmob_metrics (val)->filename_ = filename;
+ progress_indication ("[" + file_name);
+ val = read_afm_file (file_name);
+ unsmob_metrics (val)->file_name_ = file_name;
unsmob_metrics (val)->description_ = scm_cons (name_string,
scm_make_real (1.0));
{
// FIXME: broken sentence
String s = _f ("checksum mismatch for font file: `%s'",
- filename.to_str0 ());
+ file_name.to_str0 ());
s += " " + _f ("does not match: `%s'",
- tfm->filename_.to_str0 ());
+ tfm->file_name_.to_str0 ());
s += "\n";
s += " TFM: " + to_string ((int) tfm->info_.checksum);
s += " AFM: " + to_string ((int) afm->checksum_);
SCM val;
if (!tfm_p_dict_->try_retrieve (sname, &val))
{
- String filename;
+ String file_name;
- if (filename.is_empty ())
+ if (file_name.is_empty ())
{
String p = kpathsea_find_tfm (name.to_str0 ());
if (p.length ())
- filename = p;
+ file_name = p;
}
- if (filename.is_empty ())
- filename = search_path_.find (name + ".tfm");
- if (filename.is_empty ())
+ if (file_name.is_empty ())
+ file_name = search_path_.find (name + ".tfm");
+ if (file_name.is_empty ())
return 0;
if (verbose_global_b)
- progress_indication ("[" + filename);
+ progress_indication ("[" + file_name);
- val = Tex_font_metric::make_tfm (filename);
+ val = Tex_font_metric::make_tfm (file_name);
if (verbose_global_b)
progress_indication ("]");
- unsmob_metrics (val)->filename_ = filename;
+ unsmob_metrics (val)->file_name_ = file_name;
unsmob_metrics (val)->description_ = scm_cons (name_string,
scm_make_real (1.0));
tfm_p_dict_->set (sname, val);
#include "binary-source-file.hh"
#include "string-convert.hh"
-Binary_source_file::Binary_source_file (String& filename_string)
- : Source_file (filename_string)
+Binary_source_file::Binary_source_file (String& file_name_string)
+ : Source_file (file_name_string)
{
}
return scm_cons (ly_interval2scm (b[X_AXIS]), ly_interval2scm (b[Y_AXIS]));
}
-LY_DEFINE (ly_font_filename,"ly:font-filename",
+LY_DEFINE (ly_font_file_name,"ly:font-file-name",
1, 0, 0,
(SCM font),
"Given the font metric @var{font}, "
LexerError (msg.to_str0 ());
return;
}
- filename_strings_.push (file->name_string ());
+ file_name_strings_.push (file->name_string ());
char_count_stack_.push (0);
if (yy_current_buffer)
{
Source_file *file = new Source_file (name, data);
sources->add (file);
- filename_strings_.push (name);
+ file_name_strings_.push (name);
char_count_stack_.push (0);
if (yy_current_buffer)
class Binary_source_file : public Source_file
{
public:
- Binary_source_file (String& filename_string );
+ Binary_source_file (String& file_name_string );
virtual ~Binary_source_file ();
U8 get_U8 ();
{
public:
SCM description_;
- String filename_;
+ String file_name_;
virtual int count () const;
virtual Offset get_indexed_wxwy (int) const;
~Includable_lexer ();
/// store dependencies for Makefile stuff.
- Array<String> filename_strings_;
+ Array<String> file_name_strings_;
Source_file* get_source_file () const;
void new_input (String s, Sources*);
/// Midi outputfile
struct Midi_stream {
- Midi_stream (String filename_string);
+ Midi_stream (String file_name_string);
~Midi_stream ();
Midi_stream& operator << ( String str);
void open ();
FILE *out_file_;
- String filename_string_;
+ String file_name_string_;
};
#endif // MIDI_STREAM_HH
class Paper_outputter
{
SCM output_module_;
- String filename_;
+ String file_name_;
SCM file_;
SCM file ();
Sources ();
~Sources ();
- Source_file *get_file (String &filename );
+ Source_file *get_file (String &file_name );
Source_file *get_sourcefile (char const*);
void add (Source_file* sourcefile );
void set_path (File_path*);
#include "string.hh"
#if __GNUC__ > 2
-std::ostream *open_file_stream (String filename,
+std::ostream *open_file_stream (String file_name,
std::ios_base::openmode mode=std::ios::out);
#else
-std::ostream *open_file_stream (String filename, int mode=ios::out);
+std::ostream *open_file_stream (String file_name, int mode=ios::out);
#endif
void close_file_stream (std::ostream *os);
class Tex_font_metric : public Simple_font_metric
{
public:
- static SCM make_tfm (String filename);
+ static SCM make_tfm (String file_name);
virtual int count () const;
virtual Box get_ascii_char (int) const;
TODO: rename this function. ly:input-location? vs ly:input-location
*/
LY_DEFINE (ly_input_location, "ly:input-location", 1, 0, 0, (SCM sip),
- "Return input location in @var{sip} as (filename line column).")
+ "Return input location in @var{sip} as (file-name line column).")
{
Input *ip = unsmob_input (sip);
SCM_ASSERT_TYPE (ip, sip, SCM_ARG1, __FUNCTION__, "input location");
String
kpathsea_find_tfm (char const *name)
{
- String filename = global_path.find (String (name) + ".tfm");
+ String file_name = global_path.find (String (name) + ".tfm");
#if (KPATHSEA && HAVE_KPSE_FIND_FILE)
- if (filename.is_empty ())
+ if (file_name.is_empty ())
{
/* If invoked for a TeX font, we could do TRUE (must exist).
We could also do:
if (!p)
warning (_f ("kpathsea can not find TFM file: `%s'", name));
else
- filename = p;
+ file_name = p;
}
#endif
- return filename;
+ return file_name;
}
#if KPATHSEA
String
kpathsea_gulp_file_to_string (String name)
{
- String filename = global_path.find (name);
+ String file_name = global_path.find (name);
#if (KPATHSEA && HAVE_KPSE_FIND_FILE)
- if (filename.is_empty ())
+ if (file_name.is_empty ())
{
char *p = kpse_find_file (name.to_str0 (), kpathsea_find_format (name),
true);
if (p)
- filename = p;
+ file_name = p;
else
warning (_f ("kpathsea can not find file: `%s'", name));
}
#endif
- if (filename.is_empty ())
+ if (file_name.is_empty ())
error (_f ("can't find file: `%s'", name));
if (verbose_global_b)
- progress_indication ("[" + filename);
+ progress_indication ("[" + file_name);
int filesize;
- char *str = gulp_file (filename, &filesize);
+ char *str = gulp_file (file_name, &filesize);
String string (str);
delete[] str;
SCM_ASSERT_TYPE (scm_is_string (name), name, SCM_ARG1, __FUNCTION__, "string");
String nm = ly_scm2string (name);
- String filename = global_path.find (nm);
- if (filename.is_empty ())
+ String file_name = global_path.find (nm);
+ if (file_name.is_empty ())
{
char *p = kpse_find_file (nm.to_str0 (), kpathsea_find_format (nm),
true);
else
return SCM_BOOL_F;
}
- return scm_makfrom0str (filename.to_str0 ());
+ return scm_makfrom0str (file_name.to_str0 ());
}
#include "warn.hh"
#include "scm-option.hh"
-Midi_stream::Midi_stream (String filename)
+Midi_stream::Midi_stream (String file_name)
{
- filename_string_ = filename;
- out_file_ = fopen (filename.to_str0(), "wb");
+ file_name_string_ = file_name;
+ out_file_ = fopen (file_name.to_str0(), "wb");
}
Midi_stream::~Midi_stream ()
coding_description_);
}
}
-
-
-
-LY_DEFINE (ly_font_encoding_alist, "ly:font-encoding-alist",
- 1, 0, 0,
- (SCM font),
- "Given the Modified_font_metric @var{font}, return an "
- "alist. Keys are input-name, input-vector, "
- "output-name, output-table, mapping.")
-{
- Modified_font_metric *fm
- = dynamic_cast<Modified_font_metric*> (unsmob_metrics (font));
-
- SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "Modified_font_metric");
- return fm->coding_description_;
-}
-
SCM
Modified_font_metric::make_scaled_font_metric (SCM coding,
Font_metric *m, Real s)
{
Interval ydims;
- Real w=0.0;
+ Real w = 0.0;
for (int i = 0; i < text.length (); i++)
{
if (!scm_is_symbol (sym))
continue;
- char const * chars = scm_i_string_chars (scm_symbol_to_string(sym));
+ char const *chars = scm_i_string_chars (scm_symbol_to_string (sym));
int idx = orig_->name_to_index (chars);
if (idx >= 0)
{
return orig_;
}
+
+
+LY_DEFINE (ly_font_encoding_alist, "ly:font-encoding-alist",
+ 1, 0, 0,
+ (SCM font),
+ "Given the Modified_font_metric @var{font}, return an "
+ "alist. Keys are input-name, input-vector, "
+ "output-name, output-table, mapping.")
+{
+ Modified_font_metric *fm
+ = dynamic_cast<Modified_font_metric*> (unsmob_metrics (font));
+
+ SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "Modified_font_metric");
+ return fm->coding_description_;
+}
+
+LY_DEFINE (ly_font_encoding, "ly:font-encoding",
+ 1, 0, 0,
+ (SCM font),
+ "Return encoding of @var{font}.")
+{
+ Modified_font_metric *fm
+ = dynamic_cast<Modified_font_metric*> (unsmob_metrics (font));
+ SCM_ASSERT_TYPE (fm, font, SCM_ARG1, __FUNCTION__, "Modified_font_metric");
+ return ly_symbol2scm (fm->original_font ()->coding_scheme ().to_str0 ());
+}
+
struct _PangoFcAfmDecoderPrivate
{
GString encoding[256];
- //GString file_name;
char const *file_name;
PangoFcFont *fc_font;
};
static PangoFcDecoderClass *parent_class;
-#if 0
-/* ugly warning */
G_DEFINE_TYPE (PangoFcAfmDecoder, pango_fc_afm_decoder, PANGO_TYPE_FC_DECODER);
-#else
-GType
-pango_fc_afm_decoder_get_type (void)
-{
- static GType object_type = 0;
-
- if (!object_type)
- {
- static const GTypeInfo object_info =
- {
- sizeof (PangoFcAfmDecoderClass),
- (GBaseInitFunc) 0,
- (GBaseFinalizeFunc) 0,
- (GClassInitFunc) pango_fc_afm_decoder_class_init,
- 0, /* class_finalize */
- 0, /* class_data */
- sizeof (PangoFcAfmDecoder),
- 0, /* n_preallocs */
- (GInstanceInitFunc) pango_fc_afm_decoder_init,
- 0, /* value table */
- };
-
- object_type = g_type_register_static (PANGO_TYPE_FC_DECODER,
- "PangoFcAfmDecoder",
- &object_info, (GTypeFlags)0);
- }
-
- return object_type;
-}
-#endif
static void
pango_fc_afm_decoder_init (PangoFcAfmDecoder *fcafmdecoder)
= G_TYPE_INSTANCE_GET_PRIVATE (fcafmdecoder,
PANGO_TYPE_FC_AFM_DECODER,
PangoFcAfmDecoderPrivate);
- /*
- init members
- */
}
static void
static void
pango_fc_afm_decoder_finalize (GObject *object)
{
-#if 0
- PangoFcAfmDecoder *fcafmdecoder = PANGO_FC_AFM_DECODER (object);
- PangoFcAfmDecoderPrivate *priv = fcafmdecoder->priv;
-#endif
-
- /*
- destroy members
- */
G_OBJECT_CLASS (parent_class)->finalize (object);
}
pango_fc_afm_get_charset (PangoFcDecoder *decoder, PangoFcFont *fcfont)
{
(void) decoder;
- //dprintf ("get charset: %s\n", fcfont->font_pattern);
dprintf ("get charset: \n");
#if 0
FcCharSet *charset = 0;
FcPatternGetCharSet (fcfont->font_pattern, FC_CHARSET, 0, &charset);
#else
/* Return plain, undecoded charset.
- TODO:
- - actually read AFM?
- - caching?
- - PUA mapping ? */
+ FIXME:
+ - actually read AFM
+ - caching */
(void) fcfont;
int i;
FcChar32 chr = 0;
dprintf ("get glyph! 0x%x --> 0x%x\n", wc, (unsigned)g);
#else
(void) fcfont;
- /* TODO:
- - PUA mapping?
-
- Shortcut PUA mapping/AFM reading: The Feta charsets are encoded
- without any gaps, starting at 0x21. *grin*
-
- FIXME: +1 what has changed? -- jcn
- */
- return wc - 0x21 + 1;
+ /* FIXME
+ Use direct privat usage area (PUA) mapping as shortcut for
+ actual AFM reading. The Feta charsets are encoded without any
+ gaps, and mappend onto PUA. */
+ return wc - 0xe000;
#endif
}
#include "ly-smobs.icc"
-Paper_outputter::Paper_outputter (String filename, String format)
+Paper_outputter::Paper_outputter (String file_name, String format)
{
file_ = SCM_EOL;
output_module_ = SCM_EOL;
smobify_self ();
- filename_ = filename;
+ file_name_ = file_name;
String module_name = "scm output-" + format;
output_module_ = scm_c_resolve_module (module_name.to_str0 ());
}
Paper_outputter::file ()
{
if (file_ == SCM_EOL)
- if (filename_ == "-")
+ if (file_name_ == "-")
file_ = scm_current_output_port();
else
- file_ = scm_open_file (scm_makfrom0str (filename_.to_str0 ()),
+ file_ = scm_open_file (scm_makfrom0str (file_name_.to_str0 ()),
scm_makfrom0str ("w"));
return file_;
}
{
Global_context *g = dynamic_cast<Global_context*> (unsmob_context (context));
SCM_ASSERT_TYPE (g, context, SCM_ARG1, __FUNCTION__, "Global context");
- SCM_ASSERT_TYPE (scm_is_string (outname), outname, SCM_ARG2, __FUNCTION__, "output filename");
+ SCM_ASSERT_TYPE (scm_is_string (outname), outname, SCM_ARG2, __FUNCTION__, "output file name");
Music_output *output = g->get_output ();
progress_indication ("\n");
}
SCM
-Tex_font_metric::make_tfm (String filename)
+Tex_font_metric::make_tfm (String file_name)
{
Tex_font_metric *tfm = new Tex_font_metric;
- Tex_font_metric_reader reader (filename);
+ Tex_font_metric_reader reader (file_name);
tfm->info_ = reader.info_;
tfm->header_ = reader.header_;
;;
-(define-public (read-encoding-file filename)
+(define-public (read-encoding-file file-name)
"Read .enc file, return (COMMAND-NAME . VECTOR-OF-SYMBOLS)."
- (let* ((path (ly:kpathsea-expand-path filename))
- (unused (if (string? path) #t (ly:warn "can't find ~s" filename)))
+ (let* ((path (ly:kpathsea-expand-path file-name))
+ (unused (if (string? path) #t (ly:warn "can't find ~s" file-name)))
(raw (ly:gulp-file path))
(string (regexp-substitute/global #f "%[^\n]*" raw 'pre "" 'post))
(command (match:substring
(iota 256))))
-(define (get-coding-from-file filename)
- "Read FILENAME, return a list containing encoding vector and table"
- (let* ((coding (read-encoding-file filename))
+(define (get-coding-from-file file-name)
+ "Read FILE-NAME, return a list containing encoding vector and table"
+ (let* ((coding (read-encoding-file file-name))
(com (car coding))
(vec (cdr coding))
(tab (make-encoding-table vec)))
(list com vec tab)))
-;; coding-alist maps NAME -> (list FILENAME COMMAND VECTOR TAB)
+;; coding-alist maps NAME -> (list FILE-NAME COMMAND VECTOR TAB)
(define coding-alist
(map (lambda (x)
(ly:programming-error "programming error: cross thumbs, using: ~S:" fallback)
(get-coding fallback))))))
-(define-public (get-coding-filename coding-name)
+(define-public (get-coding-file-name coding-name)
(car (get-coding coding-name)))
(define-public (get-coding-command coding-name)
;; (display (make-font-tree 1.0))
-;; Century Schoolbook fonts filenames on Debian/Sid
+;; Century Schoolbook fonts file names on Debian/Sid
(define-public (add-century-schoolbook-fonts node factor)
(add-font node
"lilypond-feta-braces-g"
"lilypond-feta-braces-h"
"lilypond-feta-braces-i"
- ;; is this necessary?
- "lilypond-feta-din"
"lilypond-parmesan"))
(dump-page go 0)
(/ 72 25.4))
(define-public (ps-font-command font . override-coding)
- (let* ((name (ly:font-filename font))
+ (let* ((name (ly:font-file-name font))
(magnify (ly:font-magnification font))
(coding-alist (ly:font-encoding-alist font))
(input-encoding (assoc-get 'input-name coding-alist))
(define (load-fonts paper)
(let* ((fonts (ly:paper-fonts paper))
- (font-names (uniq-list (sort (map ly:font-filename fonts) string<?)))
+ (font-names (uniq-list (sort (map ly:font-file-name fonts) string<?)))
(pfas (map
(lambda (x)
(let* ((specced-font-name (ly:font-name font))
(fontname (if specced-font-name
specced-font-name
- (ly:font-filename font)))
+ (ly:font-file-name font)))
(coding-alist (ly:font-encoding-alist font))
(input-encoding (assoc-get 'input-name coding-alist))
(reencode-font fontname input-encoding scaling command)))))
(define (font-load-encoding encoding)
- (let ((filename (get-coding-filename encoding)))
- (ly:gulp-file (ly:kpathsea-expand-path filename))))
+ (let ((file-name (get-coding-file-name encoding)))
+ (ly:gulp-file (ly:kpathsea-expand-path file-name))))
(let* ((encoding-list (map (lambda (x)
(assoc-get 'input-name
(string-append
"magfont"
(string-encode-integer
- (hashq (ly:font-filename font) 1000000))
+ (hashq (ly:font-file-name font) 1000000))
"m"
(string-encode-integer
(inexact->exact (round (* 1000 (ly:font-magnification font)))))))
(font-encoding (assoc-get 'output-name coding-alist)))
(string-append
"\\font\\lilypond" (tex-font-command font) "="
- (ly:font-filename font)
+ (ly:font-file-name font)
" scaled "
(ly:number->string (inexact->exact
(round (* 1000
((equal? (ly:unit) "pt") (/ 72.0 72.27))
(else (error "unknown unit" (ly:unit)))))
+;;; font
+(define-public (font-family font)
+ (let ((name (ly:font-name font)))
+ (if name
+ (regexp-substitute/global #f "^GNU-(.*)-[.0-9]*$" name 'pre 1 'post)
+ (begin
+ ;;(stderr "font-name: ~S\n" (ly:font-name font))
+ ;;(stderr "font-file-name: ~S\n" (ly:font-file-name font))
+ (ly:font-file-name font)))))
+
+(define-public (char->unicode-index font char)
+ (+ (case (ly:font-encoding font)
+ ((fetaMusic) (- #xe000 #x20))
+ ((fetaBraces) (- #xe000 #x40))
+ (else 0))
+ (char->integer char)))
(+ #x80 (modulo y #x40))))))
(else FIXME)))
-(define (custom-utf8 i)
- (if (< i #x80)
- (utf8 i)
- (utf8 (+ #xee00 i))))
-
-(define (string->utf8-string string)
- (list->string
- (apply append (map utf8 (map char->integer (string->list string))))))
-
-(define (char->utf8-string char)
- (list->string (utf8 (char->integer char))))
+(define (char->utf8-string font char)
+ (list->string (utf8 (char->unicode-index font char))))
+
+(define (string->utf8-string font string)
+ (apply
+ string-append
+ (map (lambda (x) (char->utf8-string font x)) (string->list string))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; stencil outputters
(set-path-def props def)
props))
-
;; two beziers
(define (bezier-sandwich lst thick)
(let* ((def (make <gnome-canvas-path-def>))
#:width-units blot-diameter
#:join-style 'round)))
-(define (text font string)
+(define (text font s)
(define (pango-font-name font)
- (let ((name (ly:font-name font)))
- (if name
- (regexp-substitute/global #f "^GNU-(.*)-[.0-9]*$" name 'pre 1 'post)
- (begin
- (stderr "font-name: ~S\n" (ly:font-name font))
- ;; TODO s/filename/file-name/
- (stderr "font-filename: ~S\n" (ly:font-filename font))
- (stderr "pango-font-size: ~S\n" (pango-font-size font))
- ;;"ecrm12"))))
- (ly:font-filename font)))))
+ (font-family font))
(define (pango-font-size font)
(let* ((designsize (ly:font-design-size font))
(magnification (* (ly:font-magnification font)))
-
;;font-name: "GNU-LilyPond-feta-20"
- ;;font-filename: "feta20"
+ ;;font-file-name: "feta20"
;;pango-font-name: "lilypond-feta, regular 32"
;;OPS:2.61
;;scaling:29.7046771653543
;;magnification:0.569055118110236
;;design:20.0
- ;; experimental sizing:
+ ;; ugh, experimental sizing
;; where does factor ops come from?
;; Hmm, design size: 26/20
(ops 2.60)
scaling))
- (make <gnome-canvas-text>
- #:parent (canvas-root)
-
- #:anchor 'west
- #:x 0.0 #:y 0.15
-
- #:font (pango-font-name font)
-
- #:size-points (pango-font-size font)
- ;;#:size ...
- #:size-set #t
-
- ;;apparently no effect :-(
- ;;#:scale 1.0
- ;;#:scale-set #t
-
- #:fill-color "black"
- #:text (if (string? string)
- (string->utf8-string string)
- (char->utf8-string string))))
-
+ (let ((encoding (ly:font-encoding font)))
+ (make <gnome-canvas-text>
+ #:parent (canvas-root)
+ ;; ugh, experimental placement corections
+ ;; #:x 0.0 #:y 0.0
+ #:x 0.0 #:y (if (memq encoding '(fetaMusic fetaBraces)) 0.15 0.69)
+
+ #:anchor (if (memq encoding '(fetaMusic fetaBraces)) 'west 'south-west)
+ #:font (pango-font-name font)
+ #:size-points (pango-font-size font)
+ #:size-set #t
+ #:text (if (char? s)
+ (char->utf8-string font s)
+ (string->utf8-string font s)))))
;; GLobals
;; FIXME: 2?
(define output-scale (* 2 scale-to-unit))
-(define line-thickness 0)
(define (stderr string . rest)
(apply format (cons (current-error-port) (cons string rest)))
(define (control-flip-y c)
(cons (car c) (* -1 (cdr c))))
-(define (ly:numbers->string l)
+(define (ly:numbers->string lst)
(string-append
- (number->string (car l))
- (if (null? (cdr l))
+ (number->string (car lst))
+ (if (null? (cdr lst))
""
- (string-append "," (ly:numbers->string (cdr l))))))
+ (string-append "," (ly:numbers->string (cdr lst))))))
-(define (svg-bezier l close)
- (let* ((c0 (car (list-tail l 3)))
- (c123 (list-head l 3)))
+(define (svg-bezier lst close)
+ (let* ((c0 (car (list-tail lst 3)))
+ (c123 (list-head lst 3)))
(string-append
(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")))))
-
+ "L " (control->string close))))))
(define (sqr x)
(* x x))
-(define (fontify font expr)
- (tagify "text" expr (cons 'style (svg-font font))))
-;; (cons 'unicode-range "U+EE00-EEFF"))))
-
-(define (font-family font)
- (let ((name (ly:font-name font)))
- (if name
- (regexp-substitute/global #f "^GNU-(.*)-[.0-9]*$" name 'pre 1 'post)
- (begin
- (stderr "font-name: ~S\n" (ly:font-name font))
- ;; TODO s/filename/file-name/
- (stderr "font-filename: ~S\n" (ly:font-filename font))
- (stderr "font-size: ~S\n" (font-size font))
- "ecrm12"))))
-
(define (font-size font)
(let* ((designsize (ly:font-design-size font))
(magnification (* (ly:font-magnification font)))
(debugf "design:~S\n" designsize)
scaling))
-(define (integer->entity i)
- (format #f "&#x~x;" i))
-
-(define (char->entity font c)
- (define font-name-base-alist
- `(("LilyPond-feta" . ,(- #xe000 #x20))
- ("LilyPond-feta-braces-a" . ,(- #xe000 #x40))
- ("LilyPond-feta-braces-b" . ,(- #xe000 #x40))
- ("LilyPond-feta-braces-c" . ,(- #xe000 #x40))
- ("LilyPond-feta-braces-d" . ,(- #xe000 #x40))
- ("LilyPond-feta-braces-d" . ,(- #xe000 #x40))
- ("LilyPond-feta-braces-e" . ,(- #xe000 #x40))
- ("LilyPond-feta-braces-f" . ,(- #xe000 #x40))
- ("LilyPond-feta-braces-g" . ,(- #xe000 #x40))
- ("LilyPond-feta-braces-h" . ,(- #xe000 #x40))
- ("LilyPond-feta-braces-i" . ,(- #xe000 #x40))
- ("LilyPond-parmesan" . ,(- #xe000 #x20))))
-
- (integer->entity (+ (assoc-get (font-family font) font-name-base-alist 0)
- (char->integer c))))
-
+(define (char->entity font char)
+ (format #f "&#x~x;" (char->unicode-index font char)))
+
(define (string->entities font string)
(apply string-append
(map (lambda (x) (char->entity font x)) (string->list string))))
+(define (svg-font font)
+ (let* ((encoding (ly:font-encoding font))
+ (anchor (if (memq encoding '(fetaMusic fetaBraces)) 'start 'middle)))
+ (format #f "font-family:~a;font-size:~a;text-anchor:~S;"
+ (font-family font) (font-size font) anchor)))
+
+(define (fontify font expr)
+ (tagify "text" expr (cons 'style (svg-font font))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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:round;stroke-linecap:round;" line-thickness))
+ `(style . ,(format "stroke-linejoin:round;stroke-linecap:round;stroke-width:~f;" blot))
`(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)))
- `(ry . ,(number->string (* output-scale (/ line-thickness 2))))
+ `(ry . ,(number->string (* output-scale (/ blot 2))))
`(transform .
,(format #f "matrix (~f, ~f, 0, 1, 0, 0) scale (~f, ~f)"
(/ x z)
(* -1 (/ y z))
1 1)))))
-(define (bezier-sandwich l thick)
- (let* (;;(l (eval urg-l this-module))
- (first (list-tail l 4))
+(define (bezier-sandwich lst thick)
+ (let* ((first (list-tail lst 4))
(first-c0 (car (list-tail first 3)))
- (second (list-head l 4)))
+ (second (list-head lst 4)))
(tagify "path" ""
- `(stroke . "#000000")
- `(stroke-width . ,(number->string line-thickness))
+ `(style . ,(format "stroke-linejoin:round;stroke-linecap:round;stroke-width:~f;" thick))
`(transform . ,(format #f "scale (~f, ~f)"
output-scale output-scale))
`(d . ,(string-append (svg-bezier first #f)
(string-append "<!-- " s " !-->\n"))
(define (filledbox breapth width depth height)
- (round-filled-box breapth width depth height line-thickness))
-
-(define (lily-def key 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! line-thickness (* scale-to-unit (string->number val)))))
- "")
+ (round-filled-box breapth width depth height 0))
(define (placebox x y expr)
(tagify "g"
(define (round-filled-box breapth width depth height blot-diameter)
(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))
+ `(style . ,(format "stroke-linejoin:round;stroke-linecap:round;stroke-width:~f;" blot-diameter))
`(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 2)))))
-(define (svg-font font)
- (format #f "font-family:~a;font-size:~a;fill:black;text-anchor:start;"
- (font-family font) (font-size font)))
-
(define (text font string)
(dispatch `(fontify ,font ,(tagify "tspan" (string->entities font string)))))
ly:find-glyph-by-name
ly:font-design-size
ly:font-encoding-alist
- ly:font-filename
+ ly:font-file-name
ly:font-magnification
ly:font-metric?
ly:font-name
projects / lilypond.git / commitdiff