July 2005 - fomus-cvs@common-lisp.net - mailman3.common-lisp.net

[fomus-cvs] CVS update: fomus/doc/fomus.html fomus/doc/fomus.xml fomus/doc/objects.xml fomus/doc/settings.xml
by dpsenicka＠common-lisp.net 21 Jul '05

21 Jul '05

Update of /project/fomus/cvsroot/fomus/doc In directory common-lisp.net:/tmp/cvs-serv23246/doc Modified Files: fomus.xml objects.xml settings.xml Added Files: fomus.html Log Message: Testing and bug fixes Date: Thu Jul 21 17:38:46 2005 Author: dpsenicka Index: fomus/doc/fomus.xml diff -u fomus/doc/fomus.xml:1.1.1.1 fomus/doc/fomus.xml:1.2 --- fomus/doc/fomus.xml:1.1.1.1 Tue Jul 19 20:17:05 2005 +++ fomus/doc/fomus.xml Thu Jul 21 17:38:46 2005 @@ -14,8 +14,8 @@ <bookinfo> <title>FOMUS Documentation</title> - <releaseinfo>Version 0.1.0</releaseinfo> - <date>7/19/2005</date> + <releaseinfo>Version 0.1.1</releaseinfo> + <date>7/21/2005</date> <author> <firstname>David</firstname> <surname>Psenicka</surname> @@ -23,7 +23,7 @@ </author> <legalnotice> <para>Copyright © 2005 David Psenicka, All Rights Reserved</para> - <para>See file "COPYING" for terms of use and distribution</para> + <para>See file "COPYING" for terms of use and distribution.</para> </legalnotice> </bookinfo> Index: fomus/doc/objects.xml diff -u fomus/doc/objects.xml:1.2 fomus/doc/objects.xml:1.3 --- fomus/doc/objects.xml:1.2 Wed Jul 20 06:50:01 2005 +++ fomus/doc/objects.xml Thu Jul 21 17:38:46 2005 @@ -673,7 +673,7 @@ If a number is used, 60 represents middle C, as in a MIDI file. Numbers are rounded depending on the whether semitones or quartertones are specified (see the - <varname><link linkend="auto.accs.fun">AUTO-ACCS-FUN</link></varname> setting). + <varname><link linkend="quartertones">QUARTERTONES</link></varname> setting). Symbols are assembled by concatenating a note letter name (<literal>A</literal> through <literal>G</literal>), a <literal>+</literal> or <literal>S</literal> for sharp or a <literal>-</literal> or <literal>F</literal> for flat, and an @@ -934,13 +934,6 @@ <classname><link linkend="class.rest">REST</link></classname> objects. </para> - <para> - A final important thing to note is that mark offsets aren't quantized. - - Since note and rest offsets may shift slightly, it might be helpful to alter mark offsets by some amount to insure they are distributed - as expected. - </para> - <para>Constructor: <function>(MAKE-MARK &key :ID <userinput>id</userinput> Index: fomus/doc/settings.xml diff -u fomus/doc/settings.xml:1.2 fomus/doc/settings.xml:1.3 --- fomus/doc/settings.xml:1.2 Wed Jul 20 06:50:01 2005 +++ fomus/doc/settings.xml Thu Jul 21 17:38:46 2005 @@ -169,6 +169,8 @@ <section> <title>Accidentals</title> <simplelist type="horiz" columns="3"> + <member><varname><link linkend="quartertones">:QUARTERTONES</link></varname></member> + <member><varname><link linkend="acc.throughout.meas">:ACC-THROUGHOUT-MEAS</link></varname></member> <member><varname><link linkend="acc.use.double">:ACC-USE-DOUBLE</link></varname></member> @@ -474,7 +476,7 @@ <para> Designates which function is to be used for determining note spellings. - Current possible values are <literal>:DEFAULT</literal>, <literal>:NOKEY1</literal> and <literal>:NOKEY-QTONES1</literal>. + Current possible values are <literal>:DEFAULT</literal> and <literal>:NOKEY1</literal>. <literal>:DEFAULT</literal> is equivalent to <literal>:NOKEY1</literal>. </para> @@ -628,8 +630,6 @@ Floating point numbers are treated with the <function>RATIONALIZE</function> function in this case (this isn't recommended). If offsets and durations of events aren't "notatable" then <application>FOMUS</application> will complain with an error. - - Note that mark objects aren't quantized (see class <classname><link linkend="class.mark">MARK</link></classname> for details). </para> </listitem> </varlistentry> @@ -1462,6 +1462,21 @@ grace notes so that they don't exceed the durations of the notes they precede. This only applies to grace notes that are automatically generated by the quantizing algorithm. + </para> + </listitem> + </varlistentry> + + <varlistentry> + <term><varname><anchor id="quartertones"/>:QUARTERTONES</varname></term> + <listitem> + <para> + If set to <literal>T</literal>, <application>FOMUS</application> rounds pitches to quartertone values + and uses quartertone notation in the score. + + This only works if the algorithm specified by the <varname><link linkend="auto.accs.fun">AUTO-ACCS-FUN</link></varname> setting + supports it. + + Currently, <literal>:NOKEY1</literal> supports quartertones. </para> </listitem> </varlistentry>

1 0

[fomus-cvs] CVS update: fomus/README fomus/TODO fomus/accidentals.lisp fomus/backend_ly.lisp fomus/classes.lisp fomus/data.lisp fomus/final.lisp fomus/load.lisp fomus/main.lisp fomus/marks.lisp fomus/package.lisp fomus/quantize.lisp fomus/util.lisp
by dpsenicka＠common-lisp.net 21 Jul '05

21 Jul '05

Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv23246 Modified Files: TODO accidentals.lisp backend_ly.lisp classes.lisp data.lisp final.lisp load.lisp main.lisp marks.lisp package.lisp quantize.lisp util.lisp Added Files: README Log Message: Testing and bug fixes Date: Thu Jul 21 17:38:43 2005 Author: dpsenicka Index: fomus/TODO diff -u fomus/TODO:1.1.1.1 fomus/TODO:1.2 --- fomus/TODO:1.1.1.1 Tue Jul 19 20:17:01 2005 +++ fomus/TODO Thu Jul 21 17:38:42 2005 @@ -15,6 +15,7 @@ MIDI backend Profile and optimize code for speed Reorganize code, update comments +Reorganize settings MIDI input interface Index: fomus/accidentals.lisp diff -u fomus/accidentals.lisp:1.1.1.1 fomus/accidentals.lisp:1.2 --- fomus/accidentals.lisp:1.1.1.1 Tue Jul 19 20:16:55 2005 +++ fomus/accidentals.lisp Thu Jul 21 17:38:42 2005 @@ -221,20 +221,21 @@ (setf (part-events e) (sort (nconc rs (case (auto-accs-fun) - (:nokey1 (acc-nokey evs (if *acc-use-double* '(-2 -1 0 1 2) '(-1 0 1)) - #'nokey-spell #'nokey-intscore (part-name e) #'identity)) - (:nokey-qtones1 (acc-nokey evs (if *acc-use-double* - '(-2 -1 0 1 2 (-1 . -1/2) (0 . -1/2) #|(1 . -1/2) (-1 . 1/2)|# (0 . 1/2) (1 . 1/2)) - '(-1 0 1 (-1 . -1/2) (0 . -1/2) #|(1 . -1/2) (-1 . 1/2)|# (0 . 1/2) (1 . 1/2))) - #'nokeyq-spell #'nokeyq-intscore (part-name e) - (lambda (x) (if (consp x) x (cons x 0))))) + (:nokey1 (if *quartertones* + (acc-nokey evs (if *acc-use-double* + '(-2 -1 0 1 2 (-1 . -1/2) (0 . -1/2) #|(1 . -1/2) (-1 . 1/2)|# (0 . 1/2) (1 . 1/2)) + '(-1 0 1 (-1 . -1/2) (0 . -1/2) #|(1 . -1/2) (-1 . 1/2)|# (0 . 1/2) (1 . 1/2))) + #'nokeyq-spell #'nokeyq-intscore (part-name e) + (lambda (x) (if (consp x) x (cons x 0)))) + (acc-nokey evs (if *acc-use-double* '(-2 -1 0 1 2) '(-1 0 1)) + #'nokey-spell #'nokey-intscore (part-name e) #'identity))) (otherwise (error "Unknown accidental assignment function ~A" *auto-accs-fun*)))) #'sort-offdur))))) (defmacro set-note-precision (&body forms) - `(let ((*note-precision* + `(let ((*note-precision* (case (auto-accs-fun) - (:nokey-qtones1 1/2) + (:nokey1 (if *quartertones* 1/2 1)) (otherwise 1)))) ,@forms)) @@ -299,7 +300,7 @@ #'sort-offdur))) (mapcar #'part-meas pa)))) (case (auto-accs-fun) ; m is list of measures (everything is sorted) - ((:nokey1 :nokey-qtones1) (acc-nokey-cautaccs ms)) + (:nokey1 (acc-nokey-cautaccs ms)) (otherwise (error "Unknown accidental assignment function ~A" *auto-accs-fun*)))))) (defun preproc-cautaccs (parts) @@ -349,7 +350,7 @@ (loop for m in (part-meas p) do (multiple-value-bind (evs rs) (split-list (meas-events m) #'notep) (case (auto-accs-fun) - ((:nokey1 :nokey-qtones1) (acc-nokey-postaccs evs)) + (:nokey1 (acc-nokey-postaccs evs)) (otherwise (error "Unknown accidental assignment function ~A" *auto-accs-fun*))) (setf (meas-events m) (sort (nconc rs evs) #'sort-offdur)))))) Index: fomus/backend_ly.lisp diff -u fomus/backend_ly.lisp:1.1.1.1 fomus/backend_ly.lisp:1.2 --- fomus/backend_ly.lisp:1.1.1.1 Tue Jul 19 20:17:00 2005 +++ fomus/backend_ly.lisp Thu Jul 21 17:38:42 2005 @@ -115,233 +115,232 @@ (defun save-lilypond (parts filename options view) (when (>= *verbose* 1) (out ";; Saving Lilypond file \"~A\"...~%" filename)) (with-open-file (f filename :direction :output :if-exists :supersede) - (let ((qu (= *note-precision* 1/2))) - (destructuring-bind (xxx &key filehead scorehead &allow-other-keys) options - (declare (ignore xxx)) - (format f "% ~A v~A.~A.~A~%~%" +title+ (first +version+) (second +version+) (third +version+)) - (loop for e in (if qu +lilypond-headq+ +lilypond-head+) do (format f "~A~%" e) finally (format f "~%")) ;; stuff at top - (when filehead (loop for e in filehead do (format f "~A~%" e) finally (format f "~%"))) ;; user header - (loop for e in +lilypond-defs+ do (format f "~A~%" e) finally (format f "~%")) ;; definitions - (let ((de 0) (nms nil)) - (flet ((lynote (wnum acc1 acc2 caut) - (if qu - (conc-strings - (svref +lilypond-num-note+ (mod wnum 12)) - (svref (svref +lilypond-num-accq+ (+ acc1 2)) (1+ (* acc2 2))) - (svref +lilypond-num-reg+ (1- (truncate wnum 12))) #|(when force "!")|# - (when caut "?")) - (conc-strings - (svref +lilypond-num-note+ (mod wnum 12)) - (svref +lilypond-num-acc+ (+ acc1 2)) - (svref +lilypond-num-reg+ (1- (truncate wnum 12))) #|(when force "!")|# - (when caut "?")))) - (lyname (p) - (incf de) - (conc-strings - (string-downcase - (conc-stringlist (loop for x across (part-name p) - when (alpha-char-p x) - collect (string x)))) - (string (code-char (+ 64 de))))) - (lyclef (c) - (ecase c (:treble "treble") (:alto "alto") (:tenor "tenor") (:bass "bass") (:percussion "percussion")))) - (loop - for p in parts - do (destructuring-bind (&key (lily-partname (lyname p)) - parthead ;; extra header information for part (list of strings) - &allow-other-keys) (part-opts p) - (let ((ns (instr-staves (part-instr p))) - (sa 1)) - (flet ((lystaff (s) - (if (/= s sa) - (format nil "\\change Staff = ~A " (code-char (+ 64 (setf sa s)))) - ""))) - (push lily-partname nms) - (format f "~A = {~%" lily-partname) - (when (part-name p) (format f " ~A~%" (format nil +lilypond-set-instrument+ (part-name p)))) - (when (part-abbrev p) (format f " ~A~%" (format nil +lilypond-set-instr+ (part-abbrev p)))) - (when (or (null *timesig-style*) (eq *timesig-style* :fraction)) - (if (> ns 1) - (loop for s from 1 to ns do - (format f " ~A~A~%" (lystaff s) +lilypond-set-timesig-style-frac+)) - (format f " ~A~%" +lilypond-set-timesig-style-frac+))) - (when (eq *tuplet-style* :ratio) (format f " ~A~%" +lilypond-set-tup-style-ratio+)) - (format f " \\autoBeamOff~%") - (if *acc-throughout-meas* - (format f " ~A~%" +lilypond-set-acc-style-default+) - (format f " ~A~%" +lilypond-set-acc-style-forget+)) + (destructuring-bind (xxx &key filehead scorehead &allow-other-keys) options + (declare (ignore xxx)) + (format f "% ~A v~A.~A.~A~%~%" +title+ (first +version+) (second +version+) (third +version+)) + (loop for e in (if *quartertones* +lilypond-headq+ +lilypond-head+) do (format f "~A~%" e) finally (format f "~%")) ;; stuff at top + (when filehead (loop for e in filehead do (format f "~A~%" e) finally (format f "~%"))) ;; user header + (loop for e in +lilypond-defs+ do (format f "~A~%" e) finally (format f "~%")) ;; definitions + (let ((de 0) (nms nil)) + (flet ((lynote (wnum acc1 acc2 caut) + (if *quartertones* + (conc-strings + (svref +lilypond-num-note+ (mod wnum 12)) + (svref (svref +lilypond-num-accq+ (+ acc1 2)) (1+ (* acc2 2))) + (svref +lilypond-num-reg+ (1- (truncate wnum 12))) #|(when force "!")|# + (when caut "?")) + (conc-strings + (svref +lilypond-num-note+ (mod wnum 12)) + (svref +lilypond-num-acc+ (+ acc1 2)) + (svref +lilypond-num-reg+ (1- (truncate wnum 12))) #|(when force "!")|# + (when caut "?")))) + (lyname (p) + (incf de) + (conc-strings + (string-downcase + (conc-stringlist (loop for x across (part-name p) + when (alpha-char-p x) + collect (string x)))) + (string (code-char (+ 64 de))))) + (lyclef (c) + (ecase c (:treble "treble") (:alto "alto") (:tenor "tenor") (:bass "bass") (:percussion "percussion")))) + (loop + for p in parts + do (destructuring-bind (&key (lily-partname (lyname p)) + parthead ;; extra header information for part (list of strings) + &allow-other-keys) (part-opts p) + (let ((ns (instr-staves (part-instr p))) + (sa 1)) + (flet ((lystaff (s) + (if (/= s sa) + (format nil "\\change Staff = ~A " (code-char (+ 64 (setf sa s)))) + ""))) + (push lily-partname nms) + (format f "~A = {~%" lily-partname) + (when (part-name p) (format f " ~A~%" (format nil +lilypond-set-instrument+ (part-name p)))) + (when (part-abbrev p) (format f " ~A~%" (format nil +lilypond-set-instr+ (part-abbrev p)))) + (when (or (null *timesig-style*) (eq *timesig-style* :fraction)) (if (> ns 1) - (loop for (xxx cl s) in (sort (getprops p :clef) #'< :key #'third) do - (format f " ~A\\clef ~A~%" (lystaff s) (lyclef cl))) - (format f " \\clef ~A~%" (lyclef (second (getprop p :clef))))) - (loop for e in parthead do (format f " ~A~%" e)) - (format f "~%") - (loop - for m in (part-meas p) and mn from 1 - for ts = (meas-timesig m) do - (when (getprop m :startsig) (format f " \\time ~A/~A~%" (timesig-num ts) (timesig-den ts))) - (multiple-value-bind (s1 s2 s3) - (if (list>1p (meas-events m)) - (values " << { " "} \\\\~% { " "} >> ~A| % ~A~%") - (values " " nil "~A| % ~A~%")) - (format f s1) - (loop for (ee een) on (meas-events m) ; ee = list of events - do (loop - for (pre e nxe) on (cons nil ee) while e - for fm = (getmark e :measrest) - for cl = (let ((c (getmark e :clef))) - (if (and c (null (fourth c))) (format nil "\\clef ~A " (lyclef (second c))) - "")) - and st = (let ((m (getmark e '(:staff :global)))) - (if (and m (null (fourth m))) (lystaff (third m)) "")) - and vo = (if (list>1p (meas-events m)) - (let ((m (getmark e '(:voice :ord1324)))) - (if m - (case (third m) - (1 "\\voiceOne ") (2 "\\voiceTwo ") (3 "\\voiceThree ") (4 "\\voiceFour ") (otherwise "\\oneVoice ")) - "")) - "") - and gr1 = (let ((g (event-grace e))) - (if g - (let ((g1 (getmark e :startgrace))) - (cond ((and g1 (getmark e :endgrace)) (if (< g 0) "\\acciaccatura " "\\appoggiatura ")) - (g1 (if (< g 0) "\\acciaccatura {" "\\appoggiatura {")))) - "")) - and gr2 = (if (and (event-grace e) (getmark e :endgrace) (not (getmark e :startgrace))) "}" "") - and ot1 = (cond ((or (getmark e :start8up-) (getmark e :8up)) "\\octUp ") - ((or (getmark e :start8down-) (getmark e :8down)) "\\octDown ")) - and ot2 = (cond ((or (getmark e :end8up-) (getmark e :8up)) " \\octReset") - ((or (getmark e :end8down-) (getmark e :8down)) " \\octReset")) - and ba = (if (notep e) - (if (chordp e) - (format nil "<~A>" (conc-stringlist - (loop - for (n nn) on (event-notes* e) - and w in (event-writtennotes e) - and a in (event-accs e) - and a2 in (event-addaccs e) - collect (lynote w a a2 (getmark e (list :cautacc n)) #|(getmark e (list :showacc n))|#) - when nn collect " "))) - (lynote (event-writtennote e) (event-acc e) (event-addacc e) - (getmark e (list :cautacc (event-note* e))) #|(getmark e (list :showacc n))|#)) - (if fm (if (event-inv e) "\\skip " "R") (if (event-inv e) "s" "r"))) - and du = (if fm (format nil "1*~A/~A" (timesig-num ts) (timesig-den ts)) - (multiple-value-bind (wd ds) (event-writtendur* e ts) - (let ((du (case wd - (2 "\\breve") - (4 "\\longa") - (otherwise (/ wd))))) - (ecase ds - (0 (format nil "~A" du)) - (1 (format nil "~A." du)) - (2 (format nil "~A.." du)))))) - and tu1 = (let ((uu (sort (getmarks e :starttup) #'< :key #'second))) - (conc-stringlist - (loop for u in uu for r = (third u) - collect (format nil "\\times ~A/~A {" (cdr r) (car r))))) ; tup is durmult - and tu2 = (let ((uu (getmarks e :endtup))) - (conc-stringlist - (loop repeat (length uu) collect "}"))) - and ti = (if (and (notep e) (or-list (force-list (event-tiert e)))) "\~" "") - and be1 = (if (and (notep e) (= (event-beamlt e) 0) (> (event-beamrt e) 0)) "[" "") - and be2 = (if (and (notep e) (> (event-beamlt e) 0) (= (event-beamrt e) 0)) "]" "") - and bnu = (let ((l (and (notep e) (notep pre) (> (min (event-nbeams e ts) (event-nbeams pre ts)) (event-beamlt e) 0))) - (r (and (notep e) (notep nxe) (> (min (event-nbeams e ts) (event-nbeams nxe ts)) (event-beamrt e) 0)))) - (cond ((and l r) (format nil "\\beamLR #~A #~A " (event-beamlt e) (event-beamrt e))) - (l (format nil "\\beamL #~A " (event-beamlt e))) - (r (format nil "\\beamR #~A " (event-beamrt e))) - (t ""))) - and ar = (conc-stringlist - (loop for i in - (sort (loop for a in +lilypond-marks+ nconc (getmarks e (car a))) - (lambda (x y) (let ((x2 (second x)) (y2 (second y))) - (cond ((and (numberp x2) (numberp y2)) (< x2 y2)) - (x2 t))))) - collect (lookup i +lilypond-marks+))) + (loop for s from 1 to ns do + (format f " ~A~A~%" (lystaff s) +lilypond-set-timesig-style-frac+)) + (format f " ~A~%" +lilypond-set-timesig-style-frac+))) + (when (eq *tuplet-style* :ratio) (format f " ~A~%" +lilypond-set-tup-style-ratio+)) + (format f " \\autoBeamOff~%") + (if *acc-throughout-meas* + (format f " ~A~%" +lilypond-set-acc-style-default+) + (format f " ~A~%" +lilypond-set-acc-style-forget+)) + (if (> ns 1) + (loop for (xxx cl s) in (sort (getprops p :clef) #'< :key #'third) do + (format f " ~A\\clef ~A~%" (lystaff s) (lyclef cl))) + (format f " \\clef ~A~%" (lyclef (second (getprop p :clef))))) + (loop for e in parthead do (format f " ~A~%" e)) + (format f "~%") + (loop + for m in (part-meas p) and mn from 1 + for ts = (meas-timesig m) do + (when (getprop m :startsig) (format f " \\time ~A/~A~%" (timesig-num ts) (timesig-den ts))) + (multiple-value-bind (s1 s2 s3) + (if (list>1p (meas-events m)) + (values " << { " "} \\\\~% { " "} >> ~A| % ~A~%") + (values " " nil "~A| % ~A~%")) + (format f s1) + (loop for (ee een) on (meas-events m) ; ee = list of events + do (loop + for (pre e nxe) on (cons nil ee) while e + for fm = (getmark e :measrest) + for cl = (let ((c (getmark e :clef))) + (if (and c (null (fourth c))) (format nil "\\clef ~A " (lyclef (second c))) + "")) + and st = (let ((m (getmark e '(:staff :global)))) + (if (and m (null (fourth m))) (lystaff (third m)) "")) + and vo = (if (list>1p (meas-events m)) + (let ((m (getmark e '(:voice :ord1324)))) + (if m + (case (third m) + (1 "\\voiceOne ") (2 "\\voiceTwo ") (3 "\\voiceThree ") (4 "\\voiceFour ") (otherwise "\\oneVoice ")) + "")) + "") + and gr1 = (let ((g (event-grace e))) + (if g + (let ((g1 (getmark e :startgrace))) + (cond ((and g1 (getmark e :endgrace)) (if (< g 0) "\\acciaccatura " "\\appoggiatura ")) + (g1 (if (< g 0) "\\acciaccatura {" "\\appoggiatura {")))) + "")) + and gr2 = (if (and (event-grace e) (getmark e :endgrace) (not (getmark e :startgrace))) "}" "") + and ot1 = (cond ((or (getmark e :start8up-) (getmark e :8up)) "\\octUp ") + ((or (getmark e :start8down-) (getmark e :8down)) "\\octDown ")) + and ot2 = (cond ((or (getmark e :end8up-) (getmark e :8up)) " \\octReset") + ((or (getmark e :end8down-) (getmark e :8down)) " \\octReset")) + and ba = (if (notep e) + (if (chordp e) + (format nil "<~A>" (conc-stringlist + (loop + for (n nn) on (event-notes* e) + and w in (event-writtennotes e) + and a in (event-accs e) + and a2 in (event-addaccs e) + collect (lynote w a a2 (getmark e (list :cautacc n)) #|(getmark e (list :showacc n))|#) + when nn collect " "))) + (lynote (event-writtennote e) (event-acc e) (event-addacc e) + (getmark e (list :cautacc (event-note* e))) #|(getmark e (list :showacc n))|#)) + (if fm (if (event-inv e) "\\skip " "R") (if (event-inv e) "s" "r"))) + and du = (if fm (format nil "1*~A/~A" (timesig-num ts) (timesig-den ts)) + (multiple-value-bind (wd ds) (event-writtendur* e ts) + (let ((du (case wd + (2 "\\breve") + (4 "\\longa") + (otherwise (/ wd))))) + (ecase ds + (0 (format nil "~A" du)) + (1 (format nil "~A." du)) + (2 (format nil "~A.." du)))))) + and tu1 = (let ((uu (sort (getmarks e :starttup) #'< :key #'second))) + (conc-stringlist + (loop for u in uu for r = (third u) + collect (format nil "\\times ~A/~A {" (cdr r) (car r))))) ; tup is durmult + and tu2 = (let ((uu (getmarks e :endtup))) + (conc-stringlist + (loop repeat (length uu) collect "}"))) + and ti = (if (and (notep e) (or-list (force-list (event-tiert e)))) "\~" "") + and be1 = (if (and (notep e) (= (event-beamlt e) 0) (> (event-beamrt e) 0)) "[" "") + and be2 = (if (and (notep e) (> (event-beamlt e) 0) (= (event-beamrt e) 0)) "]" "") + and bnu = (let ((l (and (notep e) (notep pre) (> (min (event-nbeams e ts) (event-nbeams pre ts)) (event-beamlt e) 0))) + (r (and (notep e) (notep nxe) (> (min (event-nbeams e ts) (event-nbeams nxe ts)) (event-beamrt e) 0)))) + (cond ((and l r) (format nil "\\beamLR #~A #~A " (event-beamlt e) (event-beamrt e))) + (l (format nil "\\beamL #~A " (event-beamlt e))) + (r (format nil "\\beamR #~A " (event-beamrt e))) + (t ""))) + and ar = (conc-stringlist + (loop for i in + (sort (loop for a in +lilypond-marks+ nconc (getmarks e (car a))) + (lambda (x y) (let ((x2 (second x)) (y2 (second y))) + (cond ((and (numberp x2) (numberp y2)) (< x2 y2)) + (x2 t))))) + collect (lookup i +lilypond-marks+))) ;and txt = ... - and we0 = (cond ((and (getmark e :startwedge<) (getmark e :endwedge-)) "\\< ") - ((and (getmark e :startwedge>) (getmark e :endwedge-)) "\\> ") - (t "")) - and we1 = (cond ((getmark e :endwedge-) "\\!") - ((getmark e :startwedge<) "\\<") - ((getmark e :startwedge>) "\\>") - (t "")) - and we2 = (cond ((and (getmark e :startwedge<) (not (getmark e :endwedge-))) "\\<") - ((and (getmark e :startwedge>) (not (getmark e :endwedge-))) "\\>") - (t "")) - and dyn = (conc-stringlist - (loop for i in - (sort (loop for a in +lilypond-dyns+ nconc (getmarks e (car a))) - (lambda (x y) (let ((x2 (second x)) (y2 (second y))) - (cond ((and (numberp x2) (numberp y2)) (< x2 y2)) - (x2 t))))) - collect (lookup i +lilypond-marks+))) - and s1 = (conc-stringlist - (loop - for xxx in (remove-if (lambda (x) (/= (third x) 1)) (getmarks e :startslur-)) - collect "(")) - and s2 = (conc-stringlist - (loop - for xxx in (remove-if (lambda (x) (/= (third x) 1)) (getmarks e :endslur-)) - collect ")")) - and sl1 = (conc-stringlist - (loop - for xxx in (remove-if (lambda (x) (/= (third x) 2)) (getmarks e :startslur-)) - collect "(")) - and sl2 = (conc-stringlist - (loop - for xxx in (remove-if (lambda (x) (/= (third x) 2)) (getmarks e :endslur-)) - collect ")")) - do (format f "~A " (conc-strings st vo cl ot1 tu1 gr1 we0 bnu ba du sl1 s1 s2 sl2 be1 be2 ti ar we1 dyn #|txt|# we2 gr2 tu2 ot2))) - when een do (format f s2)) - (format f s3 - (let ((x (getprop m :barline))) - (if x (format nil "\\bar \"~A\" " (lookup (second x) +lilypond-barlines+)) "")) - mn))) - (format f "}~%~%") - (if (> ns 1) - (format f "~A = {~% ~A~%}~%~%" - (conc-strings lily-partname "S") - (conc-stringlist - (loop with nu = 0 - for n = nil then (timesig-num (meas-timesig m)) - and d = nil then (timesig-den (meas-timesig m)) - for m in (part-meas p) - when (and (getprop m :startsig) (> nu 0)) - collect (format nil "\\skip 1*~A/~A*~A " n d nu) into re and do (setf nu 0) - do (incf nu) - finally (return (nconc re (list (format nil "\\skip 1*~A/~A*~A" n d nu)))))))))))) - (format f "\\score {~%") ;; score block - (loop for e in scorehead do (format f " ~A~%" e)) - (when (or *title* *subtitle* *composer*) - (format f " \\header {~%") - (when *title* (format f " title = \"~A\"~%" *title*)) - (when *subtitle* (format f " subtitle = \"~A\"~%" *subtitle*)) - (when *composer* (format f " composer = \"~A\"~%" *composer*)) - (format f " }~%")) - (loop - with in = 2 - for p in parts and nm in (nreverse nms) do - (loop - for (xxx nu ty) in (sort (getprops p :startgroup) #'< :key #'second) do - (if ty - (ecase ty - (:group (format f "~A\\new ~A <<~%" (make-string in :initial-element #\space) (if (<= nu 1) "StaffGroup" "InnerStaffGroup"))) - (:grandstaff (format f "~A\\new PianoStaff <<~%" (make-string in :initial-element #\space)))) - (format f "~A<<~%" (make-string in :initial-element #\space))) - (incf in 2)) - (let ((ns (instr-staves (part-instr p)))) - (if (<= ns 1) - (format f "~A\\new Staff \\~A~%" (make-string in :initial-element #\space) nm) - (progn - (loop for s from 1 to ns do (format f "~A\\context Staff = ~A \\~A~%" - (make-string in :initial-element #\space) - (code-char (+ 64 s)) - (conc-strings nm "S"))) - (format f "~A\\context Staff = A \\new Voice \\~A~%" (make-string in :initial-element #\space) nm)))) - (loop - for xxx in (getprops p :endgroup) - do (decf in 2) (format f "~A>>~%" (make-string in :initial-element #\space)))) - (format f "}~%")))))) + and we0 = (cond ((and (getmark e :startwedge<) (getmark e :endwedge-)) "\\< ") + ((and (getmark e :startwedge>) (getmark e :endwedge-)) "\\> ") + (t "")) + and we1 = (cond ((getmark e :endwedge-) "\\!") + ((getmark e :startwedge<) "\\<") + ((getmark e :startwedge>) "\\>") + (t "")) + and we2 = (cond ((and (getmark e :startwedge<) (not (getmark e :endwedge-))) "\\<") + ((and (getmark e :startwedge>) (not (getmark e :endwedge-))) "\\>") + (t "")) + and dyn = (conc-stringlist + (loop for i in + (sort (loop for a in +lilypond-dyns+ nconc (getmarks e (car a))) + (lambda (x y) (let ((x2 (second x)) (y2 (second y))) + (cond ((and (numberp x2) (numberp y2)) (< x2 y2)) + (x2 t))))) + collect (lookup i +lilypond-marks+))) + and s1 = (conc-stringlist + (loop + for xxx in (remove-if (lambda (x) (/= (third x) 1)) (getmarks e :startslur-)) + collect "(")) + and s2 = (conc-stringlist + (loop + for xxx in (remove-if (lambda (x) (/= (third x) 1)) (getmarks e :endslur-)) + collect ")")) + and sl1 = (conc-stringlist + (loop + for xxx in (remove-if (lambda (x) (/= (third x) 2)) (getmarks e :startslur-)) + collect "(")) + and sl2 = (conc-stringlist + (loop + for xxx in (remove-if (lambda (x) (/= (third x) 2)) (getmarks e :endslur-)) + collect ")")) + do (format f "~A " (conc-strings st vo cl ot1 tu1 gr1 we0 bnu ba du sl1 s1 s2 sl2 be1 be2 ti ar we1 dyn #|txt|# we2 gr2 tu2 ot2))) + when een do (format f s2)) + (format f s3 + (let ((x (getprop m :barline))) + (if x (format nil "\\bar \"~A\" " (lookup (second x) +lilypond-barlines+)) "")) + mn))) + (format f "}~%~%") + (if (> ns 1) + (format f "~A = {~% ~A~%}~%~%" + (conc-strings lily-partname "S") + (conc-stringlist + (loop with nu = 0 + for n = nil then (timesig-num (meas-timesig m)) + and d = nil then (timesig-den (meas-timesig m)) + for m in (part-meas p) + when (and (getprop m :startsig) (> nu 0)) + collect (format nil "\\skip 1*~A/~A*~A " n d nu) into re and do (setf nu 0) + do (incf nu) + finally (return (nconc re (list (format nil "\\skip 1*~A/~A*~A" n d nu)))))))))))) + (format f "\\score {~%") ;; score block + (loop for e in scorehead do (format f " ~A~%" e)) + (when (or *title* *subtitle* *composer*) + (format f " \\header {~%") + (when *title* (format f " title = \"~A\"~%" *title*)) + (when *subtitle* (format f " subtitle = \"~A\"~%" *subtitle*)) + (when *composer* (format f " composer = \"~A\"~%" *composer*)) + (format f " }~%")) + (loop + with in = 2 + for p in parts and nm in (nreverse nms) do + (loop + for (xxx nu ty) in (sort (getprops p :startgroup) #'< :key #'second) do + (if ty + (ecase ty + (:group (format f "~A\\new ~A <<~%" (make-string in :initial-element #\space) (if (<= nu 1) "StaffGroup" "InnerStaffGroup"))) + (:grandstaff (format f "~A\\new PianoStaff <<~%" (make-string in :initial-element #\space)))) + (format f "~A<<~%" (make-string in :initial-element #\space))) + (incf in 2)) + (let ((ns (instr-staves (part-instr p)))) + (if (<= ns 1) + (format f "~A\\new Staff \\~A~%" (make-string in :initial-element #\space) nm) + (progn + (loop for s from 1 to ns do (format f "~A\\context Staff = ~A \\~A~%" + (make-string in :initial-element #\space) + (code-char (+ 64 s)) + (conc-strings nm "S"))) + (format f "~A\\context Staff = A \\new Voice \\~A~%" (make-string in :initial-element #\space) nm)))) + (loop + for xxx in (getprops p :endgroup) + do (decf in 2) (format f "~A>>~%" (make-string in :initial-element #\space)))) + (format f "}~%"))))) (when view (view-lilypond filename options))) Index: fomus/classes.lisp diff -u fomus/classes.lisp:1.1.1.1 fomus/classes.lisp:1.2 --- fomus/classes.lisp:1.1.1.1 Tue Jul 19 20:16:58 2005 +++ fomus/classes.lisp Thu Jul 21 17:38:42 2005 @@ -287,7 +287,7 @@ (defparameter +timesig-repl-type+ '(class* timesig-repl - (time (check* (and* (list-of* (integer 1)) (length* = 2)) "Found ~A, expected list ((INTEGER 1) (INTEGER 1)) in TIME slot" t)) + (time (check* (and* (list* (integer 1) (integer 1))) "Found ~A, expected list ((INTEGER 1) (INTEGER 1)) in TIME slot" t)) (beat (check* (or null (rational (0))) "Found ~A, expected (RATIONAL (0)) in BEAT slot" t)) (div (check* (or* null (list-of* (rational (0))) (list-of-unique* (list-of* (rational (0))))) "Found ~A, expected list of (RATIONAL (0)) or ((RATIONAL (0)) ...) in DIV slot" t)) (comp (check* boolean) "Found ~A, expected BOOLEAN in COMP slot" t) @@ -344,10 +344,10 @@ (class* part (name (check* (or null string) "Found ~A, expected STRING in NAME slot" t)) (abbrev (check* (or null string) "Found ~A, expected STRING in ABBREV slot" t)) - (opts (check* key-arg-pairs* "Found ~A, expected KEYWORD/ARGUMENT PAIRS in OPTS slot" t)) + (opts (check* key-arg-pairs* "Found ~A, expected KEYWORD/ARGUMENT-PAIRS in OPTS slot" t)) (events (check* (or* null (list-of* (check* (or note rest mark timesig) "Found ~A, expected NOTE, REST or TIMESIG in list in EVENTS slot" t))) "Expected list of NOTE, REST or TIMESIG in EVENTS slot")) - (instr (check* (or symbol instr (cons symbol (key-arg-pairs* ,@+instr-keys+))) "Found ~A, expected SYMBOL, INSTR or (SYMBOL KEYWORD/ARGUMENT PAIRS) in INSTR slot" t)) + (instr (check* (or* symbol instr (cons* symbol (key-arg-pairs* ,@+instr-keys+))) "Found ~A, expected SYMBOL, INSTR or (SYMBOL KEYWORD/ARGUMENT-PAIRS...) in INSTR slot" t)) (partid (check* (or symbol real) "Found ~A, expected SYMBOL or REAL in PARTID slot" t)))) (with-error* (part "~~A, part ~A" (function part-name)) (class* part Index: fomus/data.lisp diff -u fomus/data.lisp:1.1.1.1 fomus/data.lisp:1.2 --- fomus/data.lisp:1.1.1.1 Tue Jul 19 20:16:57 2005 +++ fomus/data.lisp Thu Jul 21 17:38:42 2005 @@ -23,8 +23,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; QUANTIZING -(declaim (special *note-precision*)) - ;; nested tuplets indicated by a list (defparameter *max-tuplet* 7) @@ -33,6 +31,10 @@ (defparameter *min-tuplet-dur* 1/2) ; fraction of beat smallest tuplets should span at minimum (1/2 = half a beat, etc.)--can be nil (defparameter *max-tuplet-dur* 4) +;; pitch quantizing +(declaim (special *note-precision*)) +(defparameter *quartertones* nil) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; CONVERSION @@ -283,7 +285,7 @@ (:use-cm boolean) (:cm-scale t) (:loadxmls-fun (or function string symbol)) (:backend (or* (cons* symbol key-arg-pairs*) (list-of* (cons* symbol key-arg-pairs*))) - "(SYMBOL KEYWORD/ARGUMENTS PAIRS ...) or list of (SYMBOL KEYWORD/ARGUMENTS PAIRS ...)") + "(SYMBOL KEYWORD/ARGUMENTS-PAIRS...) or list of (SYMBOL KEYWORD/ARGUMENTS-PAIRS...)") (:base-filename string) (:global (or* null (list-of* (type* +timesig-type+))) "list of TIMESIG objects") @@ -304,7 +306,8 @@ (:default-grace-dur (rational (0))) (:default-grace-num integer) (:effective-grace-dur-mul (rational (0))) (:min-auto-timesig-dur (rational (0))) (:default-timesig (type* +timesig-repl-type+) "TIMESIG object") - + + (:quartertones boolean) (:auto-accidentals boolean) (:auto-cautionary-accs boolean) (:auto-staff/clef-changes boolean) (:auto-ottavas boolean) (:auto-grace-slurs boolean) (:auto-voicing boolean) (:auto-beams boolean) (:auto-quantize boolean) (:auto-multivoice-rests boolean) (:auto-multivoice-notes boolean) Index: fomus/final.lisp diff -u fomus/final.lisp:1.1.1.1 fomus/final.lisp:1.2 --- fomus/final.lisp:1.1.1.1 Tue Jul 19 20:16:59 2005 +++ fomus/final.lisp Thu Jul 21 17:38:43 2005 @@ -24,7 +24,7 @@ for x = (read f nil 'eof) until (eq x 'eof) for y = (read f nil 'eof) - when (eq y 'eof) do (error "KEYWORD/ARGUMENT PAIRS expected in initialization file") + when (eq y 'eof) do (error "KEYWORD/ARGUMENT-PAIRS expected in initialization file") do (setf nt0 (find-symbol (conc-strings "*" (symbol-name x) "*") :fomus)) if nt0 collect (find-symbol (conc-strings "*" (symbol-name x) "*") :fomus) into nt and collect y into nt else do (format t ";; WARNING: Unknown setting ~A~%" x) @@ -43,10 +43,10 @@ ;; print load greeting (eval-when (:load-toplevel :execute) - (when (>= *verbose* 1) (format t ";; ~A v~A.~A.~A~%;; ~A~%;; ~A~%;; ~A~%~%" + (when (>= *verbose* 1) (format t ";; ~A v~A.~A.~A~%~A~%" +title+ (first +version+) (second +version+) (third +version+) - +subtitle+ +copyright+ +termscond+))) + (conc-stringlist (loop for e in +banner+ collect (format nil ";; ~A~%" e)))))) (eval-when (:load-toplevel :execute) (load-initfile)) Index: fomus/load.lisp diff -u fomus/load.lisp:1.1.1.1 fomus/load.lisp:1.2 --- fomus/load.lisp:1.1.1.1 Tue Jul 19 20:17:01 2005 +++ fomus/load.lisp Thu Jul 21 17:38:43 2005 @@ -1,11 +1,11 @@ ;; -*-lisp-*- ;; Load file for FOMUS -(with-open-file (f (merge-pathnames "fomus.asd" *load-pathname*) :direction :input) - (destructuring-bind (xxx1 xxx2 &key components &allow-other-keys) (read f) - (declare (ignore xxx1 xxx2)) - (loop for (xxx na) in components - for cl = (merge-pathnames na *load-pathname*) - for cn = (compile-file-pathname cl) - when (>= (file-write-date cl) (file-write-date cn)) do (compile-file cl) - do (load cn)))) \ No newline at end of file +(loop for na in + '("package" "misc" "deps" "data" "classes" "util" "accidentals" "beams" "marks" "other" "ottavas" "parts" "postproc" "split" "staves" "voices" "quantize" "backend_ly" + "backends" "main" "interface" "final") + for cl = (merge-pathnames na *load-pathname*) + for cn = (compile-file-pathname cl) + for wd = (file-write-date cn) + when (or (null wd) (>= (file-write-date cl) (file-write-date cn))) do (compile-file cl) + do (load cn)) \ No newline at end of file Index: fomus/main.lisp diff -u fomus/main.lisp:1.1.1.1 fomus/main.lisp:1.2 --- fomus/main.lisp:1.1.1.1 Tue Jul 19 20:16:55 2005 +++ fomus/main.lisp Thu Jul 21 17:38:43 2005 @@ -34,7 +34,9 @@ (defun save-debug () (when (>= *verbose* 2) (out "~&; Saving debug file \"~A\"..." *debug-filename*)) (with-open-file (f *debug-filename* :direction :output :if-exists :supersede) - (format f ";; -*-lisp-*-~%;; ~A v~A.~A.~A~%~%(FOMUS~%" +title+ (first +version+) (second +version+) (third +version+)) + (format f ";; -*-lisp-*-~%;; ~A v~A.~A.~A~%;; ~A ~A~%~%(FOMUS~%" + +title+ (first +version+) (second +version+) (third +version+) + (lisp-implementation-type) (lisp-implementation-version)) (mapc (lambda (s) (format f " ~S ~S~&" (first s) (let ((x (symbol-value (find-symbol (conc-strings "*" (symbol-name (first s)) "*") :fomus)))) @@ -183,6 +185,6 @@ (let ((r (fomus-proc))) (loop for x in (or (force-list2 *backend*) '((:data))) do (destructuring-bind (ba &key filename view &allow-other-keys) x - (set-note-precision (backend ba (or filename (change-filename *base-filename* :ext (lookup ba +backendexts+))) r x view))))) + (backend ba (or filename (change-filename *base-filename* :ext (lookup ba +backendexts+))) r x view)))) t) Index: fomus/marks.lisp diff -u fomus/marks.lisp:1.1.1.1 fomus/marks.lisp:1.2 --- fomus/marks.lisp:1.1.1.1 Tue Jul 19 20:16:59 2005 +++ fomus/marks.lisp Thu Jul 21 17:38:43 2005 @@ -99,7 +99,7 @@ for k = (pop mks) while k do (loop with fo = (listp (event-off k)) ; fuzzy offset? (next available note forwards or backwards) with nu = (if fo (first (event-off k)) (event-off k)) - with o = (abs nu) and di = (>= nu 0) ; offset and direction + with o0 = (abs nu) and di = (>= nu 0) ; offset and direction for m in (event-marks k) do (loop with fl = (force-list m) with sy = (first fl) @@ -133,15 +133,21 @@ collect e) (if (null vo) l (remove-if-not (lambda (e) (find (event-voice* e) vo)) l))))) (if re r (remove-if #'restp r))))) - (if di - (if fo - (loop for e in (rm fo) until (> (event-off e) o) finally (return e)) - (loop for (e1 e2) on (cons nil (rm fo)) until (or (null e2) (> (event-off e2) o)) - finally (return (or e1 e2)))) - (if fo - (loop for e in (rm ba) until (< (event-endoff e) o) finally (return e)) - (loop for (e1 e2) on (cons nil (rm ba)) until (or (null e2) (< (event-endoff e2) o)) - finally (return (or e1 e2)))))))) + (let ((o (let ((q (getprop p :quant))) ; fix quantize error + (if q (let ((x (find-if (lambda (x) (and (<= (car x) o0) (>= (cdr x) o0))) (rest q)))) + (if x (cdr x) o0)) + o0)))) + (if di + (if fo + (loop for e in (rm fo) until (> (event-off e) o) finally (return e)) + (loop for (e1 e2) on (cons nil (rm fo)) until (or (null e2) (> (event-off e2) o)) + finally (return (or e1 e2)))) + (if fo + (loop for e in (rm ba) until (< (event-endoff e) o) finally (return e)) + (loop for (e1 e2) on (cons nil (rm ba)) until (or (null e2) (< (event-endoff e2) o)) + finally (return (or e1 e2))))))))) (if (eq sy :mark) (push (copy-event k :off (second fl) :voice (event-voice* ev) :marks (list (cddr fl))) mks) - (addmark ev m))))) (print-dot))) \ No newline at end of file + (addmark ev m))))) + (print-dot) + finally (mapc (lambda (p) (rmprop p :quant)) pts))) \ No newline at end of file Index: fomus/package.lisp diff -u fomus/package.lisp:1.1.1.1 fomus/package.lisp:1.2 --- fomus/package.lisp:1.1.1.1 Tue Jul 19 20:16:55 2005 +++ fomus/package.lisp Thu Jul 21 17:38:43 2005 @@ -20,6 +20,7 @@ (:use "COMMON-LISP" #|"MISCFUNS"|#) (:export "FOMUS" "LOAD-INITFILE" ; interface functions "FOMUS-INIT" "FOMUS-NEWTIMESIG" "FOMUS-NEWPART" "FOMUS-NEWMARK" "FOMUS-NEWNOTE" "FOMUS-NEWREST" "FOMUS-EXEC" "FOMUS-PART" + "LIST-FOMUS-SETTINGS" ; make/copy functions "MAKE-TIMESIG" "MAKE-TIMESIG-REPL" "MAKE-PART" "MARK-MARK" "MAKE-NOTE" "MAKE-REST" "MAKE-INSTR" "MAKE-PERC" "COPY-INSTR" "COPY-PERC" "MAKE-MEAS" "COPY-TIMESIG" "COPY-TIMESIG-REPL" "COPY-EVENT" "COPY-PART" "COPY-MEAS" @@ -56,10 +57,11 @@ (use-package "DBG" "FM"))) (defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 0)) -(defparameter +subtitle+ "Lisp music notation formatter") -(defparameter +copyright+ "Copyright (c) 2005 David Psenicka, All Rights Reserved") -(defparameter +termscond+ "See file \"COPYING\" for terms of use and distribution") +(defparameter +version+ '(0 1 1)) +(defparameter +banner+ + `("Lisp music notation formatter" + "Copyright (c) 2005 David Psenicka, All Rights Reserved" + "See file \"COPYING\" for terms of use and distribution.")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; GLOBAL Index: fomus/quantize.lisp diff -u fomus/quantize.lisp:1.1.1.1 fomus/quantize.lisp:1.2 --- fomus/quantize.lisp:1.1.1.1 Tue Jul 19 20:17:00 2005 +++ fomus/quantize.lisp Thu Jul 21 17:38:43 2005 @@ -97,16 +97,20 @@ #'<))) (loop with mg = (or (max-list (loop for e in (part-events p) when (event-grace e) collect (event-grace e))) (1- *default-grace-num*)) + and ad for e in (part-events p) do (let ((o (event-off e))) (loop while (and (list>1p qs) (< (second qs) o)) do (pop qs)) (let ((e1 (loop-return-firstmin (diff x o) for x in qs))) (if (event-grace e) - (setf (event-off e) e1 - (event-dur* e) (let ((bd (/ (beat-division (loop for s in ph until (<= (timesig-off s) e1) finally (return s)))))) - (let ((x (roundto (event-gracedur e) bd))) - (when (<= x 0) bd x)))) + (progn + (push (cons (event-off e) e1) ad) + (setf (event-off e) e1 + (event-dur* e) (let ((bd (/ (beat-division (loop for s in ph until (<= (timesig-off s) e1) finally (return s)))))) + (let ((x (roundto (event-gracedur e) bd))) + (when (<= x 0) bd x))))) (let ((e2 (let ((o (event-endoff e))) (loop-return-lastmin (diff x o) for x in qs)))) + (push (cons (event-off e) e1) ad) (setf (event-off e) e1) (let ((x (- e2 e1))) (if (<= x 0) @@ -115,7 +119,21 @@ (setf (event-dur e) (cons (- (loop for i in qs until (> i e1) finally (return i)) e1) (incf mg)))) - (setf (event-dur* e) x)))))))))) + (progn + (push (cons (event-endoff e) e2) ad) + (setf (event-dur* e) x)))))))) + finally + (addprop p (cons :quant + (merge-all ad (lambda (x y) (let ((x1 (car x)) (x2 (cdr x)) + (y1 (car y)) (y2 (cdr y))) + (when (= x2 y2) + (cons (if (< x1 x2) + #+debug (if (<= y1 y2) (min x1 y1) (error "Error in QUANTIZE-BYFIT 3")) + #-debug (min x1 y1) + #+debug (if (>= y1 y2) (max x1 y1) (error "Error in QUANTIZE-BYFIT 4")) + #-debug (max x1 y1)) + x2)))) + :call-rev nil)))))) (print-dot))))) (defun quantize (timesigs parts) Index: fomus/util.lisp diff -u fomus/util.lisp:1.1.1.1 fomus/util.lisp:1.2 --- fomus/util.lisp:1.1.1.1 Tue Jul 19 20:16:58 2005 +++ fomus/util.lisp Thu Jul 21 17:38:43 2005 @@ -569,3 +569,15 @@ :time (cons (first (timesig-time ts)) (second (timesig-time ts)))))) (timesig-check nt) nt)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; USER UTILITIES + +(defun list-fomus-settings () + (let* ((tc (+ 2 (max (1+ (loop for x in +settings+ maximize (length (symbol-name (first x))))) 4))) + (tl (+ tc 1 (max (loop for (xxx t1 t2) in +settings+ maximize (length (or t2 (princ-to-string t1)))) 4)))) + (format t "; NAME~VTTYPE~VTDEFAULT VALUE~%~%" tc tl) + (loop for (sy t1 t2) in +settings+ do + (format t "; ~A~VT~A~VT~A~%" sy tc (or t2 t1) tl (prin1-to-string (symbol-value (find-symbol (conc-strings "*" (symbol-name sy) "*") :fomus))))))) + + \ No newline at end of file

1 0

[fomus-cvs] CVS update: fomus/doc/marks.xml fomus/doc/objects.xml fomus/doc/settings.xml
by dpsenicka＠common-lisp.net 20 Jul '05

20 Jul '05

Update of /project/fomus/cvsroot/fomus/doc In directory common-lisp.net:/tmp/cvs-serv16769 Modified Files: marks.xml objects.xml settings.xml Log Message: Doc update Date: Wed Jul 20 06:50:01 2005 Author: dpsenicka Index: fomus/doc/marks.xml diff -u fomus/doc/marks.xml:1.1.1.1 fomus/doc/marks.xml:1.2 --- fomus/doc/marks.xml:1.1.1.1 Tue Jul 19 20:17:05 2005 +++ fomus/doc/marks.xml Wed Jul 20 06:50:00 2005 @@ -44,7 +44,7 @@ </para> </listitem> <listitem><para> - The starting mark is included in the object occuring at the start of the spanner and the mark without a prefix + The starting mark is included in the object occurring at the start of the spanner and the mark without a prefix is included in objects following the starting mark. The last object with a mark in it before a new starting mark is found is considered to be the end of the spanner. @@ -79,7 +79,7 @@ <variablelist> <varlistentry> <term><userinput><anchor id="markarg.art.order"/>art-order</userinput></term> - <listitem>An integer for articulations specifying relative closeness to the notehead (lower numbered articulations are closer than higher numbered ones)</listitem> + <listitem>An integer for articulations specifying relative closeness to the note head (lower numbered articulations are closer than higher numbered ones)</listitem> </varlistentry> <varlistentry> <term><userinput><anchor id="markarg.clef"/>clef</userinput></term> @@ -91,8 +91,8 @@ <listitem> This is an integer distinguishing between inner and outer levels of spanner markings. - Smaller numbers are "inner" markings occuring closest to the staff while larger numbers are "outer" markings - occuring farthest from the staff. + Smaller numbers are "inner" markings occurring closest to the staff while larger numbers are "outer" markings + occurring farthest from the staff. The default value is 1 </listitem> @@ -103,8 +103,8 @@ slot in the <classname><link linkend="class.note">NOTE</link></classname> class).</listitem> </varlistentry> <varlistentry> - <term><userinput><anchor id="markarg.notehead"/>notehead</userinput></term> - <listitem>One of the following notehead symbols: (not implemented yet).</listitem> + <term><userinput><anchor id="markarg.notehead"/>note head</userinput></term> + <listitem>One of the following note head symbols: (not implemented yet).</listitem> </varlistentry> <varlistentry> <term><userinput><anchor id="markarg.string"/>string</userinput></term> @@ -112,7 +112,7 @@ </varlistentry> <varlistentry> <term><userinput><anchor id="markarg.trem.subdiv"/>trem-subdiv</userinput></term> - <listitem>A durational value (a ratio or integer) for a tremelo subdivision</listitem> + <listitem>A durational value (a ratio or integer) for a tremolo subdivision</listitem> </varlistentry> </variablelist> </para> @@ -191,10 +191,10 @@ <title>Ornamentations</title> <simplelist> - <member><function>(<anchor id="tremelo"/>:TREMELO &optional <userinput><link link="markarg.trem.subdiv">trem-subdiv</link></userinput>)</function></member> - <member><function>(<anchor id="righthandtremelo"/>:RIGHTHANDTREMELO &optional + <member><function>(<anchor id="tremelo"/>:TREMOLO &optional <userinput><link link="markarg.trem.subdiv">trem-subdiv</link></userinput>)</function></member> + <member><function>(<anchor id="righthandtremelo"/>:RIGHTHANDTREMOLO &optional <userinput><link link="markarg.trem.subdiv">trem-subdiv</link></userinput>)</function></member> - <member><function>(<anchor id="lefthandtremelo"/>:LEFTHANDTREMELO &optional + <member><function>(<anchor id="lefthandtremelo"/>:LEFTHANDTREMOLO &optional <userinput><link link="markarg.trem.subdiv">trem-subdiv</link></userinput>)</function></member> <member><function><anchor id="longtrill"/>:LONGTRILL</function></member> <member><function>(<anchor id="arpeggio"/>:ARPEGGIO &optional <literal>:UP</literal>/<literal>:DOWN</literal>)</function></member> Index: fomus/doc/objects.xml diff -u fomus/doc/objects.xml:1.1.1.1 fomus/doc/objects.xml:1.2 --- fomus/doc/objects.xml:1.1.1.1 Tue Jul 19 20:17:05 2005 +++ fomus/doc/objects.xml Wed Jul 20 06:50:01 2005 @@ -303,7 +303,7 @@ The offset is measured in "beats," which may indicate different notational positions depending on previous time signatures and what values are present in their <structfield><link linkend="timesig.beat">BEAT</link></structfield> slots. - The number must be precise and notatable (floating point numbers are not recommended and values like 10/3 that don't + The number must be precise and "notatable" (floating point numbers are not recommended and values like 10/3 that don't occur on a regular beat divisions are currently impossible for <application>FOMUS</application> to notate). </para> </listitem> @@ -313,7 +313,7 @@ <term><function><anchor id="timesig.time"/>TIMESIG-TIME</function></term> <listitem> <para> - This is a required list of two integers, specifying the numberator and denominator of the printed time signature. + This is a required list of two integers, specifying the numerator and denominator of the printed time signature. </para> </listitem> </varlistentry> @@ -357,13 +357,13 @@ <listitem> <para> This is a single list or list of lists containing ratios or integers that add up to the total number of beats - in a meaure (as specified by either the <structfield><link linkend="timesig.time">TIME</link></structfield> or + in a measure (as specified by either the <structfield><link linkend="timesig.time">TIME</link></structfield> or <structfield><link linkend="timesig.beat">BEAT</link></structfield> slots). It represents all of the choices available for dividing up measures following this time signature. If the slot contains the default value of <literal>NIL</literal>, <application>FOMUS</application> looks up - divisions first in a user-supplied table if one exists (see the <varname><link linkend="default.meas.divs">DEFALT-MEAS-DIVS</link></varname> + divisions first in a user-supplied table if one exists (see the <varname><link linkend="default.meas.divs">DEFAULT-MEAS-DIVS</link></varname> setting) then in <application>FOMUS</application>'s default table. A value usually only needs to be specified here if the user wants to force <application>FOMUS</application> @@ -618,7 +618,7 @@ that make the best use of tuplets within given constraints while minimizing the amount of adjustment error. If this quantizing algorithm is switched off, then the user must insure that all offset and duration values - are precise and notatable (floating point numbers are not recommended in this case). + are precise and "notatable" (floating point numbers are not recommended in this case). </para> </listitem> </varlistentry> @@ -638,7 +638,7 @@ function. Symbols in this case designate notational values and not beats, although - numbers are still interpretted with respect to beats and not filtered through <application>CM</application>'s + numbers are still interpreted with respect to beats and not filtered through <application>CM</application>'s <function>RHYTHM</function> function. </para> @@ -652,7 +652,7 @@ Also, grace notes with the same position form chords, and notes with negative positions are notated with a slash. - The duration value at the front of the list is still interpretted in terms of beats and notated as such even though + The duration value at the front of the list is still interpreted in terms of beats and notated as such even though the note does not take up time in the measure. Specifying a duration of <literal>'(1/4 -1)</literal>, for example, specifies a grace sixteenth note with a slash @@ -901,7 +901,7 @@ Marks designate extra information that to be applied to a <classname><link linkend="class.note">NOTE</link></classname> or <classname><link linkend="class.rest">REST</link></classname> object - such as articulations, modifications like tremelos or harmonics, printed text, etc.. + such as articulations, modifications like tremolos or harmonics, printed text, etc.. After voices and staff assignments have been established, information in the <classname><link linkend="class.mark">MARK</link></classname> objects is dumped into the <structfield><link linkend="note.marks">MARKS</link></structfield> slots of <classname><link linkend="class.note">NOTE</link></classname> and @@ -1013,7 +1013,7 @@ only need to appear in one place. In the case of the example above, a mark with this value in its <structfield><link linkend="mark.voice">VOICE</link></structfield> - slot that is applied to a grandstaff is attached to a note in a voice close to the inside of the staff. + slot that is applied to a grand staff is attached to a note in a voice close to the inside of the staff. </para> <para> @@ -1266,11 +1266,11 @@ <para> The value of this slot influences how <application>FOMUS</application> decides when to change clefs. - A clef change isn't considered necessary until the number of leger lines required exceeds a threshold value. + A clef change isn't considered necessary until the number of ledger lines required exceeds a threshold value. Other factors determine if there is actually a clef change or not. - If the value is an integer, it designates the threshold number of leger lines in all cases. + If the value is an integer, it designates the threshold number of ledger lines in all cases. If it's a list, the first element of the list must be an integer specifying a default threshold. @@ -1278,7 +1278,7 @@ This exception list contains a clef symbol (see the <structfield><link linkend="instr.clefs">CLEFS</link></structfield> slot above) followed by one of the two symbols <literal>:UP</literal> or <literal>:DN</literal> - and ended by an integer specifying the number of leger lines. + and ended by an integer specifying the number of ledger lines. An example illustrates this data structure. @@ -1298,10 +1298,10 @@ <para> This value influences how <application>FOMUS</application> chooses where to place ottava brackets above the staff. - An ottava bracket isn't considered necessary until the number of leger lines required exceeds a threshold value. + An ottava bracket isn't considered necessary until the number of ledger lines required exceeds a threshold value. An integer in this slot indicates the threshold value, while - a list of two elements specifies the threshold for the ottava bracket to begin and the threshold below which the number of leger lines must + a list of two elements specifies the threshold for the ottava bracket to begin and the threshold below which the number of ledger lines must drop for it to end. </para> </listitem> @@ -1398,7 +1398,7 @@ <para> This is an integer or symbol designating where the instrument's notes are to appear on the staff. - The value is interpretted as if notated with a treble cleff signature. + The value is interpreted as if notated with a treble clef signature. See <function>EVENT-NOTE</function> in the <classname><link linkend="class.note">NOTE</link></classname> class for information on specifying notes with symbols. Index: fomus/doc/settings.xml diff -u fomus/doc/settings.xml:1.1.1.1 fomus/doc/settings.xml:1.2 --- fomus/doc/settings.xml:1.1.1.1 Tue Jul 19 20:17:03 2005 +++ fomus/doc/settings.xml Wed Jul 20 06:50:01 2005 @@ -253,7 +253,7 @@ <listitem> <para> This is a real number between <literal>0</literal> and <literal>1</literal> indicating the score for - finding note spellings that form augmented or dimished (rather than diatonic) intervals. + finding note spellings that form augmented or diminished (rather than diatonic) intervals. This value should probably be less than <varname><link linkend="acc.diatonic.int.score">ACC-DIATONIC-INT-SCORE</link></varname>. </para> @@ -265,7 +265,7 @@ <listitem> <para> This is a real number between <literal>0</literal> and <literal>1</literal> indicating the score for - spelling an ascending chromatic line with flats or a decending chromatic line with sharps. + spelling an ascending chromatic line with flats or a descending chromatic line with sharps. This value should probably be less than <varname><link linkend="acc.good.unison.score">ACC-GOOD-UNISON-SCORE</link></varname>. </para> @@ -521,7 +521,7 @@ <term><varname><anchor id="auto.distr.rests.fun"/>:AUTO-DISTR-RESTS-FUN</varname></term> <listitem> <para> - Designates which function is to be used for determining how rests are distributed amoung staves. + Designates which function is to be used for determining how rests are distributed among staves. Current possible values are <literal>:DEFAULT</literal> and <literal>:RESTS1</literal>. @@ -627,7 +627,7 @@ Floating point numbers are treated with the <function>RATIONALIZE</function> function in this case (this isn't recommended). - If offsets and durations of events aren't notatable then <application>FOMUS</application> will complain with an error. + If offsets and durations of events aren't "notatable" then <application>FOMUS</application> will complain with an error. Note that mark objects aren't quantized (see class <classname><link linkend="class.mark">MARK</link></classname> for details). </para> @@ -689,7 +689,7 @@ <term><varname><anchor id="auto.voicing"/>:AUTO-VOICING</varname></term> <listitem> <para> - If set to <literal>T</literal>, <application>FOMUS</application> automatically decides how to distribute notes amoung multiple voices, + If set to <literal>T</literal>, <application>FOMUS</application> automatically decides how to distribute notes among multiple voices, given the choices specified in the <classname>NOTE</classname>, <classname>REST</classname> and <classname>MARK</classname> objects. If set to <literal>NIL</literal>, the user must explicitly specify which voice an event belongs to. @@ -845,7 +845,7 @@ <listitem> <para> When set to <literal>T</literal>, the cautionary accidental algorithm considers the presence ottava brackets, placing - cautionary accidentals where apparant octave transpositions might cause confusion. + cautionary accidentals where apparent octave transpositions might cause confusion. </para> </listitem> </varlistentry> @@ -854,7 +854,7 @@ <term><varname><anchor id="check.ranges"/>:CHECK-RANGES</varname></term> <listitem> <para> - When set to <literal>T</literal>, activates a check that prints warnings if it finds notes out of range for their intruments. + When set to <literal>T</literal>, activates a check that prints warnings if it finds notes out of range for their instruments. The <structfield>MINP</structfield> and <structfield>MAXP</structfield> slots in the appropriate <classname>INSTR</classname> object must be set for this to have any effect. @@ -891,8 +891,8 @@ It affects how clef change decisions are made. - When notes require leger lines that can be avoided by a clef change, the algorithm will consider one if the number of - leger lines increases past a certain threshold (specified in the <structfield><link linkend="instr.cleflegls">CLEFLEGLS</link></structfield> slot of the + When notes require ledger lines that can be avoided by a clef change, the algorithm will consider one if the number of + ledger lines increases past a certain threshold (specified in the <structfield><link linkend="instr.cleflegls">CLEFLEGLS</link></structfield> slot of the <classname><link linkend="struct.instr">INSTR</link></classname> structure). If set to a number this setting will cause the algorithm to consider one anyways if it occurs for the specified duration. @@ -1205,7 +1205,7 @@ <listitem> <para> When set to <literal>T</literal> or <literal>:SOME</literal>, indicates that <application>FOMUS</application> hides some rests - when combining multiple voices in a grandstaff. + when combining multiple voices in a grand staff. This makes the notation easier to read for multi-staff instruments by eliminating rests that aren't necessary. @@ -1386,7 +1386,7 @@ This is a real number greater than <literal>0</literal>, specifying the minimum duration that a group of rests must occupy in order to be hidden. - Extra rests may be hidden when multiple voices are being combined in a grandstaff. + Extra rests may be hidden when multiple voices are being combined in a grand staff. </para> </listitem> </varlistentry> @@ -1430,7 +1430,7 @@ <term><varname><anchor id="parts"/>:PARTS</varname></term> <listitem> <para> - This is a list of <classname><link linkend="class.part">PART</link></classname> objects, each representing a stave or grandstaff in the score. + This is a list of <classname><link linkend="class.part">PART</link></classname> objects, each representing a stave or grand staff in the score. At least one part must be specified. </para> @@ -1505,7 +1505,7 @@ <para> This must be set to an integer greater or equal to <literal>100</literal>. - This value affects the performance of the search algorithm that decides how notes are distributed amoung staves. + This value affects the performance of the search algorithm that decides how notes are distributed among staves. A larger value will cause the algorithm to be slower but more accurate while a smaller value has the opposite affect. </para> @@ -1519,7 +1519,7 @@ This must be set to a real number between <literal>0</literal> and <literal>1</literal>. The value together with the value of <varname><link linkend="staff.importance.steps">STAFF-IMPORTANCE-STEPS</link></varname> - affects the performance of the algorithm that decides how notes are distributed amoung staves. + affects the performance of the algorithm that decides how notes are distributed among staves. As the algorithm searches ahead through possible paths, it regards previous paths as less important depending on how much farther the current best path is. @@ -1539,7 +1539,7 @@ This must be set to an integer greater than <literal>0</literal>. This value together with the value of <varname><link linkend="staff.importance.score">STAFF-IMPORTANCE-SCORE</link></varname> - affects the performance of the algorithm that decides how notes are distributed amoung staves. + affects the performance of the algorithm that decides how notes are distributed among staves. As the algorithm searches ahead through possible paths, it regards previous paths as less important depending on how much farther the current best path is. @@ -1651,7 +1651,7 @@ <varname><link linkend="cm.scale">CM-SCALE</link></varname> as if it were passed as the <literal>:IN</literal> argument to <application>CM</application>'s <function>KEYNUM</function> function. - Also, durations specified as symbols indicate notational durations and are interpretted + Also, durations specified as symbols indicate notational durations and are interpreted as such using <application>CM</application>'s <function>RHYTHM</function> function. Numbers are still interpreted by <application>FOMUS</application> in terms of beats. @@ -1727,7 +1727,7 @@ <listitem> <para> This is a real number between <literal>0</literal> and <literal>1</literal> indicating the penalty for too much - material occuring in one voice and not another. + material occurring in one voice and not another. </para> </listitem> </varlistentry> @@ -1778,7 +1778,7 @@ <para> This must be set to an integer greater or equal to <literal>100</literal>. - This value affects the performance of the search algorithm that decides how notes are distributed amoung voices. + This value affects the performance of the search algorithm that decides how notes are distributed among voices. A larger value will cause the algorithm to be slower but more accurate while a smaller value has the opposite affect. </para> @@ -1816,7 +1816,7 @@ <listitem> <para> This is a real number between <literal>0</literal> and <literal>1</literal> indicating the penalty for placing lower pitched notes - above higher pitched notes when distributing them amoung voices. + above higher pitched notes when distributing them among voices. </para> </listitem> </varlistentry> @@ -1828,7 +1828,7 @@ This must be set to a real number between <literal>0</literal> and <literal>1</literal>. The value together with the value of <varname><link linkend="voice.importance.steps">VOICE-IMPORTANCE-STEPS</link></varname> - affects the performance of the algorithm that decides how notes are distributed amoung voices. + affects the performance of the algorithm that decides how notes are distributed among voices. As the algorithm searches ahead through possible paths, it regards previous paths as less important depending on how much farther the current best path is. @@ -1848,7 +1848,7 @@ This must be set to an integer value greater than 0. The value together with the value of <varname><link linkend="voice.importance.score">VOICE-IMPORTANCE-SCORE</link></varname> - affects the performance of the algorithm that decides how notes are distributed amoung voices. + affects the performance of the algorithm that decides how notes are distributed among voices. As the algorithm searches ahead through possible paths, it regards previous paths as less important depending on how much farther the current best path is. @@ -1891,7 +1891,7 @@ <term><varname><anchor id="voice.leading.penalty"/>:VOICE-LEADING-PENALTY</varname></term> <listitem> <para> - This is a real number between <literal>0</literal> and <literal>1</literal> indicating the penalty for occurances of disjunct melodic lines + This is a real number between <literal>0</literal> and <literal>1</literal> indicating the penalty for occurrences of disjunct melodic lines and wide intervals in voices. This helps to insure that material in each voice is playable. @@ -1929,10 +1929,10 @@ <term><varname><anchor id="voice.simult.penalty"/>:VOICE-SIMULT-PENALTY</varname></term> <listitem> <para> - This is a real number between <literal>0</literal> and <literal>1</literal> indicating the penalty for simultaneous notes occuring in + This is a real number between <literal>0</literal> and <literal>1</literal> indicating the penalty for simultaneous notes occurring in one voice. - This causes chords to be distributed evenly amoung all voices. + This causes chords to be distributed evenly among all voices. </para> </listitem> </varlistentry>

1 0

[fomus-cvs] CVS update: Module imported: fomus
by dpsenicka＠common-lisp.net 19 Jul '05

19 Jul '05

Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv9145 Log Message: Initial import Status: Vendor Tag: fomus Release Tags: alpha N fomus/accidentals.lisp N fomus/parts.lisp N fomus/package.lisp N fomus/backends.lisp N fomus/main.lisp N fomus/voices.lisp N fomus/misc.lisp N fomus/deps.lisp N fomus/data.lisp N fomus/other.lisp N fomus/split.lisp N fomus/classes.lisp N fomus/util.lisp N fomus/staves.lisp N fomus/ottavas.lisp N fomus/marks.lisp N fomus/postproc.lisp N fomus/beams.lisp N fomus/fomus.asd N fomus/interface.lisp N fomus/final.lisp N fomus/backend_ly.lisp N fomus/quantize.lisp N fomus/COPYING N fomus/load.lisp N fomus/TODO N fomus/doc/intro.xml N fomus/doc/settings.xml N fomus/doc/install.xml N fomus/doc/objects.xml N fomus/doc/backends.xml N fomus/doc/init.xml N fomus/doc/fomus.xml N fomus/doc/usage.xml N fomus/doc/marks.xml No conflicts created by this import Date: Tue Jul 19 20:17:05 2005 Author: dpsenicka New module fomus added

1 0