Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv20942 Modified Files: TODO accidentals.lisp backend_ly.lisp classes.lisp data.lisp interface.lisp main.lisp marks.lisp misc.lisp package.lisp split.lisp util.lisp Log Message: Testing/bug fixes Date: Sat Jul 23 11:23:14 2005 Author: dpsenicka Index: fomus/TODO diff -u fomus/TODO:1.2 fomus/TODO:1.3 --- fomus/TODO:1.2 Thu Jul 21 17:38:42 2005 +++ fomus/TODO Sat Jul 23 11:23:14 2005 @@ -3,6 +3,12 @@ IMMEDIATE Testing and bug fixes +BUG: :startslur- and :slur- marks +BUG: error in beams in CMUCL +DOC: dynamics marks can take order arguments (backend might not support it) +DOC: make sure user knows to use the package +DOC: make sure user knows about :default-beat setting +Adjust scores and penalties for decent results @@ -17,6 +23,7 @@ Reorganize code, update comments Reorganize settings MIDI input interface +Support for polymeters in backends @@ -24,4 +31,4 @@ Features for proportional notation (generate hidden rests of constant duration?) Key signatures (key detection algorithm) -Combine sections with different settings into one score +Combine separately notated sections with different settings into one score (concatenate multiple .fms files?) Index: fomus/accidentals.lisp diff -u fomus/accidentals.lisp:1.2 fomus/accidentals.lisp:1.3 --- fomus/accidentals.lisp:1.2 Thu Jul 21 17:38:42 2005 +++ fomus/accidentals.lisp Sat Jul 23 11:23:14 2005 @@ -114,7 +114,7 @@ (aa n2 a2)))) (if qt v (max v 0))))))) (defun nokeyq-intscore (tie note1 acc1 off1 eoff1 note2 acc2 off2 eoff2) - (let ((s (nokey-intscore (- note1 (cdr acc1)) (car acc1) off1 eoff1 (- note2 (cdr acc2)) (car acc2) off2 eoff2 t))) + (let ((s (nokey-intscore tie (- note1 (cdr acc1)) (car acc1) off1 eoff1 (- note2 (cdr acc2)) (car acc2) off2 eoff2 t))) (if (and (= (cdr acc1) 0) (= (cdr acc2) 0)) (max s 0) (let ((a1 (if (= (cdr acc1) 0) (car acc1) (cdr acc1))) (a2 (if (= (cdr acc2) 0) (car acc2) (cdr acc2)))) Index: fomus/backend_ly.lisp diff -u fomus/backend_ly.lisp:1.2 fomus/backend_ly.lisp:1.3 --- fomus/backend_ly.lisp:1.2 Thu Jul 21 17:38:42 2005 +++ fomus/backend_ly.lisp Sat Jul 23 11:23:14 2005 @@ -69,9 +69,6 @@ ;; LILYPOND BACKEND (defparameter +lilypond-head+ - '("\\version \"2.4.2\"" - "\\include \"english.ly\"")) -(defparameter +lilypond-headq+ ;; quarter tones aren't supported in english '("\\version \"2.4.2\"")) (defparameter +lilypond-defs+ '("octUp = #(set-octavation 1)" @@ -83,8 +80,8 @@ )) (defparameter +lilypond-num-note+ (vector "c" nil "d" nil "e" "f" nil "g" nil "a" nil "b")) -(defparameter +lilypond-num-acc+ (vector "ff" "f" "" "s" "ss")) -(defparameter +lilypond-num-accq+ (vector (vector nil "eseh") (vector "eseh" "es" "eh") (vector "eh" "" "ih") (vector "ih" "is" "isih") (vector nil "isis"))) +(defparameter +lilypond-num-acc+ (vector "eses" "es" "" "is" "isis")) +(defparameter +lilypond-num-accq+ (vector (vector nil "eses") (vector "eseh" "es" "eh") (vector "eh" "" "ih") (vector "ih" "is" "isih") (vector nil "isis"))) (defparameter +lilypond-num-reg+ (vector ",,," ",," "," "" "'" "''" "'''" "''''" "'''''")) (defparameter +lilypond-barlines+ '((:single . "|") (:double . "||") (:final . "|.") (:repeatleft . ":|") (:repeatright . "|:") (:repeatleftright . ":|:") (:invisible . ""))) @@ -118,7 +115,7 @@ (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 + (loop for e in +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)) @@ -252,11 +249,11 @@ (t ""))) and ar = (conc-stringlist (loop for i in - (sort (loop for a in +lilypond-marks+ nconc (getmarks e (car a))) + (sort (loop for a in +lilypond-marks+ nconc (mapcar #'force-list (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+))) + collect (lookup (first i) +lilypond-marks+))) ;and txt = ... and we0 = (cond ((and (getmark e :startwedge<) (getmark e :endwedge-)) "\\< ") ((and (getmark e :startwedge>) (getmark e :endwedge-)) "\\> ") @@ -270,26 +267,23 @@ (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+))) + (loop for a in +lilypond-dyns+ nconc (mapcar #'force-list (getmarks e (car a)))) + collect (lookup (first i) +lilypond-dyns+))) and s1 = (conc-stringlist (loop - for xxx in (remove-if (lambda (x) (/= (third x) 1)) (getmarks e :startslur-)) + for xxx in (delete-if (lambda (x) (/= (second x) 1)) (getmarks e :startslur-)) collect "(")) and s2 = (conc-stringlist (loop - for xxx in (remove-if (lambda (x) (/= (third x) 1)) (getmarks e :endslur-)) + for xxx in (delete-if (lambda (x) (/= (second x) 1)) (getmarks e :endslur-)) collect ")")) and sl1 = (conc-stringlist (loop - for xxx in (remove-if (lambda (x) (/= (third x) 2)) (getmarks e :startslur-)) + for xxx in (delete-if (lambda (x) (/= (second x) 2)) (getmarks e :startslur-)) collect "(")) and sl2 = (conc-stringlist (loop - for xxx in (remove-if (lambda (x) (/= (third x) 2)) (getmarks e :endslur-)) + for xxx in (delete-if (lambda (x) (/= (second 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)) Index: fomus/classes.lisp diff -u fomus/classes.lisp:1.2 fomus/classes.lisp:1.3 --- fomus/classes.lisp:1.2 Thu Jul 21 17:38:42 2005 +++ fomus/classes.lisp Sat Jul 23 11:23:14 2005 @@ -120,7 +120,7 @@ (declaim (inline timesig-num timesig-den)) (defun timesig-num (ts) (car (timesig-time ts))) (defun timesig-den (ts) (cdr (timesig-time ts))) -(defun timesig-beat* (ts) (if (timesig-comp ts) (/ 3 (timesig-den ts)) (or (timesig-beat ts) (/ (timesig-den ts))))) +(defun timesig-beat* (ts) (if (timesig-comp ts) (/ 3 (timesig-den ts)) (or (timesig-beat ts) *default-beat* (/ (timesig-den ts))))) (declaim (inline obj-partid)) (defgeneric obj-partid (x)) Index: fomus/data.lisp diff -u fomus/data.lisp:1.2 fomus/data.lisp:1.3 --- fomus/data.lisp:1.2 Thu Jul 21 17:38:42 2005 +++ fomus/data.lisp Sat Jul 23 11:23:14 2005 @@ -31,6 +31,8 @@ (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) +(defparameter *default-beat* nil) + ;; pitch quantizing (declaim (special *note-precision*)) (defparameter *quartertones* nil) @@ -321,7 +323,8 @@ (:default-meas-divs (or* null (list-of* (cons* (rational 0) (list-of* (list-of* (rational 0)))))) "list of ((RATIONAL (0)) (((RATIONAL (0)) ...) ...))") (:use-default-tuplet-divs boolean) (:default-tuplet-divs (or* null (list-of* (cons* (integer 1) (list-of* (list-of* (integer 1)))))) "list of ((INTEGER 1) (((INTEGER 1) ...) ...))") - + + (:default-beat (or null (rational (0)))) (:beat-division (or* (integer 1) (and (list* (integer 1) (integer 1)) (length* = 2))) "(INTEGER 1) or ((INTEGER 1) (INTEGER 1))") (:min-tuplet-dur (real (0))) (:max-tuplet-dur (real (0))) (:min-simple-tuplet-dur (real (0))) (:max-tuplet (or* (integer 2) (list-of* (integer 2))) "(INTEGER 2) or list of (INTEGER 2)") @@ -377,9 +380,9 @@ :startwedge> :startwedge< :wedge- :endwedge- :startgraceslur- :graceslur- :endgraceslur- :clef- :endclef- - :rfz :sfz :spp :sp :sff :sf :fp :fffff :ffff :fff :ff :f :mf :mp :p :pp :ppp :pppp :ppppp - :cautacc)))) - x (list* x)) ; spanners w/ only 1 level, non-articulations + :cautacc + :rfz :sfz :spp :sp :sff :sf :fp :fffff :ffff :fff :ff :f :mf :mp :p :pp :ppp :pppp :ppppp)))) + (or* x (list* x))) ; spanners w/ only 1 level, non-articulations (let* ((x (unique* sy (find* :fermata)))) (or* x (list* x) (list* x (find* :short :long :verylong)))) (let* ((x (unique* sy (find* :arpeggio)))) @@ -399,7 +402,7 @@ :lineprall :prallup :pralldown :downmordent :upmordent :downprall :upprall :prallmordent :prallprall :mordent :prall :trill :reverseturn :turn :righttoe :lefttoe :rightheel :leftheel :thumb :flageolet :downbow :upbow :portato :tenuto :marcato :accent)))) - (or* x (list* x) (list* x integer))) ; articulations, some spanners + (or* x (list* x) (list* x integer))) ; articulations, dynamics, some spanners (let* ((x (unique* sy :clef (find* :clef :startclef-)))) (list* x (function* is-clef))) (let* ((x (unique* sy (find* :notehead)))) @@ -412,7 +415,7 @@ (unique* si 1 (eql* :dotted)) (list* (unique* si integer) (eql* :dotted)) (list* (eql* :dotted) (unique* si integer)))))) ; startslur- - (let* ((x (unique* sy (find* :slur- :endslur-)))) + (let* ((x (find* :slur- :endslur-))) (or* (unique* si 1 x) (unique* si 1 (list* x)) (list* x (unique* si integer)))) (let* ((x (find* :textnote :texttempo :textdyn :text))) (list* x string)) ; text @@ -435,21 +438,30 @@ (list* string (unique* tx integer)) (list* (unique* tx integer) string)))))) +(defparameter *checktype-markerr* "Found ~A, expected valid/unique mark") +(defparameter *checktype-markserr* "Found ~A, expected list of valid marks") + (defparameter +notemarks-type+ - '(with-unique* (sy si tt td tx) - (list-of* - (check* (type* +notemark-type+) "Found ~A, expected valid mark" t)))) + '(check* + (with-unique* (sy si tt td tx) + (list-of* + (check* (type* +notemark-type+) *checktype-markerr* t))) + *checktype-markserr* t)) (defparameter +markmarks-type+ - '(with-unique* (sy si tt td tx) - (list-of* - (check* (or* (type* +notemark-type+) - (cons (eql* :mark) (cons (or* (real 0) (list* real)) (and* list (type* +notemark-type+))))) - "Found ~A, expected valid mark" t)))) + '(check* + (with-unique* (sy si tt td tx) + (list-of* + (check* (or* (type* +notemark-type+) + (cons (eql* :mark) (cons (or* (real 0) (list* real)) (and* list (type* +notemark-type+))))) + *checktype-markerr* t))) + *checktype-markserr* t)) (defparameter +restmarks-type+ '(and* - (list-of* (check* (or* (satisfies is-restmarksym) (cons* (satisfies is-restmarksym) list)) "Found ~A, expected valid mark" t)) + (check* + (list-of* (check* (or* (satisfies is-restmarksym) (cons* (satisfies is-restmarksym) list)) *checktype-markerr* t)) + *checktype-markserr* t) (type* +notemarks-type+))) (defparameter +marks-rests+ Index: fomus/interface.lisp diff -u fomus/interface.lisp:1.1.1.1 fomus/interface.lisp:1.2 --- fomus/interface.lisp:1.1.1.1 Tue Jul 19 20:16:59 2005 +++ fomus/interface.lisp Sat Jul 23 11:23:14 2005 @@ -72,6 +72,10 @@ (let ((re (apply #'make-instance 'rest :partid partid args))) (push re *fomus-events*) t)) +(defun fomus-newmark (partid &rest args) + (let ((re (apply #'make-instance 'mark :partid partid args))) + (push re *fomus-events*) + t)) ;;(declaim (inline fomus-part)) (defun fomus-part (sym) @@ -81,9 +85,9 @@ (defun fomus-exec (&rest args) (unwind-protect (apply #'fomus - :global *fomus-global* - :parts (nreverse *fomus-parts*) - :events *fomus-events* + :global (append *global* *fomus-global*) + :parts (append *parts* (nreverse *fomus-parts*)) + :events (append *events* *fomus-events*) (append args *fomus-args*)) (fomus-init))) Index: fomus/main.lisp diff -u fomus/main.lisp:1.2 fomus/main.lisp:1.3 --- fomus/main.lisp:1.2 Thu Jul 21 17:38:43 2005 +++ fomus/main.lisp Sat Jul 23 11:23:14 2005 @@ -52,7 +52,7 @@ (when (and (numberp *verbose*) (>= *verbose* 1)) (out ";; Formatting music...")) (when *debug-filename* (save-debug)) (when (and (numberp *verbose*) (>= *verbose* 2)) (out "~&; Checking types...")) - (check-settings-types) + (check-setting-types) (find-cm) (check-settings) (multiple-value-bind (*timesigs* *keysigs* rm) (split-list *global* #'timesigp #'keysigp) @@ -151,7 +151,7 @@ (when (>= *verbose* 2) (out "~&; Chords...")) (preproc pts) #+debug (fomus-proc-check pts 'preproc) ; ----- CHORDS, RESTS (clean-ties pts) #+debug (fomus-proc-check pts 'cleanties1) - (when (>= *verbose* 2) (out "~&; Splits/ties/rests...")) + (when (>= *verbose* 2) (out "~&; Splits/ties/rests...")) (split pts) #+debug (fomus-proc-check pts 'ties) (clean-ties pts) #+debug (fomus-proc-check pts 'cleanties2) (when *auto-beams* Index: fomus/marks.lisp diff -u fomus/marks.lisp:1.2 fomus/marks.lisp:1.3 --- fomus/marks.lisp:1.2 Thu Jul 21 17:38:43 2005 +++ fomus/marks.lisp Sat Jul 23 11:23:14 2005 @@ -63,7 +63,7 @@ (addmark e (if a2 (list startsym n a2) (list startsym n))) ; fixed order now--level is mandatory 1st argument, modifier is optional (decf nu)) (error "Levels for marks ~A, ~A and ~A are out of order at offset ~A, part ~A" startsym contsym endsym (event-foff e) (part-name p))) - (error "Missing ending marks ~A or ~A for starting mark ~A at offset ~A, part ~A" contsym endsym startsym (event-foff e) (part-name p)))))) + (error "Missing ending mark ~A or ~A for starting mark ~A at offset ~A, part ~A" contsym endsym startsym (event-foff e) (part-name p)))))) finally (or (= nu 0) (error "Missing starting mark ~A in part ~A" startsym (part-name p)))) (print-dot)))) (defun expand-marks (pts) Index: fomus/misc.lisp diff -u fomus/misc.lisp:1.1.1.1 fomus/misc.lisp:1.2 --- fomus/misc.lisp:1.1.1.1 Tue Jul 19 20:16:56 2005 +++ fomus/misc.lisp Sat Jul 23 11:23:14 2005 @@ -301,7 +301,7 @@ ;; slightly more complicated type checking (defun check-type* (obj type &optional er un lt) (flet ((get-error (x) - (apply #'format nil (first x) + (apply #'format nil (typecase (first x) (symbol (symbol-value (first x))) (otherwise (first x))) (mapcar (lambda (z) (if (truep z) obj (cond ((functionp z) (funcall z obj)) @@ -341,7 +341,7 @@ (o (if th se obj))) (unless (find o (cdr x) :test #'equal) (push o (cdr x)) - (check-type* obj se er un lt)))) + (check-type* obj (or th se) er un lt)))) (let* (mapcar (lambda (x) (push (cons (first x) (second x)) lt)) fi) (check-type* obj se er un lt)) (error* (let ((x (get-error ty))) (if er (error er x) (error x)))) (with-error* (if (or (stringp (first fi)) (check-type* obj (first fi) er un lt)) Index: fomus/package.lisp diff -u fomus/package.lisp:1.2 fomus/package.lisp:1.3 --- fomus/package.lisp:1.2 Thu Jul 21 17:38:43 2005 +++ fomus/package.lisp Sat Jul 23 11:23:14 2005 @@ -8,10 +8,6 @@ (eval-when (:compile-toplevel) (declaim (optimize (safety 3) (debug 3)))) -;; debug feature flag -(eval-when (:compile-toplevel :load-toplevel :execute) - (pushnew :debug *features*)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; PACKAGE @@ -57,7 +53,7 @@ (use-package "DBG" "FM"))) (defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 1)) +(defparameter +version+ '(0 1 2)) (defparameter +banner+ `("Lisp music notation formatter" "Copyright (c) 2005 David Psenicka, All Rights Reserved" Index: fomus/split.lisp diff -u fomus/split.lisp:1.1.1.1 fomus/split.lisp:1.2 --- fomus/split.lisp:1.1.1.1 Tue Jul 19 20:16:57 2005 +++ fomus/split.lisp Sat Jul 23 11:23:14 2005 @@ -233,7 +233,7 @@ (defparameter *dotted-note-level* t) ; can = (t or :all), :top or :sig for levels where dotted notes are allowed, nil = no dotted notes (defparameter *shortlongshort-notes-level* t) ; = (same as above) if special rhythmic patterns allowed (tied syncopations) -(defparameter *syncopated-notes-level* :top) ; b bah.. bah.. bah.. b +(defparameter *syncopated-notes-level* t) ; b bah.. bah.. bah.. b (defparameter *double-dotted-notes* t) ; = t if can use double dotted notes (defparameter *tuplet-dotted-rests* t) @@ -274,18 +274,18 @@ (make-sig :time (cons (* (rule-num rule) n) (rule-den rule)) :comp (rule-comp rule) :beat (rule-beat rule) :alt al :art ar :init in :irr (not ex) :comp (rule-comp rule)) (make-unit :div (if (rule-comp rule) 3 2) :tup nil :alt t :art t :init in :irr (not ex) :comp (rule-comp rule)))) - (snd (n tl tr) (if #|(> num (/ n))|# (if (rule-comp rule) (>= num (/ n)) (> num (/ n))) - (make-sig-nodiv :comp (rule-comp rule) :tlt tl :trt tr :comp (rule-comp rule)) - (make-unit-nodiv :tup nil :tlt tl :trt tr :comp (rule-comp rule))))) + (snd (n tl tr) (if (if (rule-comp rule) (>= num (/ n)) (> num (/ n))) #|(> num (/ n))|# + (make-sig-nodiv :comp (rule-comp rule) :tlt tl :trt tr :comp (rule-comp rule)) + (make-unit-nodiv :tup nil :tlt tl :trt tr :comp (rule-comp rule))))) (flet ((si (n wh al ar) ; n = division ratio, >1/4 or >3/8 comp. is designated with :sig, smaller durations become units (etypecase rule (initdiv (in n al ar nil)) - (sig (if #|(> num (/ n))|# (if (rule-comp rule) (>= num (/ n)) (> num (/ n))) - (make-sig :time (cons (* (rule-num rule) n) (rule-den rule)) :comp (rule-comp rule) :beat (rule-beat rule) - :alt (if (eq wh :l) (and (rule-alt rule) al) (and (rule-alt rule) (rule-art rule) al)) - :art (if (eq wh :r) (and (rule-art rule) ar) (and (rule-alt rule) (rule-art rule) ar)) - :irr (not ex) :comp (rule-comp rule)) - (make-unit :div 2 #|(if (rule-comp rule) 3 2)|# :tup nil :alt t :art t :irr (not ex) #|(or (rule-comp rule) (not ex))|# :comp (rule-comp rule))))))) + (sig (if (if (rule-comp rule) (>= num (/ n)) (> num (/ n))) #|(> num (/ n))|# + (make-sig :time (cons (* (rule-num rule) n) (rule-den rule)) :comp (rule-comp rule) :beat (rule-beat rule) + :alt (if (eq wh :l) (and (rule-alt rule) al) (and (rule-alt rule) (rule-art rule) al)) + :art (if (eq wh :r) (and (rule-art rule) ar) (and (rule-alt rule) (rule-art rule) ar)) + :irr (not ex) :comp (rule-comp rule)) + (make-unit :div 2 #|(if (rule-comp rule) 3 2)|# :tup nil :alt t :art t :irr (not ex) #|(or (rule-comp rule) (not ex))|# :comp (rule-comp rule))))))) (nconc (etypecase rule (initdiv (loop for ee in (force-list2 (rule-list rule)) @@ -304,7 +304,7 @@ (and (expof2 xx) (or (= num xx) (expof2 (- num xx))))) collect (in i la (or (null n) aa) ee))))))) (sig (loop - for nn in (or (lowmult num) (if (rule-comp rule) '(3) '(2))) + for nn in (or (lowmult (numerator num)) (if (rule-comp rule) '(3) '(2))) nconc (loop for j from 1 below nn for x = (/ j nn) ; x is the ratio @@ -324,13 +324,21 @@ (list (list 1/8 (si 1/8 :l t t) (snd 7/8 nil t)))))) (when (and (al *shortlongshort-notes-level*) (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule)) ex (or (not (rule-comp rule)) (>= num 4))) - (list (list '(1/4 3/4) (si 1/4 :l t t) (snd 1/2 t t) (si 1/4 :r t t)))) ; longer note in middle - (when (and (al *syncopated-notes-level*) (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule) (>= num 3)) + (list (list '(1/4 3/4) (si 1/4 :l t t) (snd 1/2 t t) (si 1/4 :r t t)))) ; longer note in middle + (when (and *syncopated-notes-level* (al :top) (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule) (>= num 3)) (not (rule-comp rule))) - (list (nconc (list (loop for i from 1/2 below num collect (/ i num)) ; regular off beat syncopation - (snd (/ 1/2 num) t nil)) - (make-list (1- num) :initial-element (snd (/ num) nil nil)) - (list (snd (/ 1/2 num) nil t))))) + (cond ((integerp num) + (list (nconc (list (loop for i from 1/2 below num collect (/ i num)) ; regular off beat syncopation + (snd (/ 1/2 num) t nil)) + (make-list (1- num) :initial-element (snd (/ num) nil nil)) + (list (snd (/ 1/2 num) nil t))))) + ((= (denominator num) 2) + (nconc (list (nconc (list (loop for i from 1 below num collect (/ i num))) ; regular off beat syncopation + (make-list (- num 1/2) :initial-element (snd (/ num) nil nil)) + (list (snd (/ 1/2 num) nil t)))) + (list (nconc (list (loop for i from 1/2 below num collect (/ i num)) ; regular off beat syncopation + (snd (/ 1/2 num) t nil)) + (make-list (- num 1/2) :initial-element (snd (/ num) nil nil)))))))) (when (and tups (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule))) (loop with nu = (if (rule-comp rule) (* num 3/2) num) @@ -366,7 +374,7 @@ (when *double-dotted-notes* (list (list 1/8 (un 1/8 :l t t) (und 7/8 nil t)))))) (when (and (al *shortlongshort-notes-level*) (rule-alt rule) (rule-art rule) ex) - (list (list '(1/4 3/4) (un 1/4 :l t t) (und 1/2 t t) (un 1/4 :r t t)))) ; longer note in middle + (list (list '(1/4 3/4) (un 1/4 :l t t) (und 1/2 t t) (un 1/4 :r t t)))) ; longer note in middle (when (and tups (or (initdivp rule) (rule-alt rule)) (or (initdivp rule) (rule-art rule))) (let ((l (length (force-list (rule-tup rule))))) (when (< l mn) Index: fomus/util.lisp diff -u fomus/util.lisp:1.2 fomus/util.lisp:1.3 --- fomus/util.lisp:1.2 Thu Jul 21 17:38:43 2005 +++ fomus/util.lisp Sat Jul 23 11:23:14 2005 @@ -183,7 +183,7 @@ for x = (let ((bb (* nb d))) (or (lookup bb *default-meas-divs*) (lookup bb +default-meas-divs+))) - when x do (return (mapcar (lambda (y) (/ y d)) x)))))))) + when x do (return (loop for y in x collect (mapcar (lambda (z) (/ z d)) y))))))))) (defparameter *effective-grace-dur-mul* 1/2) ; multiplier for effective duration of grace notes--use this in any algorithm that needs a small durational value for grace notes @@ -475,7 +475,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; CHECK SETTINGS -(defun check-settings-types () +(defun check-setting-types () (loop for (sy ty er) in +settings+ do (let ((v (symbol-value (find-symbol (conc-strings "*" (symbol-name sy) "*") :fomus)))) (or (check-type* v ty) (error "Found ~A, expected ~A in setting ~A" v (or er ty) sy)))))