[fomus-cvs] CVS update: fomus/accidentals.lisp fomus/backend_ly.lisp fomus/data.lisp fomus/main.lisp fomus/parts.lisp fomus/test.lisp fomus/version.lisp
David Psenicka
dpsenicka at common-lisp.net
Sat Nov 12 20:42:49 UTC 2005
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"
More information about the Fomus-cvs
mailing list