gsharp-cvs

gsharp-cvs@common-lisp.net

396 discussions

[gsharp-cvs] CVS gsharp
by rstrandh 16 Nov '08

16 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv1372 Modified Files: sdl.lisp Log Message: Time signature digit 4. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/15 18:22:23 1.39 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/16 06:36:03 1.40 @@ -1831,3 +1831,82 @@ pj right ++ pk up ++ pl left ++ pm down ++ pn down ++ po left ++ pp up ++ pq right ++ pr down (tensions 0.75 10) ps down (tensions 10 0.75) pt down ++ cycle))))) + +;;; +;;; +;;; +;;; k l +;;; ************* - +;;; j*************m | +;;; ************* | +;;; ************* | +;;; ************ | +;;; ************ | +;;; *********** *** | +;;; **********n t****v | +;;; ********* ****** | +;;; ******** ******** | +;;; i******* s********** | h2 +;;; ****** ********** | +;;; ***** ********** | +;;; ***** r**********w | +;;; ******o p ********** | +;;; ****************************** | +;;; h*********************************x | +;;; ****************************** - | +;;; g f e**********y | | +;;; d**************** | | +;;; c -**********************z | h1 | +;;; ********************** _| _| +;;; b a aa +;;; +;;; |_ _| +;;; w2 +;;; |_________| +;;; w1 +;;; + +(defmethod compute-design ((font font) (shape (eql :time-signature-4))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + yoffset) + font + (flet ((c (x y) (complex x y))) + (let* (;; This symbol should sit on top of a staff line + (ya (+ (/ slt 2) yoffset)) + ;; Its top should hang under the staff line + (h2 (- (* 2 sld) slt)) + (xa (round (* 0.02 h2))) + (h1 (round (* 0.15 h2))) + (w1 (round (* 0.25 h2))) + (w2 (round (* 0.14 h2))) + (pa (c xa ya)) + (pb (c (- xa (* 0.90 w1)) ya)) + (pc (c (- xa w1) (+ ya (* 0.25 h1)))) + (pd (+ pb (c 0 (* 1/2 h1)))) + (pe (c (- xa w2) (+ ya (* 0.75 h1)))) + (pf (+ pd (c 0 (* 1/2 h1)))) + (pg (c (* -0.45 h2) (+ ya h1))) + (ph (c (* -0.47 h2) (+ ya (* 1.1 h1)))) + (ppi (c (* -0.38 h2) (+ ya (* 0.5 h2)))) + (pj (c (* -0.20 h2) (+ ya (* 0.95 h2)))) + (pk (c (* -0.12 h2) (+ ya h2))) + (pl (c (* 0.17 h2) (+ ya h2))) + (pm (c (* 0.17 h2) (+ ya (* 0.9 h2)))) + (pn (c (* -0.1 h2) (+ ya (* 0.55 h2)))) + (po (c (* -0.35 h2) (+ ya (* 1.75 h1)))) + (pp (c (* -0.3 h2) (+ ya (* 1.5 h1)))) + (pr (c (- xa w2) (+ ya (* 2.2 h1)))) + (ps (c (- xa w2) (+ ya (* 2.5 h1)))) + (pt (c (+ xa (* 0.70 w2)) (+ ya (* 0.65 h2)))) + (pv (c (+ xa w2) (+ ya (* 0.65 h2)))) + (pw (c (+ xa w2) (+ ya (* 2.0 h1)))) + (px (c (+ xa w1) (+ ya (* 1.1 h1)))) + (py (c (+ xa w2) (+ ya (* 0.75 h1)))) + (pz (c (+ xa w1) (+ ya (* 0.25 h1)))) + (paa (c (+ xa (* 0.90 w1)) ya))) + (mf pa -- pb left ++ pc up ++ pd right ++ pe up ++ left pf -- + pg left ++ ph ++ ppi (tensions 1 3) pj ++ right pk -- pl right ++ pm ++ + pn (tensions 1 5) po down ++ pp right ++ pr up ++ up ps -- pt + (direction (- pt ps)) ++ down pv -- pw down ++ px down ++ + py down ++ pz down ++ left paa -- cycle))))) \ No newline at end of file

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 15 Nov '08

15 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv7755 Modified Files: sdl.lisp Log Message: Time signature digit 3. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/15 17:20:07 1.38 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/15 18:22:23 1.39 @@ -1757,4 +1757,77 @@ p5 left ++ p6 down (tensions 3 1) p7 down ++ p8 left ++ p9 up ++ p10 right ++ p11 down (tensions 1 3) p12 down (tensions 3 1) p13 right (tensions 1 3) p14 (tensions 3 1) cycle))))) - \ No newline at end of file + +;;; +;;; w2 +;;; _________ +;;; | | +;;; q _ +;;; ********** | +;;; ************** | +;;; *****m l ******** | +;;; ******* ******* | +;;; p*********n k********r | +;;; ******* ******** | +;;; *** j ******* | +;;; o | ******** | +;;; ii-*************s | +;;; ************* | h1 +;;; c | ******** | +;;; *** h ******* | +;;; ******* ******** | +;;; ********* ********* | +;;; b - ***********d g********* t | +;;; ********* f ******** | +;;; ******- e| ******** | +;;; **************** | +;;; ************ _| +;;; | +;;; a +;;; +;;; |___________| +;;; w1 +;;; +;;; +;;; + +(defmethod compute-design ((font font) (shape (eql :time-signature-3))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + yoffset) + font + (flet ((c (x y) (complex x y))) + (let* (;; This symbol should sit have its lowest point + ;; at the bottom of the staff line + (ya (+ (- (/ slt 2)) yoffset)) + ;; it should have its top at the lower edge of the staff line + (h1 (* 2 sld)) + (h2 (* 0.25 h1)) + (h3 (* 0.75 h1)) + (w1 (round (* 0.38 h1))) + (w2 (round (* 0.33 h1))) + (pa (c (* -0.1 w1) ya)) + (pb (c (- w1) (+ ya h2))) + (pc (c (* -0.6 w1) (+ ya (min (1- sld) (round (* 0.4 h1)))))) + (pd (c (round (* -0.2 w1)) (+ ya h2))) + (pe (c (* -0.5 w1) (+ ya (* 2.1 slt)))) + (pf (c (* -0.1 w1) (+ ya slt))) + (pg (c (* 0.2 w1) (+ ya h2))) + (ph (c (* -0.1 w1) (+ ya sld))) + (pii (c (* -0.7 w1) (+ ya sld (* 0.5 slt)))) + (pj (+ ph (c 0 slt))) + (pk (c (* 0.18 w1) (+ ya h3))) + (pl (c (* -0.1 w1) (+ ya (round (* 0.88 h1))))) + (pm (c (* -0.3 w1) (+ ya (round (* 0.85 h1))))) + (pn (c (round (* -0.2 w1)) (+ ya h3))) + (po (c (* -0.55 w1) (+ ya (max (1+ sld) (* 0.6 h1))))) + (pp (c (- w2) (+ ya h3))) + (pq (c 0 (+ ya h1))) + (pr (c w2 h3)) + (ps (c (* 0.5 w1) (+ ya sld (* 0.5 slt)))) + (pt (c w1 (+ ya h2)))) + (mf pa left ++ pb up ++ pc right ++ pd down ++ pe down ++ + pf right ++ pg up ++ ph left (tensions 1 5) pii up (tensions 5 1) + pj right ++ pk up ++ pl left ++ pm down ++ pn down ++ + po left ++ pp up ++ pq right ++ pr down (tensions 0.75 10) + ps down (tensions 10 0.75) pt down ++ cycle)))))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 15 Nov '08

15 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv27296 Modified Files: sdl.lisp Log Message: Time signature digits 1 and 2. --- /project/gsharp/cvsroot/gsharp/sdl.lisp 2007/09/18 21:19:03 1.37 +++ /project/gsharp/cvsroot/gsharp/sdl.lisp 2008/11/15 17:20:07 1.38 @@ -1610,3 +1610,151 @@ (climi::close-path (mf #c(0 0) -- (complex 16 0) -- (complex 0 -1) -- #c(0 0)))) +;;; w3 +;;; ___________ +;;; | | +;;; +;;; 9 *** 10 ** -11 - +;;; ********** -12 | +;;; *********** | +;;; 8- ************ | +;;; ************* | +;;; ************** | +;;; *************** | +;;; ***6/ ********** | +;;; ** / ********** | +;;; 7 5 ********** | +;;; ********** | h2 +;;; ********** | +;;; ********** | +;;; ********** | +;;; ********** | +;;; ********** | +;;; ********** | +;;; 4 -**********- 13 | +;;; 3 ********** 14 - | +;;; \ **************** / | | +;;; 2 -**********************- 15 | h1 | +;;; ********************** _| _| +;;; | | | +;;; 1 0 16 +;;; +;;; +;;; |___| +;;; w1 +;;; +;;; |_________| +;;; w2 + +(defmethod compute-design ((font font) (shape (eql :time-signature-1))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + yoffset) + font + (flet ((c (x y) (complex x y))) + (let* (;; This symbol should sit on top of a staff line + (y0 (+ (/ slt 2) yoffset)) + (p0 (c 0 y0)) + ;; if the little notch is to be visible, the top + ;; of this character should hang below the upper staff line. + (h2 (- (* 2 sld) slt)) + ;; w1 and w2 should be integers in to avoid fuzziness + (w1 (round (* 0.14 h2))) + (w2 (round (* 0.25 h2))) + (h1 (* 0.5 w2)) + (p1 (- p0 (* 0.9 w2))) + (p2 (c (- w2) (+ y0 (* h1 0.25)))) + (p3 (+ p1 (c 0 (+ y0 (* h1 0.5))))) + (p4 (c (- w1) (+ y0 (* h1 1.2)))) + (p5 (c (- w1) (+ y0 (* h2 0.62)))) + (p6 (c (- (* w1 1.09)) (+ y0 (* h2 0.65)))) + (p7 (c (- (* w2 1.3)) (+ y0 (* h2 0.52)))) + (p8 (c (- (* w1 1.23)) (+ y0 (* h2 0.85)))) + (p9 (c (- (* w1 0.91)) (+ y0 h2))) + (p10 (c (* w1 0.18) (+ y0 (* h2 0.97)))) + (p11 (c w1 (+ y0 (* h2 0.98)))) + (p12 (c w1 (+ y0 (* h2 0.96)))) + (p13 (c w1 (imagpart p4))) + (p14 (c (- (realpart p3)) (imagpart p3))) + (p15 (c w2 (imagpart p2))) + (p16 (c (- (realpart p1)) (imagpart p1)))) + (mf p0 -- p1 left ++ p2 up ++ p3 ++ up p4 -- p5 up ++ + p6 (tensions 2 3) p7 (tensions 4 1) + p8 (tensions 1 2) + p9 (tensions 2 2) p10 ++ p11 ++ down p12 -- p13 down ++ + p14 ++ p15 down ++ left p16 -- cycle))))) + + +;;; +;;; w2 +;;; __________ +;;; | | +;;; 10 +;;; | _ +;;; ********* | +;;; ************** | +;;; ****************** | +;;; ****-6 | ********** | +;;; 9 -****** 5 ********** | +;;; *******-7 4-*********-11 | +;;; ****** ********* | +;;; *** ********* | +;;; | ******** | +;;; 8 ******* | +;;; ***** 14 | +;;; ***** | | h1 +;;; *****-12 13 * | +;;; ******* | ** _ | +;;; ********************** | | +;;; *********************** | | +;;; _ *********************** | | +;;; | **** | ************* | h2 | +;;; | 3 -*** 1 *********** | | +;;; h3 | ** ******** | | +;;; |_ \ ***** _| _| +;;; 2 | +;;; 0 +;;; +;;; +;;; +;;; |__________| +;;; w1 +;;; + +(defmethod compute-design ((font font) (shape (eql :time-signature-2))) + (with-slots ((sld staff-line-distance) + (slt staff-line-thickness) + yoffset) + font + (flet ((c (x y) (complex x y))) + (let* (;; This symbol should sit have its lowest point + ;; at the bottom of the staff line + (y0 (+ (- (/ slt 2)) yoffset)) + ;; it should have its top at the lower edge of the staff line + (h1 (* 2 sld)) + (h2 (round (* 0.20 h1))) + (h3 (* 0.14 h1)) + (h4 (* 0.65 h1)) + (w1 (round (* 0.38 h1))) + (w2 (round (* 0.33 h1))) + (w3 (round (* 0.6 w2))) + (p0 (c (* 0.1 w1) y0)) + (p1 (c (- (* 0.5 w1)) (+ y0 h3))) + (p2 (c (- (* 0.9 w1)) (+ y0 slt))) + (p3 (c (- w1) (+ y0 (* 0.5 h3)))) + (p4 (c (round (* 0.2 w1)) (+ y0 h4))) + (p5 (c (- (* 0.1 w1)) (+ y0 (round (* 0.88 h1))))) + (p6 (c (- w3) (+ y0 (* 0.78 h1)))) + (p7 (c (- (* 0.2 w1)) (+ y0 h4))) + (p8 (c (- w3) (+ y0 (round (* 0.53 h1))))) + (p9 (c (- w2) (+ y0 (* 0.7 h1)))) + (p10 (c 0 (+ y0 h1))) + (p11 (c w2 h4)) + (p12 (c (- (* 0.01 w1)) (* 0.3 h1))) + (p13 (c (* 0.5 w1) h2)) + (p14 (c w1 (* 0.3 h1)))) + (mf p0 left ++ p1 left ++ p2 left ++ p3 up ++ p4 up (tensions 3 1) + p5 left ++ p6 down (tensions 3 1) p7 down ++ p8 left ++ p9 up ++ + p10 right ++ p11 down (tensions 1 3) p12 down (tensions 3 1) p13 right (tensions 1 3) + p14 (tensions 3 1) cycle))))) + \ No newline at end of file

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 15 Nov '08

15 Nov '08

Update of /project/gsharp/cvsroot/gsharp In directory cl-net:/tmp/cvs-serv27245 Modified Files: mf.lisp Log Message: Make it possible to use cycle after --. --- /project/gsharp/cvsroot/gsharp/mf.lisp 2007/07/17 06:36:32 1.2 +++ /project/gsharp/cvsroot/gsharp/mf.lisp 2008/11/15 17:19:38 1.3 @@ -136,8 +136,10 @@ (setf (curl (right-context x)) (slot-value y 'curl)) (setf (direction (right-context x)) (slot-value y 'direction))) (if (typep y 'curl) - (setf (curl (left-context z)) (slot-value y 'curl)) - (setf (direction (left-context z)) (slot-value y 'direction))))))) + (setf (curl (left-context (if (eq z *cycle*) (car path) z))) + (slot-value y 'curl)) + (setf (direction (left-context (if (eq z *cycle*) (car path) z))) + (slot-value y 'direction))))))) (defun propagate-tensions-controls (path) (loop for (x y z) on path

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 29 Apr '08

29 Apr '08

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv15652 Modified Files: modes.lisp Log Message: Removed all the :shift modifiers because they are no longer necessary thanks to Troels Henriksen fixing McCLIM. --- /project/gsharp/cvsroot/gsharp/modes.lisp 2008/02/09 16:58:35 1.28 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2008/04/29 07:54:24 1.29 @@ -23,8 +23,8 @@ (set-key 'com-insert-barline 'global-gsharp-table '(#\|)) -(set-key 'com-end-of-score 'global-gsharp-table '((#\> :shift :meta))) -(set-key 'com-beginning-of-score 'global-gsharp-table '((#\< :shift :meta))) +(set-key 'com-end-of-score 'global-gsharp-table '((#\> :meta))) +(set-key 'com-beginning-of-score 'global-gsharp-table '((#\< :meta))) ;;; FIXME where are the corresponding commands? (set-key 'com-left 'global-gsharp-table '((#\l :meta))) @@ -61,8 +61,8 @@ (set-key 'com-insert-keysig 'melody-table '(#\K)) (set-key 'com-more-sharps 'melody-table '((#\# :meta))) -(set-key 'com-more-sharps 'melody-table '((#\# :meta :shift))) -(set-key 'com-more-flats 'melody-table '((#\@ :meta :shift))) +(set-key 'com-more-sharps 'melody-table '((#\# :meta))) +(set-key 'com-more-flats 'melody-table '((#\@ :meta))) ;;; the rhythmic table contains command that are specific ;;; to rhythmic elements @@ -88,9 +88,9 @@ (set-key 'com-sharper 'cluster-table '((#\#))) (set-key 'com-flatter 'cluster-table '(#\@)) (set-key 'com-microsharper 'cluster-table '((#\# :control))) -(set-key 'com-microsharper 'cluster-table '((#\# :control :shift))) ;; mcclim bug workaround +(set-key 'com-microsharper 'cluster-table '((#\# :control))) +(set-key 'com-microflatter 'cluster-table '((#\@ :control))) (set-key 'com-microflatter 'cluster-table '((#\@ :control))) -(set-key 'com-microflatter 'cluster-table '((#\@ :control :shift))) ;; mcclim bug workaround (set-key 'com-add-note-c 'cluster-table '(#\C)) (set-key 'com-add-note-d 'cluster-table '(#\D)) (set-key 'com-add-note-e 'cluster-table '(#\E)) @@ -107,8 +107,8 @@ (set-key 'com-toggle-tenuto 'cluster-table '(#\t)) (set-key 'com-current-increment 'cluster-table '((#\p))) (set-key 'com-current-decrement 'cluster-table '((#\n))) -(set-key 'com-octave-up 'cluster-table '((#\U :shift :meta))) -(set-key 'com-octave-down 'cluster-table '((#\D :shift :meta))) +(set-key 'com-octave-up 'cluster-table '((#\U :meta))) +(set-key 'com-octave-down 'cluster-table '((#\D :meta))) ;;; lyrics mode table @@ -134,67 +134,67 @@ do (set-key (make-insert-fun i) 'lyrics-table`((,c)))) ;;; try some latin prefix mode for national characters -(set-key (make-insert-fun 192) 'lyrics-table '((:dead--grave) (#\A :shift))) -(set-key (make-insert-fun 193) 'lyrics-table '((:dead--acute) (#\A :shift))) -(set-key (make-insert-fun 194) 'lyrics-table '((:dead--circumflex :shift) (#\A :shift))) -(set-key (make-insert-fun 195) 'lyrics-table '((:dead--tilde :shift) (#\A :shift))) -(set-key (make-insert-fun 196) 'lyrics-table '((:dead--diaeresis :shift) (#\A :shift))) -(set-key (make-insert-fun 197) 'lyrics-table '((:dead-above-ring) (#\A :shift))) -(set-key (make-insert-fun 198) 'lyrics-table '((:dead-above-ring) (#\E :shift))) -(set-key (make-insert-fun 199) 'lyrics-table '((:dead-above-ring) (#\C :shift))) -(set-key (make-insert-fun 200) 'lyrics-table '((:dead--grave) (#\E :shift))) -(set-key (make-insert-fun 201) 'lyrics-table '((:dead--acute) (#\E :shift))) -(set-key (make-insert-fun 202) 'lyrics-table '((:dead--circumflex :shift) (#\E :shift))) -(set-key (make-insert-fun 203) 'lyrics-table '((:dead--diaeresis :shift) (#\E :shift))) -(set-key (make-insert-fun 204) 'lyrics-table '((:dead--grave) (#\I :shift))) -(set-key (make-insert-fun 205) 'lyrics-table '((:dead--acute) (#\I :shift))) -(set-key (make-insert-fun 206) 'lyrics-table '((:dead--circumflex :shift) (#\I :shift))) -(set-key (make-insert-fun 207) 'lyrics-table '((:dead--diaeresis :shift) (#\I :shift))) -(set-key (make-insert-fun 208) 'lyrics-table '((:dead-above-ring) (#\D :shift))) -(set-key (make-insert-fun 209) 'lyrics-table '((:dead--tilde :shift) (#\N :shift))) -(set-key (make-insert-fun 210) 'lyrics-table '((:dead--grave) (#\O :shift))) -(set-key (make-insert-fun 211) 'lyrics-table '((:dead--acute) (#\O :shift))) -(set-key (make-insert-fun 212) 'lyrics-table '((:dead--circumflex :shift) (#\O :shift))) -(set-key (make-insert-fun 213) 'lyrics-table '((:dead--tilde :shift) (#\O :shift))) -(set-key (make-insert-fun 214) 'lyrics-table '((:dead--diaeresis :shift) (#\O :shift))) - -(set-key (make-insert-fun 216) 'lyrics-table '((:dead-above-ring) (#\O :shift))) -(set-key (make-insert-fun 217) 'lyrics-table '((:dead--grave) (#\U :shift))) -(set-key (make-insert-fun 218) 'lyrics-table '((:dead--acute) (#\U :shift))) -(set-key (make-insert-fun 219) 'lyrics-table '((:dead--circumflex :shift) (#\U :shift))) -(set-key (make-insert-fun 220) 'lyrics-table '((:dead--diaeresis :shift) (#\U :shift))) -(set-key (make-insert-fun 221) 'lyrics-table '((:dead--acute) (#\Y :shift))) +(set-key (make-insert-fun 192) 'lyrics-table '((:dead--grave) (#\A))) +(set-key (make-insert-fun 193) 'lyrics-table '((:dead--acute) (#\A))) +(set-key (make-insert-fun 194) 'lyrics-table '((:dead--circumflex) (#\A))) +(set-key (make-insert-fun 195) 'lyrics-table '((:dead--tilde) (#\A))) +(set-key (make-insert-fun 196) 'lyrics-table '((:dead--diaeresis) (#\A))) +(set-key (make-insert-fun 197) 'lyrics-table '((:dead-above-ring) (#\A))) +(set-key (make-insert-fun 198) 'lyrics-table '((:dead-above-ring) (#\E))) +(set-key (make-insert-fun 199) 'lyrics-table '((:dead-above-ring) (#\C))) +(set-key (make-insert-fun 200) 'lyrics-table '((:dead--grave) (#\E))) +(set-key (make-insert-fun 201) 'lyrics-table '((:dead--acute) (#\E))) +(set-key (make-insert-fun 202) 'lyrics-table '((:dead--circumflex) (#\E))) +(set-key (make-insert-fun 203) 'lyrics-table '((:dead--diaeresis) (#\E))) +(set-key (make-insert-fun 204) 'lyrics-table '((:dead--grave) (#\I))) +(set-key (make-insert-fun 205) 'lyrics-table '((:dead--acute) (#\I))) +(set-key (make-insert-fun 206) 'lyrics-table '((:dead--circumflex) (#\I))) +(set-key (make-insert-fun 207) 'lyrics-table '((:dead--diaeresis) (#\I))) +(set-key (make-insert-fun 208) 'lyrics-table '((:dead-above-ring) (#\D))) +(set-key (make-insert-fun 209) 'lyrics-table '((:dead--tilde) (#\N))) +(set-key (make-insert-fun 210) 'lyrics-table '((:dead--grave) (#\O))) +(set-key (make-insert-fun 211) 'lyrics-table '((:dead--acute) (#\O))) +(set-key (make-insert-fun 212) 'lyrics-table '((:dead--circumflex) (#\O))) +(set-key (make-insert-fun 213) 'lyrics-table '((:dead--tilde) (#\O))) +(set-key (make-insert-fun 214) 'lyrics-table '((:dead--diaeresis) (#\O))) + +(set-key (make-insert-fun 216) 'lyrics-table '((:dead-above-ring) (#\O))) +(set-key (make-insert-fun 217) 'lyrics-table '((:dead--grave) (#\U))) +(set-key (make-insert-fun 218) 'lyrics-table '((:dead--acute) (#\U))) +(set-key (make-insert-fun 219) 'lyrics-table '((:dead--circumflex) (#\U))) +(set-key (make-insert-fun 220) 'lyrics-table '((:dead--diaeresis) (#\U))) +(set-key (make-insert-fun 221) 'lyrics-table '((:dead--acute) (#\Y))) (set-key (make-insert-fun 224) 'lyrics-table '((:dead--grave) (#\a))) (set-key (make-insert-fun 225) 'lyrics-table '((:dead--acute) (#\a))) -(set-key (make-insert-fun 226) 'lyrics-table '((:dead--circumflex :shift) (#\a))) -(set-key (make-insert-fun 227) 'lyrics-table '((:dead--tilde :shift) (#\a))) -(set-key (make-insert-fun 228) 'lyrics-table '((:dead--diaeresis :shift) (#\a))) +(set-key (make-insert-fun 226) 'lyrics-table '((:dead--circumflex) (#\a))) +(set-key (make-insert-fun 227) 'lyrics-table '((:dead--tilde) (#\a))) +(set-key (make-insert-fun 228) 'lyrics-table '((:dead--diaeresis) (#\a))) (set-key (make-insert-fun 229) 'lyrics-table '((:dead-above-ring) (#\a))) (set-key (make-insert-fun 230) 'lyrics-table '((:dead-above-ring) (#\e))) -(set-key (make-insert-fun 231) 'lyrics-table '((:dead--tilde :shift) (#\c))) +(set-key (make-insert-fun 231) 'lyrics-table '((:dead--tilde) (#\c))) (set-key (make-insert-fun 232) 'lyrics-table '((:dead--grave) (#\e))) (set-key (make-insert-fun 233) 'lyrics-table '((:dead--acute) (#\e))) -(set-key (make-insert-fun 234) 'lyrics-table '((:dead--circumflex :shift) (#\e))) -(set-key (make-insert-fun 235) 'lyrics-table '((:dead--diaeresis :shift) (#\e))) +(set-key (make-insert-fun 234) 'lyrics-table '((:dead--circumflex) (#\e))) +(set-key (make-insert-fun 235) 'lyrics-table '((:dead--diaeresis) (#\e))) (set-key (make-insert-fun 236) 'lyrics-table '((:dead--grave) (#\i))) (set-key (make-insert-fun 237) 'lyrics-table '((:dead--acute) (#\i))) -(set-key (make-insert-fun 238) 'lyrics-table '((:dead--circumflex :shift) (#\i))) -(set-key (make-insert-fun 239) 'lyrics-table '((:dead--diaeresis :shift) (#\i))) +(set-key (make-insert-fun 238) 'lyrics-table '((:dead--circumflex) (#\i))) +(set-key (make-insert-fun 239) 'lyrics-table '((:dead--diaeresis) (#\i))) (set-key (make-insert-fun 242) 'lyrics-table '((:dead--grave) (#\o))) (set-key (make-insert-fun 243) 'lyrics-table '((:dead--acute) (#\o))) -(set-key (make-insert-fun 244) 'lyrics-table '((:dead--circumflex :shift) (#\o))) -(set-key (make-insert-fun 245) 'lyrics-table '((:dead--tilde :shift) (#\o))) -(set-key (make-insert-fun 246) 'lyrics-table `((:dead--diaeresis :shift) (#\o))) +(set-key (make-insert-fun 244) 'lyrics-table '((:dead--circumflex) (#\o))) +(set-key (make-insert-fun 245) 'lyrics-table '((:dead--tilde) (#\o))) +(set-key (make-insert-fun 246) 'lyrics-table `((:dead--diaeresis) (#\o))) (set-key (make-insert-fun 248) 'lyrics-table '((:dead-above-ring) (#\o))) (set-key (make-insert-fun 249) 'lyrics-table '((:dead--grave) (#\u))) (set-key (make-insert-fun 250) 'lyrics-table '((:dead--acute) (#\u))) -(set-key (make-insert-fun 251) 'lyrics-table '((:dead--circumflex :shift) (#\u))) -(set-key (make-insert-fun 252) 'lyrics-table '((:dead--diaeresis :shift) (#\u))) +(set-key (make-insert-fun 251) 'lyrics-table '((:dead--circumflex) (#\u))) +(set-key (make-insert-fun 252) 'lyrics-table '((:dead--diaeresis) (#\u))) (set-key (make-insert-fun 253) 'lyrics-table '((:dead--acute) (#\y))) -(set-key (make-insert-fun 255) 'lyrics-table '((:dead--diaeresis :shift) (#\y))) +(set-key (make-insert-fun 255) 'lyrics-table '((:dead--diaeresis) (#\y)))

1 0

[gsharp-cvs] CVS gsharp/Mxml
by crhodes 09 Feb '08

09 Feb '08

Update of /project/gsharp/cvsroot/gsharp/Mxml In directory clnet:/tmp/cvs-serv21297 Modified Files: mxml.lisp Log Message: MusicXML support for staccato and tenuto import and export. --- /project/gsharp/cvsroot/gsharp/Mxml/mxml.lisp 2008/02/09 18:21:00 1.7 +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml.lisp 2008/02/09 18:43:13 1.8 @@ -201,6 +201,8 @@ (remove-if #'(lambda (s) (not (typep s 'fiveline-staff))) staves))) (elt melody-staves (parse-mxml-note-staff-number note)))) +(defvar *parsing-in-cluster*) + (defun parse-mxml-pitched-note (note staves) (let* ((staff (parse-mxml-note-staff note staves)) (step (named-pcdata note "step")) @@ -213,11 +215,16 @@ (estringcase (dom:get-attribute tie "type") ("start" (setf tie-right t)) ("stop" (setf tie-left t)))) + (for-named-elements ("staccato" stacc note) + (declare (ignore stacc)) + (pushnew :staccato (annotations *parsing-in-cluster*))) + (for-named-elements ("tenuto" ten note) + (declare (ignore ten)) + (pushnew :tenuto (annotations *parsing-in-cluster*))) (make-instance 'note :pitch pitch :staff staff :accidentals accidentals :tie-left tie-left :tie-right tie-right))) (defvar *parsing-duration-gmeasure-position*) -(defvar *parsing-in-cluster*) (defvar *mxml-divisions*) (defun parse-mxml-note (xnote bars staves lyrics-layer-hash) ;; TODO: There is nothing in MusicXML that stops you from having @@ -1011,18 +1018,14 @@ (defmethod make-xml-element ((cluster cluster) voice) ;; this maybe should get called earlier. or later. i don't know. (gsharp-measure::compute-final-accidentals (notes cluster)) - (let ((duration (calculate-duration cluster)) - (type (rhythmic-element-type cluster)) - (dots (dots cluster))) - + (let ((duration (calculate-duration cluster))) (loop for note in (notes cluster) - for x from 0 - do (make-xml-note note (> x 0) type dots duration voice)) - + for x from 0 + do (make-xml-note note (> x 0) duration voice cluster)) (when (null (notes cluster)) - ;; it's an empty cluster, a "space" + ;; it's an empty cluster, a "space" (cxml:with-element "forward" - (cxml:text (write-to-string duration)))))) + (cxml:text (write-to-string duration)))))) (defmethod make-xml-element ((lyric lyrics-element) voice) (let ((duration (calculate-duration lyric)) @@ -1067,29 +1070,47 @@ (let ((step (mod pitch 7))) (list (car (rassoc step *step-to-basenote*)) (/ (- pitch step) 7)))) -(defun make-xml-note (note in-chord type dots duration voice) - (let ((pitch (gshnote-to-xml (pitch note))) - (accidental (ecase (final-accidental note) - ((nil)) - (:sharp "sharp") - (:natural "natural") - (:flat "flat") - (:double-sharp "double-sharp") - (:sesquisharp "three-quarters-sharp") - (:semisharp "quarter-sharp") - (:semiflat "quarter-flat") - (:sesquiflat "three-quarters-flat") - (:double-flat "flat-flat"))) - (alter (ecase (accidentals note) - (:sharp "1") - (:natural nil) - (:flat "-1") - (:double-sharp "2") - (:sesquisharp "1.5") - (:semisharp "0.5") - (:semiflat "-0.5") - (:sesquiflat "-1.5") - (:double-flat "-2")))) +(defun note-accidental (note) + (ecase (final-accidental note) + ((nil)) + (:sharp "sharp") + (:natural "natural") + (:flat "flat") + (:double-sharp "double-sharp") + (:sesquisharp "three-quarters-sharp") + (:semisharp "quarter-sharp") + (:semiflat "quarter-flat") + (:sesquiflat "three-quarters-flat") + (:double-flat "flat-flat"))) + +(defun note-alter (note) + (ecase (accidentals note) + (:sharp "1") + (:natural nil) + (:flat "-1") + (:double-sharp "2") + (:sesquisharp "1.5") + (:semisharp "0.5") + (:semiflat "-0.5") + (:sesquiflat "-1.5") + (:double-flat "-2"))) + +(defun note-notations-p (note cluster) + (or (tie-left note) + (tie-right note) + (note-articulations-p note cluster))) + +(defun note-articulations-p (note cluster) + (let ((annotations (annotations cluster))) + (or (member :staccato annotations) + (member :tenuto annotations)))) + +(defun make-xml-note (note in-chord duration voice cluster) + (let ((type (rhythmic-element-type cluster)) + (dots (dots cluster)) + (pitch (gshnote-to-xml (pitch note))) + (accidental (note-accidental note)) + (alter (note-alter note))) (cxml:with-element "note" (when in-chord (cxml:with-element "chord")) @@ -1113,12 +1134,15 @@ (when (> (hash-table-count *staff-hash*) 1) (cxml:with-element "staff" (cxml:text (write-to-string (gethash (staff note) *staff-hash*))))) - - ;; Small temptation here to put the if clause on the attribute, - ;; but remember that a note can have ties in both directions. - (when (or (tie-left note) (tie-right note)) + (when (note-notations-p note cluster) (cxml:with-element "notations" (when (tie-left note) (cxml:with-element "tied" (cxml:attribute "type" "stop"))) (when (tie-right note) - (cxml:with-element "tied" (cxml:attribute "type" "start")))))))) + (cxml:with-element "tied" (cxml:attribute "type" "start"))) + (when (note-articulations-p note cluster) + (cxml:with-element "articulations" + (when (member :staccato (annotations cluster)) + (cxml:with-element "staccato")) + (when (member :tenuto (annotations cluster)) + (cxml:with-element "tenuto")))))))))

1 0

[gsharp-cvs] CVS gsharp/Mxml
by crhodes 09 Feb '08

09 Feb '08

Update of /project/gsharp/cvsroot/gsharp/Mxml In directory clnet:/tmp/cvs-serv15850 Modified Files: mxml.lisp Log Message: One or two more stylistic changes. --- /project/gsharp/cvsroot/gsharp/Mxml/mxml.lisp 2008/02/09 18:17:20 1.6 +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml.lisp 2008/02/09 18:21:00 1.7 @@ -1004,9 +1004,9 @@ (cxml:with-element "type" (cxml:text type)) (loop repeat dots do (cxml:with-element "dot")) - (if (> (hash-table-count *staff-hash*) 1) - (cxml:with-element "staff" - (cxml:text (write-to-string (gethash (staff rest) *staff-hash*)))))))) + (when (> (hash-table-count *staff-hash*) 1) + (cxml:with-element "staff" + (cxml:text (write-to-string (gethash (staff rest) *staff-hash*)))))))) (defmethod make-xml-element ((cluster cluster) voice) ;; this maybe should get called earlier. or later. i don't know. @@ -1034,9 +1034,9 @@ (unless (null voice) (cxml:with-element "voice" (cxml:text (write-to-string voice)))) ;; TODO: make this use the first melody staff above the lyrics staff - (if (> (hash-table-count *staff-hash*) 1) - (cxml:with-element "staff" - (cxml:text (write-to-string (gethash (staff lyric) *staff-hash*))))) + (when (> (hash-table-count *staff-hash*) 1) + (cxml:with-element "staff" + (cxml:text (write-to-string (gethash (staff lyric) *staff-hash*))))) (cxml:with-element "lyric" (cxml:with-element "syllabic" (cxml:text syllabic)) (cxml:with-element "text" (cxml:text text))))))

1 0

[gsharp-cvs] CVS gsharp/Mxml
by crhodes 09 Feb '08

09 Feb '08

Update of /project/gsharp/cvsroot/gsharp/Mxml In directory clnet:/tmp/cvs-serv13743 Modified Files: mxml.lisp Log Message: Minor MusicXML edits. --- /project/gsharp/cvsroot/gsharp/Mxml/mxml.lisp 2008/02/09 16:54:33 1.5 +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml.lisp 2008/02/09 18:17:20 1.6 @@ -753,10 +753,10 @@ (let ((sink (cxml:make-rod-sink :indentation 2 :canonical nil)) (ordered-parts)) (cxml:with-xml-output sink - (sax:start-dtd sink - "score-partwise" - "-//Recordare//DTD MusicXML 1.1 Partwise//EN" - "http://www.musicxml.org/dtds/partwise.dtd") + (sax:start-dtd sink + "score-partwise" + "-//Recordare//DTD MusicXML 1.1 Partwise//EN" + "http://www.musicxml.org/dtds/partwise.dtd") (sax:end-dtd sink) (cxml:with-element "score-partwise" (cxml:attribute "version" "1.1") @@ -976,22 +976,25 @@ (defgeneric make-xml-element (gharp-element voice)) +(defun rhythmic-element-type (element) + (ecase (notehead element) + (:long "long") + (:breve "breve") + (:whole "whole") + (:half "half") + (:filled + (ecase (max (rbeams element) (lbeams element)) + (0 "quarter") + (1 "eighth") + (2 "16th") + (3 "32nd") + (4 "64th") + (5 "128th") + (6 "256th"))))) + (defmethod make-xml-element ((rest rest) voice) (let ((duration (calculate-duration rest)) - (type (ecase (notehead rest) - (:long "long") - (:breve "breve") - (:whole "whole") - (:half "half") - (:filled - (ecase (max (rbeams rest) (lbeams rest)) - (0 "quarter") - (1 "eighth") - (2 "16th") - (3 "32nd") - (4 "64th") - (5 "128th") - (6 "256th"))))) + (type (rhythmic-element-type rest)) (dots (dots rest))) (cxml:with-element "note" (cxml:with-element "rest") @@ -1009,20 +1012,7 @@ ;; this maybe should get called earlier. or later. i don't know. (gsharp-measure::compute-final-accidentals (notes cluster)) (let ((duration (calculate-duration cluster)) - (type (ecase (notehead cluster) - (:long "long") - (:breve "breve") - (:whole "whole") - (:half "half") - (:filled - (ecase (max (rbeams cluster) (lbeams cluster)) - (0 "quarter") - (1 "eighth") - (2 "16th") - (3 "32nd") - (4 "64th") - (5 "128th") - (6 "256th"))))) + (type (rhythmic-element-type cluster)) (dots (dots cluster))) (loop for note in (notes cluster) @@ -1077,7 +1067,7 @@ (let ((step (mod pitch 7))) (list (car (rassoc step *step-to-basenote*)) (/ (- pitch step) 7)))) -(defun make-xml-note (note in-chord type dots duration &optional voice) +(defun make-xml-note (note in-chord type dots duration voice) (let ((pitch (gshnote-to-xml (pitch note))) (accidental (ecase (final-accidental note) ((nil)) @@ -1101,11 +1091,12 @@ (:sesquiflat "-1.5") (:double-flat "-2")))) (cxml:with-element "note" - (if in-chord - (cxml:with-element "chord")) + (when in-chord + (cxml:with-element "chord")) (cxml:with-element "pitch" (cxml:with-element "step" (cxml:text (car pitch))) - (if alter (cxml:with-element "alter" (cxml:text alter))) + (when alter + (cxml:with-element "alter" (cxml:text alter))) (cxml:with-element "octave" (cxml:text (write-to-string (cadr pitch))))) (cxml:with-element "duration" (cxml:text (write-to-string duration))) (unless (null voice) @@ -1113,15 +1104,15 @@ (cxml:with-element "type" (cxml:text type)) (loop repeat dots do (cxml:with-element "dot")) - (if accidental (cxml:with-element "accidental" - (cxml:text accidental))) + (when accidental + (cxml:with-element "accidental" (cxml:text accidental))) (unless (eq (final-stem-direction (cluster note)) :auto) (cxml:with-element "stem" (cxml:text (string-downcase (string (final-stem-direction (cluster note))))))) - (if (> (hash-table-count *staff-hash*) 1) - (cxml:with-element "staff" - (cxml:text (write-to-string (gethash (staff note) *staff-hash*))))) + (when (> (hash-table-count *staff-hash*) 1) + (cxml:with-element "staff" + (cxml:text (write-to-string (gethash (staff note) *staff-hash*))))) ;; Small temptation here to put the if clause on the attribute, ;; but remember that a note can have ties in both directions.

1 0

[gsharp-cvs] CVS gsharp
by crhodes 09 Feb '08

09 Feb '08

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv26736 Modified Files: buffer.lisp drawing.lisp gui.lisp measure.lisp modes.lisp packages.lisp Log Message: Work-in-progress hooks for drawing routines, used for now for tenuto and staccato articulation marks. The quality of the graphical rendering of the marks is not really up to scratch; horizontal placement seems to be off by somewhere between half and one pixel, and of course a note with both marks on at once gets an ugly graphical clash. As I say, "work in progress". --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/12/02 05:52:53 1.58 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2008/02/09 16:58:35 1.59 @@ -61,10 +61,11 @@ (defclass element (gsharp-object) ((bar :initform nil :initarg :bar :accessor bar) - (xoffset :initform 0 :initarg :xoffset :accessor xoffset))) + (xoffset :initform 0 :initarg :xoffset :accessor xoffset) + (annotations :initform nil :initarg :annotations :accessor annotations))) (defmethod slots-to-be-saved append ((e element)) - '(xoffset)) + '(xoffset annotations)) (defmethod duration ((element element)) 0) (defmethod rbeams ((element element)) 0) --- /project/gsharp/cvsroot/gsharp/drawing.lisp 2007/09/18 21:19:03 1.84 +++ /project/gsharp/cvsroot/gsharp/drawing.lisp 2008/02/09 16:58:35 1.85 @@ -909,6 +909,60 @@ (defgeneric draw-element (pane element &optional flags)) +(defmethod draw-element :around (pane element &optional flags) + (call-next-method) + (dolist (annotation (annotations element)) + (draw-element-annotation pane element annotation))) + +(defgeneric draw-element-annotation (pane element annotation) + (:method (pane element annotation) + (warn "unknown annotation ~S for ~S" annotation element))) + +;;; FIXME: these methods work and have the right vertical behaviour; +;;; the horizontal centering of the dot and the tenuto mark are all +;;; wrong, sadly. +(defmethod draw-element-annotation + (pane (element cluster) (annotation (eql :staccato))) + (let ((direction (final-stem-direction element)) + (x (final-absolute-element-xoffset element))) + (if (eq direction :up) + (score-pane:with-vertical-score-position (pane (bot-note-staff-yoffset element)) + (score-pane:with-notehead-right-offsets (dx dy) + (score-pane:with-notehead-left-offsets (ddx ddy) + (let ((pos (- (bot-note-pos element) 2))) + (when (and (<= 0 pos) (evenp pos)) + (setq pos (1- pos))) + (score-pane:draw-dot pane (+ x (/ (+ dx ddx) 2)) pos))))) + (score-pane:with-vertical-score-position (pane (top-note-staff-yoffset element)) + (score-pane:with-notehead-right-offsets (dx dy) + (score-pane:with-notehead-left-offsets (ddx ddy) + (let ((pos (+ (top-note-pos element) 2))) + (when (and (<= pos 8) (evenp pos)) + (setq pos (1+ pos))) + (score-pane:draw-dot pane (+ x (/ (+ dx ddx) 2)) pos)))))))) + +(defmethod draw-element-annotation + (pane (element cluster) (annotation (eql :tenuto))) + (let ((direction (final-stem-direction element)) + (x (final-absolute-element-xoffset element))) + (if (eq direction :up) + (score-pane:with-vertical-score-position (pane (bot-note-staff-yoffset element)) + (score-pane:with-notehead-right-offsets (dx dy) + (score-pane:with-notehead-left-offsets (ddx ddy) + (let ((pos (- (bot-note-pos element) 2))) + (when (and (<= 0 pos) (evenp pos)) + (setq pos (1- pos))) + (draw-rectangle* pane (+ x ddx) (1- (score-pane:staff-step (- pos))) + (+ x dx) (1+ (score-pane:staff-step (- pos)))))))) + (score-pane:with-vertical-score-position (pane (top-note-staff-yoffset element)) + (score-pane:with-notehead-right-offsets (dx dy) + (score-pane:with-notehead-left-offsets (ddx ddy) + (let ((pos (+ (bot-note-pos element) 2))) + (when (and (<= pos 8) (evenp pos)) + (setq pos (1+ pos))) + (draw-rectangle* pane (+ x ddx) (1- (score-pane:staff-step (- pos))) + (+ x dx) (1+ (score-pane:staff-step (- pos))))))))))) + (defmethod note-difference ((note1 note) (note2 note)) (- (pitch note1) (pitch note2))) --- /project/gsharp/cvsroot/gsharp/gui.lisp 2008/01/30 09:59:25 1.93 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2008/02/09 16:58:35 1.94 @@ -754,6 +754,18 @@ (:up :down) (:down :auto)))) +(define-gsharp-command com-toggle-staccato () + (let ((cluster (cur-cluster))) + (if (member :staccato (annotations cluster)) + (setf (annotations cluster) (remove :staccato (annotations cluster))) + (push :staccato (annotations cluster))))) + +(define-gsharp-command com-toggle-tenuto () + (let ((cluster (cur-cluster))) + (if (member :tenuto (annotations cluster)) + (setf (annotations cluster) (remove :tenuto (annotations cluster))) + (push :tenuto (annotations cluster))))) + (define-gsharp-command com-down () (let ((element (cur-element))) (if (typep element 'cluster) --- /project/gsharp/cvsroot/gsharp/measure.lisp 2007/08/30 03:04:56 1.38 +++ /project/gsharp/cvsroot/gsharp/measure.lisp 2008/02/09 16:58:35 1.39 @@ -117,6 +117,10 @@ (declare (ignore direction)) (mark-modified element)) +(defmethod (setf annotations) :after (annotations (element relement)) + (declare (ignore annotations)) + (mark-modified element)) + (defmethod append-char :after ((element lyrics-element) char) (declare (ignore char)) (mark-modified element)) --- /project/gsharp/cvsroot/gsharp/modes.lisp 2007/07/06 14:16:20 1.27 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2008/02/09 16:58:35 1.28 @@ -103,6 +103,8 @@ (set-key 'com-untie-note-left 'cluster-table '((#\x) (#\{))) (set-key 'com-untie-note-right 'cluster-table '((#\x) (#\}))) (set-key 'com-rotate-stem-direction 'cluster-table '((#\s :meta))) +(set-key 'com-toggle-staccato 'cluster-table '(#\s)) +(set-key 'com-toggle-tenuto 'cluster-table '(#\t)) (set-key 'com-current-increment 'cluster-table '((#\p))) (set-key 'com-current-decrement 'cluster-table '((#\n))) (set-key 'com-octave-up 'cluster-table '((#\U :shift :meta))) --- /project/gsharp/cvsroot/gsharp/packages.lisp 2008/01/15 15:43:52 1.65 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2008/02/09 16:58:35 1.66 @@ -59,7 +59,7 @@ #:gsharp-condition #:pitch #:accidentals #:dots #:note #:make-note #:note-less #:note-equal #:bar - #:notehead #:rbeams #:lbeams #:dots #:element + #:notehead #:rbeams #:lbeams #:dots #:element #:annotations #:melody-element #:rhythmic-element #:notes #:add-note #:find-note #:remove-note #:cluster-upper-bound #:cluster-lower-bound

1 0

[gsharp-cvs] CVS gsharp/Mxml
by crhodes 09 Feb '08

09 Feb '08

Update of /project/gsharp/cvsroot/gsharp/Mxml In directory clnet:/tmp/cvs-serv26533/Mxml Modified Files: mxml.lisp Log Message: Comment fixes in MusicXML code. --- /project/gsharp/cvsroot/gsharp/Mxml/mxml.lisp 2008/02/08 16:50:57 1.4 +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml.lisp 2008/02/09 16:54:33 1.5 @@ -129,6 +129,9 @@ :filled) ("half" :half) ("whole" :whole) + ;; KLUDGE: "full" here (and for beams) I think is a + ;; feature of catering for Nightingale's MusicXML + ;; export, which is wrong in this respect. (("breve" "full") :breve) ("long" :long)) :filled)) @@ -166,9 +169,8 @@ (+ basenum (* 7 octave)))) (defun parse-mxml-accidental (note) - ;; TODO this should support microtones. also, i wrote it fairly - ;; early on and it doesn't use things like has-element which it - ;; should. + ;; I (presumably Brian Gruber -- CSR) wrote it fairly early on and + ;; it doesn't use things like has-element which it should. (let ((alters (dom:get-elements-by-tag-name note "alter"))) (if (= 0 (length alters)) :natural

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

gsharp-cvs