Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv1863

Modified Files: accidentals.lisp backend_ly.lisp data.lisp main.lisp parts.lisp test.lisp version.lisp Log Message: ... Date: Sat Nov 12 21:42:46 2005 Author: dpsenicka

Index: fomus/accidentals.lisp diff -u fomus/accidentals.lisp:1.11 fomus/accidentals.lisp:1.12 --- fomus/accidentals.lisp:1.11 Sat Nov 12 19:57:23 2005 +++ fomus/accidentals.lisp Sat Nov 12 21:42:46 2005 @@ -204,9 +204,13 @@ if (> (event-endoff (cdr e)) oo) ; endoff will = offset for grace notes! collect (cdr e) ; collect just the events else do (incf s (car e))) - (let ((a (loop-return-argmax (event-endoff (cdr e)) - for e of-type (cons #-openmcl (float 0) #+openmcl float note) in (nokeynode-evd no)))) - (when a (decf s (car a)) (list (cdr a))))))) + (let ((mx (loop for e of-type (cons #-openmcl (float 0) #+openmcl float note) in (nokeynode-evd no) + maximize (event-endoff (cdr e))))) + (setf s (nokeynode-sc no)) + (loop for e of-type (cons #-openmcl (float 0) #+openmcl float note) in (nokeynode-evd no) + if (>= (event-endoff (cdr e)) mx) + collect (cdr e) + else do (incf s (car e))))))) (c (cons w (let ((o (- oo mxd))) (remove-if (lambda (e) (declare (type noteex e)) @@ -281,7 +285,7 @@ (declare (ignorable keysigs)) (loop for e of-type partex in parts - unless (or (is-percussion e) (not (string= (part-name e) "Vln."))) + unless (is-percussion e) do (multiple-value-bind (evs rs) (split-list (part-events e) #'notep) (setf (part-events e) (sort (nconc rs

Index: fomus/backend_ly.lisp diff -u fomus/backend_ly.lisp:1.20 fomus/backend_ly.lisp:1.21 --- fomus/backend_ly.lisp:1.20 Sat Oct 22 22:43:06 2005 +++ fomus/backend_ly.lisp Sat Nov 12 21:42:46 2005 @@ -401,6 +401,8 @@ (loop repeat (length uu) collect "}"))) (cond ((or (getmark e :end8up-) (getmark e :8up)) " \octReset") ((or (getmark e :end8down-) (getmark e :8down)) " \octReset")))))) + (let ((b (getprop m :barline))) + (when b (format f "\bar "~A" " (lookup (second b) +lilypond-barlines+)))) (format f "| %~A~% ~A" mn (if nxm " " ""))) (if (< vce (1- nvce)) (format f "} \\~% ") (format f "}~% >>~%"))) (format f "}~%~%")

Index: fomus/data.lisp diff -u fomus/data.lisp:1.26 fomus/data.lisp:1.27 --- fomus/data.lisp:1.26 Fri Nov 11 23:03:16 2005 +++ fomus/data.lisp Sat Nov 12 21:42:46 2005 @@ -440,7 +440,7 @@ :accordion :harmonica :ukulele :mandolin :guitar :bass-guitar :soprano :mezzo-soprano :contralto :tenor :tenor-8dn :baritone :bass (:group :soprano-choir :alto-choir :tenor-choir :bass-choir) - (:group (:group :violin) (:group :viola) (:group :violoncello) (:group :contrabass))) + (:group (:group :violin) (:group :viola) (:group :cello) (:group :contrabass)))

(cons :small-ensemble (loop for e in +instruments+

Index: fomus/main.lisp diff -u fomus/main.lisp:1.18 fomus/main.lisp:1.19 --- fomus/main.lisp:1.18 Fri Nov 11 23:03:16 2005 +++ fomus/main.lisp Sat Nov 12 21:42:46 2005 @@ -189,7 +189,7 @@

(defun fomus-main () (find-cm) - (when (find :cmn (force-list2some *backend*) :key #'first) (find-cmn)) + (when (find :cmn (force-list2some *backend*) :key (lambda (x) (first (force-list x)))) (find-cmn)) (let ((r (fomus-proc))) (loop for x of-type (or symbol cons) in (force-list2some *backend*) do (let ((xx (force-list x)))

Index: fomus/parts.lisp diff -u fomus/parts.lisp:1.7 fomus/parts.lisp:1.8 --- fomus/parts.lisp:1.7 Wed Aug 31 23:17:59 2005 +++ fomus/parts.lisp Sat Nov 12 21:42:46 2005 @@ -119,60 +119,3 @@ (getprop l '(:endgroup 1))) (addprop f '(:startgroup 0)) ; add a global group if there isn't one (addprop l '(:endgroup 0))))))) - -;; (defun group-parts (pts) -;; (declare (type list pts)) -;; (labels ((nu (in sp tv &optional i) -;; (declare (type symbol in) (type (cons symbol list) sp) (type boolean tv) (type (or (integer 0) null) i)) -;; (loop -;; with fs = (unless (and tv (eq (the symbol (first sp)) :grandstaff)) (the symbol (first sp))) -;; for s of-type (or cons symbol) in (rest sp) -;; and j from 0 -;; if (consp s) -;; do (let ((l (nu in s tv j))) -;; (when l (return (cons (cons i fs) l)))) -;; else if (eq in s) do (return (list (cons i fs)))))) -;; (let ((gs nil)) ; in the middle of grandstaff? -;; (flet ((en (p l ty) -;; (declare (type partex p) (type (integer 1) l) (type symbol ty)) -;; (if (and (getprop p (list :startgroup l)) (not gs)) ; eliminate 1-staff braces -;; (rmprop p (list :startgroup l)) -;; (addprop p (list :endgroup l))) -;; (when (eq ty :grandstaff) (setf gs nil))) -;; (ad (p l ty) -;; (declare (type partex p) (type (integer 1) l) (type symbol ty)) -;; (addprop p (list :startgroup l ty)) -;; (when (eq ty :grandstaff) (setf gs t)))) -;; (loop -;; for (lp p) of-type ((or part null) part) on (cons nil pts) and ii downfrom -1 -;; and l = g -;; for g = (when p (or (rest (nu (instr-sym (part-instr p)) (cons nil (instr-groups)) (<= (instr-staves (part-instr p)) 1))) -;; (if (> (instr-staves (part-instr p)) 1) -;; (list (cons ii :grandstaff)) -;; (list (cons ii nil))))) -;; do -;; (loop -;; for ll on l and gg on g and i from 1 -;; while (equal (the (cons integer symbol) (first ll)) (the (cons integer symbol) (first gg))) -;; finally -;; (loop -;; for l on ll and g on gg and j from i -;; do -;; (let ((x (cdr (the (cons * symbol) (first l))))) (when (or x gs) (en lp j x))) -;; (let ((x (cdr (the (cons * symbol) (first g))))) (when x (ad p j x))) -;; finally -;; (loop -;; for ll on l and k from j -;; do (let ((x (cdr (the (cons * symbol) (first ll))))) (when (or x gs) (en lp k x)))) -;; (loop -;; for gg on g and k from j -;; do (let ((x (cdr (the (cons * symbol) (first gg))))) (when x (ad p k x)))))) -;; (print-dot)) -;; (let ((f (first pts)) -;; (l (last-element pts))) -;; (declare (type partex f l)) -;; (unless (and (getprop f '(:startgroup 1)) -;; (notany (lambda (p) (declare (type partex p)) (getprop p '(:startgroup 1))) (rest pts)) -;; (getprop l '(:endgroup 1))) -;; (addprop f '(:startgroup 0)) ; add a global group if there isn't one -;; (addprop l '(:endgroup 0))))))))

Index: fomus/test.lisp diff -u fomus/test.lisp:1.19 fomus/test.lisp:1.20 --- fomus/test.lisp:1.19 Sat Oct 22 22:43:06 2005 +++ fomus/test.lisp Sat Nov 12 21:42:46 2005 @@ -129,7 +129,7 @@

(fomus :backend '((:data) (:lilypond :view t)) - :ensemble-type :small-ensemble + :ensemble-type :orchestra :parts (list (make-part :name "Piano 1" @@ -154,6 +154,22 @@ (make-part :name "Clarinet 2" :instr :bf-clarinet + :events (list (make-note :off 4 :dur 1 :note 60))) + (make-part + :name "Violin" + :instr :violin + :events (list (make-note :off 4 :dur 1 :note 60))) + (make-part + :name "Violin" + :instr :violin + :events (list (make-note :off 4 :dur 1 :note 60))) + (make-part + :name "Cello" + :instr :cello + :events (list (make-note :off 4 :dur 1 :note 60))) + (make-part + :name "Cello" + :instr :cello :events (list (make-note :off 4 :dur 1 :note 60))) (make-part :name "Tuba"

Index: fomus/version.lisp diff -u fomus/version.lisp:1.19 fomus/version.lisp:1.20 --- fomus/version.lisp:1.19 Sat Nov 12 19:57:59 2005 +++ fomus/version.lisp Sat Nov 12 21:42:46 2005 @@ -12,7 +12,7 @@ (declaim (type string +title+) (type cons +version+ +banner+)) (defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 24)) +(defparameter +version+ '(0 1 25)) (defparameter +banner+ `("Lisp music notation formatter" "Copyright (c) 2005 David Psenicka, All Rights Reserved"