+2002-09-20 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+ * lily/ly-module.cc: new file.
+
2002-09-17 Rune Zedeler <rune@zedeler.dk>
* lily/accidental-engraver.cc: Also work with partial measures.
SCM ly_unique (SCM list);
-SCM ly_make_anonymous_module ();
-void ly_copy_module_variable (SCM dest, SCM src);
-SCM ly_module_to_alist (SCM mod);
/*
snarfing.
--- /dev/null
+/*
+ ly-modules.hh -- declare module related helper functions
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+ */
+
+#ifndef LY_MODULES_HH
+#define LY_MODULES_HH
+
+SCM ly_make_anonymous_module ();
+void ly_copy_module_variables (SCM dest, SCM src);
+SCM ly_module_to_alist (SCM mod);
+SCM ly_module_lookup (SCM module, SCM sym);
+SCM ly_module_symbols (SCM mod);
+void ly_reexport_module (SCM mod);
+
+#endif /* LY_MODULES_HH */
+
#include "source.hh"
#include "lily-version.hh"
#include "scm-hash.hh"
+#include "ly-modules.hh"
LY_DEFINE(ly_set_point_and_click_x, "set-point-and-click!", 1, 0, 0,
{
if (key_req_)
{
+
+ /*
+ UGH. primitive-eval.
+ */
SCM pitchlist = key_req_->get_mus_property ("pitch-alist");
SCM proc = scm_primitive_eval (ly_symbol2scm ("accidentals-in-key"));
SCM acc = gh_call1 (proc, pitchlist);
scm_init_funcs_->push (f);
}
-#if 0
-SCM
-ly_use_module (SCM module)
-{
- scm_call_1 (SCM_VARIABLE_REF (process_use_modules_var),
- scm_list_1 (scm_list_1 (convert_module_name (name))));
- return SCM_UNSPECIFIED;
-}
-#endif
-
void
ly_init_ly_module (void *data)
{
return gh_car(l);
}
-static int module_count;
-
-void
-ly_init_anonymous_module (void * data)
-{
- scm_c_use_module ("lily");
-}
-
-SCM
-ly_make_anonymous_module ()
-{
- String s = "*anonymous-ly-" + to_string (module_count++) + "*";
- SCM mod = scm_c_define_module (s.to_str0(), ly_init_anonymous_module, 0);
- scm_module_define (mod, ly_symbol2scm ("symbols-defined-here"), SCM_EOL);
- return mod;
-}
-
-void
-ly_copy_module_variable (SCM dest, SCM src)
-{
- SCM defd = ly_symbol2scm ("symbols-defined-here");
- SCM dvar = scm_module_lookup (src, ly_symbol2scm ("symbols-defined-here"));
- SCM lst = scm_variable_ref (dvar);
- for (SCM s =lst; gh_pair_p (s); s = gh_cdr (s))
- {
- SCM var = scm_module_lookup (src, gh_car (s));
- scm_module_define (dest, gh_car (s),
- scm_variable_ref (var));
- }
-
- scm_module_define (dest, defd, lst);
-}
-
-SCM
-ly_module_to_alist (SCM mod)
-{
- SCM defd = ly_symbol2scm ("symbols-defined-here");
- SCM dvar = scm_module_lookup (mod, defd);
- SCM lst = scm_variable_ref (dvar);
-
- SCM alist = SCM_EOL;
- for (SCM s =lst; gh_pair_p (s); s = gh_cdr (s))
- {
- SCM var = scm_module_lookup (mod, gh_car (s));
- alist= scm_cons (scm_cons (gh_car(s), scm_variable_ref (var)), alist);
- }
- return alist;
-}
--- /dev/null
+/*
+ly-module.cc -- implement guile module stuff.
+
+source file of the GNU LilyPond music typesetter
+
+(c) 2002 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+ */
+
+#include "string.hh"
+#include "lily-guile.hh"
+#include "ly-modules.hh"
+
+static int module_count;
+
+void
+ly_init_anonymous_module (void * data)
+{
+ scm_c_use_module ("lily");
+}
+
+SCM
+ly_make_anonymous_module ()
+{
+ String s = "*anonymous-ly-" + to_string (module_count++) + "*";
+ SCM mod = scm_c_define_module (s.to_str0(), ly_init_anonymous_module, 0);
+ return mod;
+}
+
+void
+ly_copy_module_variables (SCM dest, SCM src)
+{
+ SCM obarr= SCM_MODULE_OBARRAY(src);
+ SCM syms = SCM_EOL;
+
+ for (int i = 0; i < SCM_VECTOR_LENGTH (obarr); i++)
+ {
+ for( SCM s = scm_vector_ref(obarr, SCM_MAKINUM (i));
+ gh_pair_p (s); s = gh_cdr (s))
+ {
+ scm_module_define (dest, gh_caar (s), scm_variable_ref (gh_cdar(s)));
+ }
+ }
+}
+
+SCM
+ly_module_symbols (SCM mod)
+{
+ SCM obarr= SCM_MODULE_OBARRAY(mod);
+ SCM syms = SCM_EOL;
+
+ for (int i = 0; i < SCM_VECTOR_LENGTH (obarr); i++)
+ {
+ for( SCM s = scm_vector_ref(obarr, SCM_MAKINUM (i));
+ gh_pair_p (s); s = gh_cdr (s))
+ {
+ syms = scm_cons (gh_caar (s), syms);
+ }
+ }
+ return syms;
+}
+
+
+
+SCM
+ly_module_to_alist (SCM mod)
+{
+ SCM obarr= SCM_MODULE_OBARRAY(mod);
+ SCM alist = SCM_EOL;
+
+ for (int i = 0; i < SCM_VECTOR_LENGTH (obarr); i++)
+ {
+ for( SCM s = scm_vector_ref(obarr, SCM_MAKINUM (i));
+ gh_pair_p (s); s = gh_cdr (s))
+ {
+ alist = scm_acons (gh_caar (s), scm_variable_ref (gh_cdar (s)),
+ alist);
+ }
+ }
+ return alist;
+}
+
+/*
+ Lookup SYM, but don't give error when it is not defined.
+ */
+SCM
+ly_module_lookup (SCM module, SCM sym)
+{
+ SCM var;
+#define FUNC_NAME __FUNCTION__
+ SCM_VALIDATE_MODULE (1, module);
+
+ var = scm_sym2var (sym, scm_module_lookup_closure (module), SCM_BOOL_F);
+ return var;
+}
+
+SCM export_function ;
+
+void
+ly_export (SCM module, SCM namelist)
+{
+ if (!export_function)
+ {
+ export_function = scm_permanent_object (scm_c_lookup ("module-export!"));
+ }
+
+ scm_call_2 (SCM_VARIABLE_REF (export_function),
+ module, namelist);
+}
+
+void
+ly_reexport_module (SCM mod)
+{
+ ly_export (mod, ly_module_symbols (mod));
+}
{
Byte program_byte = 0;
bool found = false;
+
+ /*
+ UGH. don't use eval.
+ */
SCM proc = scm_primitive_eval (ly_symbol2scm ("midi-program"));
SCM program = gh_call1 (proc, ly_symbol2scm (audio_->str_.to_str0 ()));
found = (program != SCM_BOOL_F);
#include "main.hh"
#include "file-path.hh"
#include "lily-guile.hh"
+#include "ly-modules.hh"
#include "ly-smobs.icc"
scaled_fonts_ = scm_list_copy (s.scaled_fonts_);
scope_= ly_make_anonymous_module ();
- ly_copy_module_variable (scope_, s.scope_);
-
+ ly_copy_module_variables (scope_, s.scope_);
}
Music_output_def::set_variable (SCM sym, SCM val)
{
scm_module_define (scope_, sym, val);
-
- SCM var = scm_module_lookup (scope_, ly_symbol2scm ("symbols-defined-here"));
- scm_variable_set_x (var, gh_cons (sym, scm_variable_ref (var)));
}
SCM
Music_output_def::lookup_variable (SCM sym) const
{
- SCM var = scm_module_lookup (scope_, sym);
+ SCM var = ly_module_lookup (scope_, sym);
return scm_variable_ref (var);
}
#include "main.hh"
#include "input.hh"
#include "moment.hh"
+#include "ly-modules.hh"
+
static Keyword_ent the_key_tab[]={
{"alias", ALIAS},
void
My_lily_lexer::add_scope (SCM module)
{
+ ly_reexport_module (scm_current_module());
scm_set_current_module (module);
for (SCM s = scopes_; gh_pair_p (s); s = gh_cdr (s))
{
+ /*
+ UGH. how to do this more neatly?
+ */
SCM expr = scm_list_n (ly_symbol2scm ("module-use!"),
module, scm_list_n (ly_symbol2scm ("module-public-interface"),
gh_car (s), SCM_UNDEFINED),
}
scopes_ = scm_cons (module, scopes_);
- scm_display (scm_current_module(), scm_current_output_port());
}
SCM
{
SCM sym = ly_symbol2scm (s.to_str0());
for (SCM s = scopes_; gh_pair_p (s); s = gh_cdr (s))
- {
- SCM var = scm_module_lookup (gh_car (s), sym);
- return scm_variable_ref (var);
- }
+ {
+ SCM var = ly_module_lookup (gh_car (s), sym);
+ if (var != SCM_BOOL_F)
+ return scm_variable_ref(var);
+ }
return SCM_UNSPECIFIED;
}
SCM sym = scm_string_to_symbol (name);
SCM mod = gh_car (scopes_);
- SCM var = scm_module_lookup (mod, ly_symbol2scm ("symbols-defined-here"));
- scm_variable_set_x (var, gh_cons (sym, scm_variable_ref (var)));
scm_module_define (mod, sym, s);
- scm_c_export (ly_symbol2string(sym).to_str0(), NULL);
}
My_lily_lexer::~My_lily_lexer ()
return Molecule();
}
- /*
- ugh: use gh_call () / scm_apply ().
-
- UGH: use grob-property.
- */
SCM log = gh_int2scm (Note_head::get_balltype (me));
- SCM exp = scm_list_n (ly_symbol2scm ("find-notehead-symbol"), log,
- ly_quote_scm (style),
- SCM_UNDEFINED);
- SCM scm_font_char = scm_primitive_eval (exp);
+ SCM proc = me->get_grob_property ("glyph-name-procedure");
+ SCM scm_font_char = scm_call_2 (proc, log, style);
String font_char = "noteheads-" + ly_scm2string (scm_font_char);
Font_metric * fm = Font_interface::get_default_font (me);
#include "scm-hash.hh"
#include "input-file-results.hh" // urg? header_global
#include "paper-outputter.hh"
+#include "ly-modules.hh"
+
/*
This is an almost empty thing. The only substantial thing this class
}
else
{
- SCM var = scm_module_lookup (scope_, ly_symbol2scm ("outputscale"));
+ SCM var = ly_module_lookup (scope_, ly_symbol2scm ("outputscale"));
m /= gh_scm2double (scm_variable_ref (var));
f = all_fonts_global->find_font (ly_scm2string (fn));
#include "lily-version.hh"
#include "paper-def.hh"
#include "input-file-results.hh"
+#include "ly-modules.hh"
+
/*
void
Paper_outputter::output_scope (SCM mod, String prefix)
{
+ if (!SCM_MODULEP (mod))
+ return ;
+
SCM al = ly_module_to_alist (mod);
for (SCM s = al ; gh_pair_p (s); s = ly_cdr (s))
{
#include "auto-change-iterator.hh"
#include "un-relativable-music.hh"
#include "chord.hh"
+#include "ly-modules.hh"
bool
regular_identifier_b (SCM id)
#include "cpu-timer.hh"
#include "main.hh"
#include "paper-def.hh"
+#include "ly-modules.hh"
+
/*
defs_.push (s.defs_[i]->clone ());
errorlevel_ = s.errorlevel_;
header_ = ly_make_anonymous_module ();
- ly_copy_module_variable (header_, s.header_);
+ ly_copy_module_variables (header_, s.header_);
}
Score::~Score ()
void
Staff_performer::stop_translation_timestep ()
{
- SCM proc = scm_primitive_eval (ly_symbol2scm ("percussion-p"));
+ /*
+ UGH. -> don't use eval.
+ */
+
+ SCM proc = scm_primitive_eval (ly_symbol2scm ("percussion?"));
SCM drums = gh_call1 (proc, ly_symbol2scm (instrument_string_.to_str0 ()));
audio_staff_->channel_ = (drums == SCM_BOOL_T ? 9 : -1 );
if (name_)
% Toplevel initialisation file.
-#(use-modules (lily))
+
+#(define-public point-and-click #f)
+#(define-public midi-debug #f)
\version "1.5.68"
linewidth = \hsize - 2.\cm
% Leave the textheight calculation to the geometry package. /MB
%textheight = \vsize - 4.\cm
-
+raggedright = ##f
indent = \linewidth / 14.0
;;; Note: this file can't be used without LilyPond executable
-(define (number-pair? x)
+(define-public (number-pair? x)
(and (pair? x)
(number? (car x)) (number? (cdr x))))
-(define (number-or-grob? x)
+(define-public (number-or-grob? x)
(or (ly-grob? x) (number? x))
)
-(define (grob-list? x)
+(define-public (grob-list? x)
(list? x))
-(define (moment-pair? x)
+(define-public (moment-pair? x)
(and (pair? x)
(moment? (car x)) (moment? (cdr x))))
-(define (boolean-or-symbol? x)
+(define-public (boolean-or-symbol? x)
(or (boolean? x) (symbol? x)))
-(define (number-or-string? x)
+(define-public (number-or-string? x)
(or (number? x) (string? x)))
-(define (markup? x)
+(define-public (markup? x)
(or (string? x) (list? x)))
-(define (scheme? x) #t)
+(define-public (scheme? x) #t)
(define type-p-name-alist
`(
; Make a function that checks score element for being of a specific type.
-(define (make-type-checker symbol)
+(define-public (make-type-checker symbol)
(lambda (elt)
;;(display symbol)
;;(eq? #t (ly-get-grob-property elt symbol))
(cdr cell)
(car cell)))
-(define (repeat-name-to-ctor name)
+(define-public (repeat-name-to-ctor name)
(let*
((supported-reps
`(("volta" . ((iterator-ctor . ,Volta_repeat_iterator::constructor)
)
)
-(define (clef-name-to-properties cl)
+(define-public (clef-name-to-properties cl)
(let ((e '())
(c0 0)
(oct 0)
paper20-style-sheet-alist))
font-list-alist)))
-(define (make-style-sheet sym)
+(define-public (make-style-sheet sym)
`((fonts . ,(append paper-style-sheet-alist
(cdr (assoc sym font-list-alist))))
(font-defaults
. (
(style . default)
(molecule-callback . ,Note_head::brew_molecule)
+ (glyph-name-procedure . ,find-notehead-symbol)
(Y-offset-callbacks . (,Staff_symbol_referencer::callback))
(stem-attachment-function . ,note-head-style->attachment-coordinates)
(meta . ((interfaces . (rhythmic-head-interface font-interface note-head-interface staff-symbol-referencer-interface item-interface ))))
(grob-property-description 'glyph string? "a string determining what (style) of glyph is typeset. Valid choices depend on the function that is reading this property. .")
(grob-property-description 'glyph-name string? "a name of character within font.")
+(grob-property-description 'glyph-name-procedure procedure? "Return
+name of character within font.")
(grob-property-description 'gap number? "Size of a gap in a variable symbol.")
(use-modules (ice-9 regex))
; (use-modules (lily))
-(display "hallo\n")
+;;(display "hallo\n")
;;(display (make-duration 1 2))
;;(write standalone (current-error-port))
;;; General settings
;; debugging evaluator is slower.
-;(debug-enable 'debug)
+(debug-enable 'debug)
;(debug-enable 'backtrace)
-;(read-enable 'positions)
+(read-enable 'positions)
-
-(define point-and-click #f)
-(define security-paranoia #f)
-(define midi-debug #f)
+(define-public security-paranoia #f)
(define (line-column-location line col file)
"Print an input location, including column number ."
(define ifndef "First run this through cpp.")
(define-public default-script-alist '())
-(define font-name-alist '())
(if (not (defined? 'standalone))
(define standalone (not (defined? 'ly-gulp-file))))
;; The regex module may not be available, or may be broken.
-(define use-regex
+(define-public use-regex
(let ((os (string-downcase (vector-ref (uname) 0))))
(not (equal? "cygwin" (substring os 0 (min 6 (string-length os)))))))
-;; If you have trouble with regex, define #f
-(define use-regex #t)
-;;(define use-regex #f)
;;; Un-assorted stuff
output-alist)
))
-(define (find-dumper format )
+(define-public (find-dumper format )
(let*
((d (assoc format output-alist)))
)
absolute-volume-alist))
-(define (default-dynamic-absolute-volume s)
+(define-public (default-dynamic-absolute-volume s)
(let ((entry (assoc s absolute-volume-alist)))
(if entry
(cdr entry))))
)
-(define (default-instrument-equalizer s)
+(define-public (default-instrument-equalizer s)
(let ((entry (assoc s instrument-equalizer-alist)))
(if entry
(cdr entry))))
-;; returns whether the instrument should use midi channel 9
-(define (percussion-p instrument)
+
+(define-public (percussion? instrument)
+ "
+returns whether the instrument should use midi channel 9
+"
(let* ((inst (symbol->string instrument))
(entry (assoc inst instrument-names-alist))
)
(and entry (>= (cdr entry) 32768))
)
)
-
-;; returns the program of the instrument
-(define (midi-program instrument)
+(define-public (midi-program instrument)
+"
+returns the program of the instrument
+"
(let* ((inst (symbol->string instrument))
(entry (assoc inst instrument-names-alist))
)
;; 90 == 90/127 == 0.71 is supposed to be the default value
;; urg: we should set this at start of track
-(define dynamic-default-volume 0.71)
+(define-public dynamic-default-volume 0.71)
-;; Count number of sharps minus number of flats
-(define (accidentals-in-key pitch-list)
+(define-public (accidentals-in-key pitch-list)
+ "Count number of sharps minus number of flats"
(apply + (map cdr pitch-list)))
-;; Characterise the key as major if the alteration of the
-;; third scale note is the same as that of the main note.
-;; Note: MIDI cannot handle other tonalities than major/minor.
-(define (major-key pitch-list)
+(define-public (major-key pitch-list)
+ "Characterise the key as major if the alteration of the
+third scale note is the same as that of the main note.
+Note: MIDI cannot handle other tonalities than major/minor.
+"
;; This charactersition is only true for a scale that starts at `c'.
(if (not (equal? (car pitch-list) '(0 . 0)))
(begin
;;;;;;;;;;;;;;;;
-(define (make-grob-property-set grob gprop val)
+(define-public (make-grob-property-set grob gprop val)
"Make a M-exp that sets GPROP to VAL in GROBS. Does a pop first, i.e.
this is not an override
"
m
))
-
-(define (make-grob-property-revert grob gprop)
+
+
+(define-public (make-grob-property-revert grob gprop)
"Revert the grob property GPROP for GROB."
(let* ((m (ly-make-music "Music")))
(ly-set-mus-property! m 'iterator-ctor Pop_property_iterator::constructor)
))
-(define (make-voice-props-set n)
+(define-public (make-voice-props-set n)
(make-sequential-music
(append
(map (lambda (x) (make-grob-property-set x 'direction
)
))
-(define (make-voice-props-revert)
+(define-public (make-voice-props-revert)
(make-sequential-music
(list
(make-grob-property-revert 'Tie 'direction)
))
)
-(define (context-spec-music m context . rest)
+(define-public (context-spec-music m context . rest)
"Add \context CONTEXT = foo to M. "
(let* ((cm (ly-make-music "Context_specced_music")))
cm
))
-(define (make-sequential-music elts)
+(define-public (make-sequential-music elts)
(let* ((m (ly-make-music "Sequential_music")))
(ly-set-mus-property! m 'elements elts)
m
))
-(define (make-simultaneous-music elts)
+(define-public (make-simultaneous-music elts)
(let* ((m (ly-make-music "Simultaneous_music")))
(ly-set-mus-property! m 'elements elts)
m
))
-(define (music-separator? m)
+(define-public (music-separator? m)
"Is M a separator."
(let* ((n (ly-get-mus-property m 'name )))
(and (symbol? n) (equal? 'separator n))
m
)
-(define toplevel-music-functions
+(define-public toplevel-music-functions
(list check-start-chords
voicify-music
;; do nothing in .scm output
(define (comment s) "")
-(define (numbers->string l)
+(define-public (numbers->string l)
(apply string-append (map ly-number->string l)))
; (define (chop-decimal x) (if (< (abs x) 0.001) 0.0 x))
(number->string n8)
(number->string (remainder (- n (+ (* n64 64) (* n8 8))) 8)))))
-(define (inexact->string x radix)
+(define-public (inexact->string x radix)
(let ((n (inexact->exact x)))
(number->string n radix)))
-(define (control->string c)
+(define-public (number-pair->string c)
(string-append (number->string (car c)) " "
(number->string (cdr c)) " "))
;; silly, use alist?
-(define (find-notehead-symbol duration style)
+(define-public (find-notehead-symbol duration style)
(case style
((xcircle) "2xcircle")
((harmonic) "0neo_mensural")
'(1.0 . 0.0)
)))
-(define (string-encode-integer i)
+(define-public (string-encode-integer i)
(cond
((= i 0) "o")
((< i 0) (string-append "n" (string-encode-integer (- i))))
(define currentpoint (cons 0 0))
(define (showcp)
- (string-append (control->string currentpoint) " "))
+ (string-append (number-pair->string currentpoint) " "))
(define (moveto x y)
(set! currentpoint (cons x y))
(string-append (showcp) "m "))
(ice-9 string-fun)
)
+
+(define font-name-alist '())
+
(define this-module (current-module))
(define (unknown)
"%\n\\unknown%\n")
(define-module (scm ps)
)
+(define font-name-alist '())
+
(define this-module (current-module))
(debug-enable 'backtrace)
(use-modules
(guile)
+ (lily)
)
;; what the heck is this interface ?
(define (dashed-slur thick dash l)
(string-append
- (apply string-append (map control->string l))
+ (apply string-append (map number-pair->string l))
(ly-number->string thick)
" [ "
(ly-number->string dash)
;; two beziers
(define (bezier-sandwich l thick)
(string-append
- (apply string-append (map control->string l))
+ (apply string-append (map number-pair->string l))
(ly-number->string thick)
" draw_bezier_sandwich "))
;; two beziers with round endings
(define (bezier-bow l thick)
(string-append
- (apply string-append (map control->string l))
+ (apply string-append (map number-pair->string l))
(ly-number->string thick)
" draw_bezier_sandwich "
(bezier-ending (list-ref l 3) (list-ref l 0) (list-ref l 5))
;; what the heck is this interface ?
(define (dashed-slur thick dash l)
(string-append
- (apply string-append (map control->string l))
+ (apply string-append (map number-pair->string l))
(ly-number->string thick)
" [ "
(ly-number->string dash)
(ice-9 string-fun)
(ice-9 format)
(guile)
+ (lily)
)
(define this-module (current-module))
;;;;;;;;
;;;;;;;; DOCUMENT ME!
-;;;;;;;;
+;;;;;;;;
+
+(define font-name-alist '())
+
(define (tex-encoded-fontswitch name-mag)
(let* ((iname-mag (car name-mag))
(ename-mag (cdr name-mag)))
projects / lilypond.git / commitdiff