From 9a063561c02da3e8af52f30725559e20d77b7197 Mon Sep 17 00:00:00 2001 From: fred Date: Wed, 27 Mar 2002 02:03:53 +0000 Subject: [PATCH] lilypond-1.5.19 --- .../bibliography/computer-notation.bib | 16 ++ flower/include/string.icc | 6 + flower/string.cc | 5 - lily/grob.cc | 51 ++-- lily/include/grob.hh | 18 +- scm/lily.scm | 2 +- scm/sketch.scm | 268 ++++++++++++++++++ 7 files changed, 319 insertions(+), 47 deletions(-) create mode 100644 scm/sketch.scm diff --git a/Documentation/bibliography/computer-notation.bib b/Documentation/bibliography/computer-notation.bib index 00a3e9cd8d..c5a2505371 100644 --- a/Documentation/bibliography/computer-notation.bib +++ b/Documentation/bibliography/computer-notation.bib @@ -655,3 +655,19 @@ general rules, similar to\cite{parrish87-simultaneities}}, note = {Placement of accidentals crystallised in an enormous set of rules. Same remarks as for \cite{grover89-twovoices} applies} } + +@TechReport{, + author = {Michael Droettboom}, + title = {Study of music Notation Description Languages}, + year = {2000}, + OPTkey = {}, + OPTvolume = {}, + OPTnumber = {}, + OPTpages = {}, + OPTmonth = {}, + OPTnote = {}, + OPTannote = {} +html= {http://gigue.peabody.jhu.edu/~mdboom/format.pdf} +annote ={Author compares GUIDO and lilypond. LilyPond wins on practical issues as usability and availability of tools, GUIDO wins on implementation simplicity.} +} + diff --git a/flower/include/string.icc b/flower/include/string.icc index f53586f5b5..8ce2211a79 100644 --- a/flower/include/string.icc +++ b/flower/include/string.icc @@ -30,6 +30,12 @@ String::String () { } +INLINE +String::String (char const* source) +{ + assert (source); + strh_ = source; +} #endif /* STRING_ICC */ diff --git a/flower/string.cc b/flower/string.cc index 8ee89d0c5f..4659807f0c 100644 --- a/flower/string.cc +++ b/flower/string.cc @@ -62,11 +62,6 @@ String::operator = (String const&source) return *this; } -String::String (char const* source) -{ - assert (source); - strh_ = source; -} String::String (Byte const* byte_l, int length_i) { diff --git a/lily/grob.cc b/lily/grob.cc index bd716106db..3f35eb86b8 100644 --- a/lily/grob.cc +++ b/lily/grob.cc @@ -122,14 +122,7 @@ Grob::~Grob () SCM -Grob::get_grob_property (const char *nm) const -{ - SCM sym = ly_symbol2scm (nm); - return get_grob_property (sym); -} - -SCM -Grob::get_grob_property (SCM sym) const +Grob::internal_get_grob_property (SCM sym) const { SCM s = scm_sloppy_assq (sym, mutable_property_alist_); if (s != SCM_BOOL_F) @@ -153,13 +146,8 @@ Grob::remove_grob_property (const char* key) return val; } -void -Grob::set_grob_property (const char* k, SCM v) -{ - SCM s = ly_symbol2scm (k); - set_grob_property (s, v); -} +#if 0 /* Puts the k, v in the immutable_property_alist_, which is convenient for storing variables that are needed during the breaking process. (eg. @@ -178,8 +166,11 @@ Grob::set_immutable_grob_property (SCM s, SCM v) immutable_property_alist_ = gh_cons (gh_cons (s,v), mutable_property_alist_); mutable_property_alist_ = scm_assq_remove_x (mutable_property_alist_, s); } +#endif + + void -Grob::set_grob_property (SCM s, SCM v) +Grob::internal_set_grob_property (SCM s, SCM v) { mutable_property_alist_ = scm_assq_set_x (mutable_property_alist_, s, v); } @@ -640,13 +631,6 @@ Grob::extent (Grob * refp, Axis a) const return ext; } - -Grob* -Grob::parent_l (Axis a) const -{ - return dim_cache_[a].parent_l_; -} - Grob * Grob::common_refpoint (Grob const* s, Axis a) const { @@ -786,15 +770,14 @@ Grob::mark_smob (SCM ses) { scm_gc_mark (s->dim_cache_[a].offset_callbacks_); scm_gc_mark (s->dim_cache_[a].dimension_); + Grob *p = s->parent_l (Y_AXIS); + if (p) + scm_gc_mark (p->self_scm ()); } - if (s->parent_l (Y_AXIS)) - scm_gc_mark (s->parent_l (Y_AXIS)->self_scm ()); - if (s->parent_l (X_AXIS)) - scm_gc_mark (s->parent_l (X_AXIS)->self_scm ()); - if (s->original_l_) scm_gc_mark (s->original_l_->self_scm ()); + return s->do_derived_mark (); } @@ -834,7 +817,7 @@ ly_set_grob_property (SCM elt, SCM sym, SCM val) if (sc) { - sc->set_grob_property (sym, val); + sc->internal_set_grob_property (sym, val); } else { @@ -853,7 +836,7 @@ ly_get_grob_property (SCM elt, SCM sym) if (sc) { - return sc->get_grob_property (sym); + return sc->internal_get_grob_property (sym); } else { @@ -879,12 +862,10 @@ spanner_get_bound (SCM slur, SCM dir) -static SCM interfaces_sym; + static void init_functions () { - interfaces_sym = scm_permanent_object (ly_symbol2scm ("interfaces")); - scm_c_define_gsubr ("ly-get-grob-property", 2, 0, 0, (Scheme_function_unknown)ly_get_grob_property); scm_c_define_gsubr ("ly-set-grob-property", 3, 0, 0, @@ -896,7 +877,7 @@ init_functions () bool Grob::has_interface (SCM k) { - SCM ifs = get_grob_property (interfaces_sym); + SCM ifs = get_grob_property ("interfaces"); return scm_memq (k, ifs) != SCM_BOOL_F; } @@ -908,8 +889,8 @@ Grob::set_interface (SCM k) return ; else { - set_grob_property (interfaces_sym, - gh_cons (k, get_grob_property (interfaces_sym))); + set_grob_property ("interfaces", + gh_cons (k, get_grob_property ("interfaces"))); } } diff --git a/lily/include/grob.hh b/lily/include/grob.hh index 0cabf6e0e1..e9665ea31b 100644 --- a/lily/include/grob.hh +++ b/lily/include/grob.hh @@ -28,6 +28,10 @@ enum Grob_status { typedef void (Grob::*Grob_method_pointer) (void); + +#define get_grob_property(x) internal_get_grob_property(ly_symbol2scm(x)) +#define set_grob_property(x,y) internal_set_grob_property(ly_symbol2scm(x),y) + /* Basic output object. */ @@ -62,12 +66,14 @@ public: /* properties */ - SCM get_grob_property (const char*) const; - SCM get_grob_property (SCM) const; - void set_grob_property (const char * , SCM val); + SCM internal_get_grob_property (SCM) const; + void internal_set_grob_property (SCM, SCM val); + +#if 0 void set_immutable_grob_property (const char * , SCM val); - void set_immutable_grob_property (SCM key, SCM val); - void set_grob_property (SCM , SCM val); + void set_immutable_grob_property (SCM key, SCM val); +#endif + void set_elt_pointer (const char*, SCM val); friend class Property_engraver; // UGHUGHUGH. SCM remove_grob_property (const char* nm); @@ -170,7 +176,7 @@ public: */ void set_parent (Grob* e, Axis); - Grob *parent_l (Axis a) const; + Grob *parent_l (Axis a) const { return dim_cache_[a].parent_l_; } DECLARE_SCHEME_CALLBACK (fixup_refpoint, (SCM)); }; diff --git a/scm/lily.scm b/scm/lily.scm index df53f375c2..c251e8fa2e 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -113,7 +113,7 @@ (map (lambda (x) (eval-string (ly-gulp-file x))) '("output-lib.scm" "tex.scm" - "ps.scm" + "ps.scm" "sketch.scm" "pdf.scm" "pdftex.scm" "ascii-script.scm" diff --git a/scm/sketch.scm b/scm/sketch.scm new file mode 100644 index 0000000000..ab2e8751ca --- /dev/null +++ b/scm/sketch.scm @@ -0,0 +1,268 @@ + + +;;; urg. +(define (sk-numbers->string l) + (string-append + (number->string (car l)) + (if (null? (cdr l)) + "" + (string-append "," (sk-numbers->string (cdr l))) + ) + ) + ) + + +(define (sketch-scm action-name) + (define global-x 0.0) + (define global-y 0.0) + (define output-scale 1.0) + (define (mul-scale x) (* output-scale x)) + + ;; alist containing fontname -> fontcommand assoc (both strings) + (define font-alist '()) + (define font-count 0) + (define current-font "") + + + (define (cached-fontname i) + (string-append + "lilyfont" + (make-string 1 (integer->char (+ 65 i))))) + + + (define (select-font name-mag-pair) + (let* + ( + (c (assoc name-mag-pair font-name-alist)) + ) + + (if (eq? c #f) + (begin + (display "FAILED\n") + (display (object-type (car name-mag-pair))) + (display (object-type (caaar font-name-alist))) + + (ly-warn (string-append + "Programming error: No such font known " + (car name-mag-pair) " " + (ly-number->string (cdr name-mag-pair)) + )) + + "") ; issue no command + "") +; (string-append " " (cddr c) " ")) + )) + + (define (font-load-command name-mag command) + "") + +; "Fn(" command ")" ) + + (define (beam width slope thick) + (string-append + (sk-numbers->string (list slope width thick)) " draw_beam" )) + + (define (comment s) + (string-append "% " s)) + + (define (bracket arch_angle arch_width arch_height height arch_thick thick) + (string-append + (numbers->string (list arch_angle arch_width arch_height height arch_thick thick)) " draw_bracket" )) + + (define (char i) + (invoke-char " show" i)) + + + (define (hairpin thick width starth endh ) + (string-append + (numbers->string (list width starth endh thick)) + " draw_hairpin")) + + ;; what the heck is this interface ? + (define (dashed-slur thick dash l) + (string-append + (apply string-append (map control->string l)) + (ly-number->string thick) + " [ " + (ly-number->string dash) + " " + (ly-number->string (* 10 thick)) ;UGH. 10 ? + " ] 0 draw_dashed_slur")) + + (define (dashed-line thick on off dx dy) + (string-append + (ly-number->string dx) + " " + (ly-number->string dy) + " " + (ly-number->string thick) + " [ " + (ly-number->string on) + " " + (ly-number->string off) + " ] 0 draw_dashed_line")) + + (define (repeat-slash wid slope thick) + (string-append (numbers->string (list wid slope thick)) + " draw_repeat_slash")) + + (define (end-output) + "guidelayer('Guide Lines',1,0,0,1,(0,0,1)) +grid((0,0,20,20),0,(0,0,1),'Grid')\n") + + (define (experimental-on) "") + + ;; obsolete? + (define (font-def i s) + (string-append + "\n/" (font i) " {/" + (substring s 0 (- (string-length s) 4)) + " findfont 12 scalefont setfont} bind def \n")) + + (define (font-switch i) + "") +; (string-append (font i) " ")) + + (define (header-end) + (string-append "") + + ) + + (define (lily-def key val) + (if (equal? key "lilypondpaperoutputscale") + (set! output-scale (string->number val)) +) + "") + + + (define (header creator generate) + (string-append + "##Sketch 1 2 +document() +layout('A4',0) +layer('Layer 1',1,1,0,0,(0,0,0)) +")) + + (define (invoke-char s i) + "") + + (define (invoke-dim1 s d) + (string-append + (ly-number->string (* d (/ 72.27 72))) " " s )) + + (define (placebox x y s) + (set! global-x (+ x 0)) + (set! global-y (+ y 100)) + (eval s) + ) + + (define (bezier-sandwich l thick) + '(string-append + (apply string-append (map control->string l)) + (ly-number->string thick) + " draw_bezier_sandwich")) + +; TODO: use HEIGHT argument + (define (start-line height) + "G()\n" + ) + + (define (filledbox breapth width depth height) + `(string-append + "lw(1)\nr(" + (sk-numbers->string (quote ,(map mul-scale (list (+ breapth width) + 0 0 + (- (+ breapth depth)) + global-x + (+ global-y height))))) + ")\n") + ) + + (define (stem x y z w) (filledbox x y z w)) + + + (define (stop-line) + "G_()\n") + + (define (text s) + "") +; (string-append "(" s ") show ")) + + + (define (volta h w thick vert_start vert_end) + (string-append + (numbers->string (list h w thick (inexact->exact vert_start) (inexact->exact vert_end))) + " draw_volta")) + + (define (tuplet ht gap dx dy thick dir) + (string-append + (numbers->string (list ht gap dx dy thick (inexact->exact dir))) + " draw_tuplet")) + + + (define (unknown) + "\n unknown\n") + + (define (ez-ball ch letter-col ball-col) + (string-append + " (" ch ") " + (numbers->string (list letter-col ball-col)) + " /Helvetica-Bold " ;; ugh + " draw_ez_ball")) + + (define (define-origin a b c ) "") + (define (no-origin) "") + + ;; PS + (cond ((eq? action-name 'all-definitions) + `(begin + (define beam ,beam) + (define tuplet ,tuplet) + (define bracket ,bracket) + (define char ,char) + (define hairpin ,hairpin) + (define volta ,volta) + (define bezier-sandwich ,bezier-sandwich) + (define dashed-line ,dashed-line) + (define dashed-slur ,dashed-slur) + (define end-output ,end-output) + (define experimental-on ,experimental-on) + (define filledbox ,filledbox) + (define stem ,stem) + (define font-def ,font-def) + (define font-switch ,font-switch) + (define header-end ,header-end) + (define lily-def ,lily-def) + (define font-load-command ,font-load-command) + (define header ,header) + (define invoke-char ,invoke-char) + (define invoke-dim1 ,invoke-dim1) + (define placebox ,placebox) + (define select-font ,select-font) + (define start-line ,start-line) + (define stem ,stem) + (define stop-line ,stop-line) + (define stop-last-line ,stop-line) + (define repeat-slash ,repeat-slash) + (define text ,text) + (define no-origin ,no-origin) + (define define-origin ,define-origin) + (define ez-ball ,ez-ball) + )) + ((eq? action-name 'repeat-slash) repeat-slash) + ((eq? action-name 'tuplet) tuplet) + ((eq? action-name 'beam) beam) + ((eq? action-name 'bezier-sandwich) bezier-sandwich) + ((eq? action-name 'bracket) bracket) + ((eq? action-name 'char) char) + ((eq? action-name 'dashed-line) dashed-line) + ((eq? action-name 'dashed-slur) dashed-slur) + ((eq? action-name 'hairpin) hairpin) + ((eq? action-name 'experimental-on) experimental-on) + ((eq? action-name 'filledbox) filledbox) + ((eq? action-name 'ez-ball) ez-ball) + ((eq? action-name 'select-font) select-font) + ((eq? action-name 'volta) volta) + (else (error "unknown tag -- SKETCH-SCM " action-name)) + ) + ) -- 2.39.5