October 2007 - gsharp-cvs@common-lisp.net

[gsharp-cvs] CVS gsharp
by mjonsson 27 Oct '07

27 Oct '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv24656 Modified Files: gui.lisp play.lisp Log Message: Implemented play-buffer and made play-layer available in play menu --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/09/18 21:19:03 1.87 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/10/27 02:10:55 1.88 @@ -534,7 +534,11 @@ 'play-command-table :errorp nil :menu '(("Buffer" :command com-play-buffer) - ("Segment" :command com-play-segment))) + ("Segment" :command com-play-segment) + ("Layer" :command com-play-layer))) + +(define-gsharp-command (com-play-buffer :name t) () + (play-buffer (buffer (current-cursor)))) (define-gsharp-command (com-play-segment :name t) () (play-segment (segment (current-cursor)))) --- /project/gsharp/cvsroot/gsharp/play.lisp 2007/10/20 18:41:25 1.10 +++ /project/gsharp/cvsroot/gsharp/play.lisp 2007/10/27 02:10:55 1.11 @@ -19,12 +19,12 @@ (defun measure-durations (slices) (let ((durations (mapcar (lambda (slice) - (mapcar #'duration - (bars slice))) - slices))) + (mapcar #'duration + (bars slice))) + slices))) (loop while durations - collect (reduce #'max durations :key #'car) - do (setf durations (remove nil (mapcar #'cdr durations)))))) + collect (reduce #'max durations :key #'car) + do (setf durations (remove nil (mapcar #'cdr durations)))))) (defun average (list &key (key #'identity)) (let ((sum 0) @@ -68,14 +68,14 @@ (incf time (* *tempo* (duration element))))) (elements bar))) -(defun track-from-slice (slice channel durations) - (cons (make-instance 'program-change-message - :time 0 :status (+ #xc0 channel) :program 0) - (let ((time 0)) - (mapcan (lambda (bar duration) - (prog1 (events-from-bar bar time channel) - (incf time (* *tempo* duration)))) - (bars slice) durations)))) +(defun track-from-slice (slice channel durations &key (start-time 0)) + (let ((time start-time)) + (cons (make-instance 'program-change-message + :time time :status (+ #xc0 channel) :program 0) + (mapcan (lambda (bar duration) + (prog1 (events-from-bar bar time channel) + (incf time (* *tempo* duration)))) + (bars slice) durations)))) (define-condition midi-player-failed (gsharp-condition) ((midi-player :initarg :midi-player) @@ -115,20 +115,57 @@ #-(or cmu sbcl clisp) (error "write compatibility layer for RUN-PROGRAM"))) -(defun play-segment (segment) - (let* ((slices (mapcar #'body (layers segment))) - (durations (measure-durations slices)) - (*tempo* (tempo segment)) - (*tuning* (gsharp-buffer:tuning segment)) - (tracks (loop for slice in slices - for i from 0 - collect (track-from-slice slice i durations)))) - (play-tracks tracks))) - (defun play-layer (layer) (let* ((slice (body layer)) - (durations (measure-durations (list slice))) + (durations (measure-durations (list slice))) (*tempo* (tempo (segment layer))) (*tuning* (gsharp-buffer:tuning (segment layer))) - (tracks (list (track-from-slice slice 0 durations)))) - (play-tracks tracks))) \ No newline at end of file + (tracks (list (track-from-slice slice 0 durations)))) + (play-tracks tracks))) + +(defun segment-tracks (segment &key (start-time 0)) + (let* ((slices (mapcar #'body (layers segment))) + (durations (measure-durations slices)) + (*tempo* (tempo segment)) + (*tuning* (gsharp-buffer:tuning segment))) + (values (loop + for slice in slices + for i from 0 + collect (track-from-slice slice i durations :start-time start-time)) + (reduce #'+ durations)))) + +(defun play-segment (segment) + (play-tracks (segment-tracks segment))) + +; TODO: There is a short pause between segments? +(defun play-buffer (buffer) + (let* ((time 0) + (num-tracks (loop :for segment :in (segments buffer) + :maximize (length (layers segment)))) + (tracks (loop :for i :from 0 :below num-tracks :collect nil))) + + ; Collect snippets from each segment that should go to different tracks + (dolist (segment (segments buffer)) + (let ((*tempo* (tempo segment)) + (*tuning* (tuning segment))) + (multiple-value-bind (track-addendums segment-duration) + (segment-tracks segment :start-time time) + (format t "~S" segment-duration) + + (incf time segment-duration) + + (loop :for track-addendum :in track-addendums + :for tracks-tail :on tracks + :do (push track-addendum (car tracks-tail)))))) + + ; Concatenate each track's snippets + (loop :for tracks-tail :on tracks + :do (setf (car tracks-tail) + (reduce (lambda (result snippet) + (nconc snippet result)) + (car tracks-tail) + :from-end t))) + + (play-tracks tracks))) + +

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 22 Oct '07

22 Oct '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv25693 Modified Files: buffer.lisp gsharp.asd Added Files: melody.lisp Log Message: I moved melody-related functionality from buffer.lisp to a new file. --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/10/22 10:03:40 1.56 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/10/22 11:45:36 1.57 @@ -33,6 +33,8 @@ (save-object obj stream) (print-unreadable-object (obj stream :type t :identity t)))) +(define-condition gsharp-condition (error) ()) + (defgeneric name (obj)) (defclass name-mixin () @@ -43,296 +45,12 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; -;;; Clef - -;;; The line number on which the clef is located on the staff. -;;; The bottom line of the staff is number 1. -(defgeneric lineno (clef)) - -;;; for key signature drawing calcluations. FIXME: in fact the layout -;;; of key signatures isn't the same across all clefs. -(defgeneric b-position (clef)) -(defgeneric f-position (clef)) - -;;; the note number of the bottom line of this clef. -(defgeneric bottom-line (clef)) - -(defclass clef (gsharp-object name-mixin) - ((lineno :reader lineno :initarg :lineno - :type (or (integer 0 8) null)))) - -(defun make-clef (name &key lineno) - (declare (type (member :treble :treble8 :bass :c :percussion) name) - (type (or (integer 0 8) null) lineno)) - (when (null lineno) - (setf lineno - (ecase name - ((:treble :treble8) 2) - (:bass 6) - (:c 4) - (:percussion 3)))) - (make-instance 'clef :name name :lineno lineno)) - -(defmethod slots-to-be-saved append ((c clef)) - '(lineno)) - -(defun read-clef-v3 (stream char n) - (declare (ignore char n)) - (apply #'make-instance 'clef (read-delimited-list #\] stream t))) - -(set-dispatch-macro-character #\[ #\K - #'read-clef-v3 - *gsharp-readtable-v3*) - -;;; given a clef, return the staff step of the B that should have -;;; the first flat sign in key signatures with flats -(defmethod b-position ((clef clef)) - (ecase (name clef) - (:bass (- (lineno clef) 4)) - ((:treble :treble8) (+ (lineno clef) 2)) - (:c (- (lineno clef) 1)))) - - -;;; given a clef, return the staff step of the F that should have -;;; the first sharp sign in key signatures with sharps -(defmethod f-position ((clef clef)) - (ecase (name clef) - (:bass (lineno clef)) - ((:treble :treble8) (+ (lineno clef) 6)) - (:c (+ (lineno clef) 3)))) - -(defmethod bottom-line ((clef clef)) - (- (ecase (name clef) - (:treble 32) - (:bass 24) - (:c 28) - (:treble8 25)) - (lineno clef))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; ;;; Staff (defclass staff (gsharp-object name-mixin) ((buffer :initarg :buffer :accessor buffer)) (:default-initargs :name "default staff")) -;;; fiveline - -(defgeneric clef (fiveline-staff)) - -(defclass fiveline-staff (staff) - ((clef :accessor clef :initarg :clef :initform (make-clef :treble)) - (%keysig :accessor keysig :initarg :keysig - :initform (make-array 7 :initial-element :natural)) - (key-signatures :accessor key-signatures :initform nil))) - -(defmethod initialize-instance :after ((obj fiveline-staff) &rest args) - (declare (ignore args)) - (with-slots (%keysig) obj - (when (vectorp %keysig) - (setf %keysig - (make-instance 'key-signature :staff obj :alterations %keysig))))) - -(defun make-fiveline-staff (&rest args &key name clef keysig) - (declare (ignore name clef keysig)) - (apply #'make-instance 'fiveline-staff args)) - -(defmethod slots-to-be-saved append ((s fiveline-staff)) - '(clef %keysig)) - -(defun read-fiveline-staff-v3 (stream char n) - (declare (ignore char n)) - (apply #'make-instance 'fiveline-staff (read-delimited-list #\] stream t))) - -(set-dispatch-macro-character #\[ #\= - #'read-fiveline-staff-v3 - *gsharp-readtable-v3*) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Note - -;;; Notes are immutable objets. If you want to alter (say) the staff -;;; or the pitch of a note, you have to delete it and add a new note -;;; with the right characteristics. - -;;; Return the pitch of the note. -(defgeneric pitch (note)) - -;;; Return the accidentals of the note. The value returned is one of -;;; :natural :flat :double-flat :sharp or :double-sharp. -(defgeneric accidentals (note)) - -;;; Return a non-negative integer indicating the number of dots of the -;;; note. The value nil is returned whenever the note takes its -;;; number of dots from the cluster to which it belongs. -(defgeneric dots (note)) - -;;; Returns the cluster to which the note belongs, or nil if the note -;;; currently does not belong to any cluster. -(defgeneric cluster (note)) - -;;; The pitch is a number from 0 to 128 -;;; -;;; The staff is a staff object. -;;; -;;; Head can be :long, :breve, :whole, :half, :filled, or nil. A -;;; value of nil means that the notehead is determined by that of the -;;; cluster to which the note belongs. -;;; -;;; Accidentals can be :natural :flat :double-flat :sharp or :double-sharp. -;;; The default is :natural. Whether a note is actually displayed -;;; preceded by one of the corresponding signs is a matter of context and -;;; display style. -;;; -;;; The number of dots can be an integer or nil, meaning that the number -;;; of dots is taken from the cluster. The default value is nil. -;;; -;;; The actual duration of the note is computed from the note head, the -;;; number of beams of the cluster to which the note belongs, and the -;;; number of dots in the usual way. - -(defclass note (gsharp-object) - ((cluster :initform nil :initarg :cluster :accessor cluster) - (pitch :initarg :pitch :reader pitch :type (integer 0 127)) - (staff :initarg :staff :reader staff :type staff) - (head :initform nil :initarg :head :reader head - :type (or (member :long :breve :whole :half :filled) null)) - (accidentals :initform :natural :initarg :accidentals :reader accidentals - ;; FIXME: we want :TYPE ACCIDENTAL here but need to - ;; sort out order of definition for that to be useful. - #+nil #+nil - :type (member :natural :flat :double-flat :sharp :double-sharp)) - (dots :initform nil :initarg :dots :reader dots - :type (or (integer 0 3) null)) - (%tie-right :initform nil :initarg :tie-right :accessor tie-right) - (%tie-left :initform nil :initarg :tie-left :accessor tie-left))) - -(defun make-note (pitch staff &rest args &key head (accidentals :natural) dots) - (declare (type (integer 0 127) pitch) - (type staff staff) - (type (or (member :long :breve :whole :half :filled) null) head) - ;; FIXME: :TYPE ACCIDENTAL - #+nil #+nil - (type (member :natural :flat :double-flat :sharp :double-sharp) - accidentals) - (type (or (integer 0 3) null) dots) - (ignore head accidentals dots)) - (apply #'make-instance 'note :pitch pitch :staff staff args)) - -(defmethod slots-to-be-saved append ((n note)) - '(pitch staff head accidentals dots %tie-right %tie-left)) - -(defun read-note-v3 (stream char n) - (declare (ignore char n)) - (apply #'make-instance 'note (read-delimited-list #\] stream t))) - -(set-dispatch-macro-character #\[ #\N - #'read-note-v3 - *gsharp-readtable-v3*) - -;;; Return true if note1 is considered less than note2. -(defun note-less (note1 note2) - (< (pitch note1) (pitch note2))) - -;;; Return true if note1 is considered equal to note2. -(defun note-equal (note1 note2) - (= (pitch note1) (pitch note2))) - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Tuning (support for microtonal and historical tunings/temperaments) - -;;; FIXME: add name-mixin also? -(defclass tuning (gsharp-object) - ((master-pitch-note :initform (make-instance 'note :pitch 33 ; a above middle c - :staff (make-instance 'staff)) - :initarg :master-pitch-note - :type note - :accessor master-pitch-note) - (master-pitch-freq :initform 440 - :initarg :master-pitch-freq - :accessor master-pitch-freq))) - -(defmethod slots-to-be-saved append ((tuning tuning)) - '(master-pitch-note master-pitch-freq)) - -;;; Returns how a note should be tuned in a given tuning -;;; in terms of a cent value. -(defgeneric note-cents (note tuning)) - -;;; 12-edo is provided for efficiency only. It is a -;;; special case of a regular temperament. Perhaps it -;;; should be removed? -(defclass 12-edo (tuning) - ()) - -(defmethod slots-to-be-saved append ((tuning 12-edo)) - '()) - -(defmethod note-cents ((note note) (tuning 12-edo)) - (multiple-value-bind (octave pitch) (floor (pitch note) 7) - (+ (* 1200 (1+ octave)) - (ecase pitch (0 0) (1 200) (2 400) (3 500) (4 700) (5 900) (6 1100)) - (ecase (accidentals note) - (:double-flat -200) - (:sesquiflat -150) - (:flat -100) - (:semiflat -50) - (:natural 0) - (:semisharp 50) - (:sharp 100) - (:sesquisharp 150) - (:double-sharp 200))))) - -;;; regular temperaments are temperaments that -;;; retain their interval sizes regardless of modulation, as opposed to -;;; irregular temperaments. -(defclass regular-temperament (tuning) - ((octave-cents :initform 1200 :initarg :octave-cents :accessor octave-cents) - (fifth-cents :initform 700 :initarg :fifth-cents :accessor fifth-cents) - (quartertone-cents :initform 50 :initarg :quartertone-cents :accessor quartertone-cents) - ;; TODO: Add cent sizes of various microtonal accidentals, perhaps in an alist? - )) - -(defmethod slots-to-be-saved append ((tuning regular-temperament)) - '(octave-cents fifth-cents)) - -(defmethod note-cents ((note note) (tuning regular-temperament)) - (let ((octaves 1) - (fifths 0) - (sharps 0) ;; short for 7 fifths up and 4 octaves down - (quartertones 0)) - (incf octaves (floor (pitch note) 7)) - (ecase (mod (pitch note) 7) - (0 (progn)) - (1 (progn (incf octaves -1) (incf fifths 2))) - (2 (progn (incf octaves -2) (incf fifths 4))) - (3 (progn (incf octaves 1) (incf fifths -1))) - (4 (progn (incf fifths 1))) - (5 (progn (incf octaves -1) (incf fifths 3))) - (6 (progn (incf octaves -2) (incf fifths 5)))) - (ecase (accidentals note) - (:double-flat (incf sharps -2)) - (:sesquiflat (incf sharps -1) (incf quartertones -1)) - (:flat (incf sharps -1)) - (:semiflat (incf quartertones -1)) - (:natural) - (:semisharp (incf quartertones 1)) - (:sharp (incf sharps 1)) - (:sesquisharp (incf sharps 1) (incf quartertones 1)) - (:double-sharp (incf sharps 2))) - (incf octaves (* -4 sharps)) - (incf fifths (* 7 sharps)) - (+ (* octaves (octave-cents tuning)) - (* fifths (fifth-cents tuning)) - (* quartertones (quartertone-cents tuning))))) - -;;; TODO: (defclass irregular-temperament ...) - - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Element @@ -404,216 +122,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; -;;; Melody element - -(defclass melody-element (rhythmic-element) ()) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Key signature - -(defgeneric alterations (key-signature) - (:documentation "return the alterations in the form of a -7-element array where each element is either :natural, -:sharp, or :flat according to how each staff position -should be altered")) - -(defgeneric more-sharps (key-signature &optional n) - (:documentation "make the key signature N alterations -sharper by removing some flats and/or adding some sharps")) - -(defgeneric more-flats (key-signature &optional n) - (:documentation "make the key signature N alterations -flatter by removing some sharps and/or adding some flats")) - -(defclass key-signature (element) - ((%staff :initarg :staff :reader staff) - (%alterations :initform (make-array 7 :initial-element :natural) - :initarg :alterations :reader alterations))) - -(defun make-key-signature (staff &rest args &key alterations) - (declare (type (or null (simple-vector 7)) alterations) - (ignore alterations)) - (apply #'make-instance 'key-signature :staff staff args)) - -(defmethod slots-to-be-saved append ((k key-signature)) - '(%staff %alterations)) - -(defmethod more-sharps ((sig key-signature) &optional (n 1)) - (let ((alt (alterations sig))) - (loop repeat n - do (cond ((eq (aref alt 3) :flat) (setf (aref alt 3) :natural)) - ((eq (aref alt 0) :flat) (setf (aref alt 0) :natural)) - ((eq (aref alt 4) :flat) (setf (aref alt 4) :natural)) - ((eq (aref alt 1) :flat) (setf (aref alt 1) :natural)) - ((eq (aref alt 5) :flat) (setf (aref alt 5) :natural)) - ((eq (aref alt 2) :flat) (setf (aref alt 2) :natural)) - ((eq (aref alt 6) :flat) (setf (aref alt 6) :natural)) - ((eq (aref alt 3) :natural) (setf (aref alt 3) :sharp)) - ((eq (aref alt 0) :natural) (setf (aref alt 0) :sharp)) - ((eq (aref alt 4) :natural) (setf (aref alt 4) :sharp)) - ((eq (aref alt 1) :natural) (setf (aref alt 1) :sharp)) - ((eq (aref alt 5) :natural) (setf (aref alt 5) :sharp)) - ((eq (aref alt 2) :natural) (setf (aref alt 2) :sharp)) - ((eq (aref alt 6) :natural) (setf (aref alt 6) :sharp)))))) - -(defmethod more-flats ((sig key-signature) &optional (n 1)) - (let ((alt (alterations sig))) - (loop repeat n - do (cond ((eq (aref alt 6) :sharp) (setf (aref alt 6) :natural)) - ((eq (aref alt 2) :sharp) (setf (aref alt 2) :natural)) - ((eq (aref alt 5) :sharp) (setf (aref alt 5) :natural)) - ((eq (aref alt 1) :sharp) (setf (aref alt 1) :natural)) - ((eq (aref alt 4) :sharp) (setf (aref alt 4) :natural)) - ((eq (aref alt 0) :sharp) (setf (aref alt 0) :natural)) - ((eq (aref alt 3) :sharp) (setf (aref alt 3) :natural)) - ((eq (aref alt 6) :natural) (setf (aref alt 6) :flat)) - ((eq (aref alt 2) :natural) (setf (aref alt 2) :flat)) - ((eq (aref alt 5) :natural) (setf (aref alt 5) :flat)) - ((eq (aref alt 1) :natural) (setf (aref alt 1) :flat)) - ((eq (aref alt 4) :natural) (setf (aref alt 4) :flat)) - ((eq (aref alt 0) :natural) (setf (aref alt 0) :flat)) - ((eq (aref alt 3) :natural) (setf (aref alt 3) :flat)))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Cluster - -;;; Return a list of the notes of the cluster -(defgeneric notes (cluster)) - -;;; Add a note to the cluster. It is an error if there is already a -;;; note in the cluster with the same staff and the same pitch. -(defgeneric add-note (cluster note)) - -;;; Find a note in a cluster. The comparison is made using only the -;;; pitch of the supplied note. If the note does not exist nil is returned. -(defgeneric find-note (cluster note)) - -;;; Delete a note from the cluster to which it belongs. It is an -;;; error to call this function if the note currently does not belong [199 lines skipped] --- /project/gsharp/cvsroot/gsharp/gsharp.asd 2007/10/22 09:39:23 1.18 +++ /project/gsharp/cvsroot/gsharp/gsharp.asd 2007/10/22 11:45:37 1.19 @@ -27,6 +27,7 @@ "sdl" "score-pane" "buffer" + "melody" "lyrics" "numbering" "Obseq/obseq" --- /project/gsharp/cvsroot/gsharp/melody.lisp 2007/10/22 11:45:37 NONE +++ /project/gsharp/cvsroot/gsharp/melody.lisp 2007/10/22 11:45:37 1.1 (in-package :gsharp-buffer) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Clef ;;; The line number on which the clef is located on the staff. ;;; The bottom line of the staff is number 1. (defgeneric lineno (clef)) ;;; for key signature drawing calcluations. FIXME: in fact the layout ;;; of key signatures isn't the same across all clefs. (defgeneric b-position (clef)) (defgeneric f-position (clef)) ;;; the note number of the bottom line of this clef. (defgeneric bottom-line (clef)) (defclass clef (gsharp-object name-mixin) ((lineno :reader lineno :initarg :lineno :type (or (integer 0 8) null)))) (defun make-clef (name &key lineno) (declare (type (member :treble :treble8 :bass :c :percussion) name) (type (or (integer 0 8) null) lineno)) (when (null lineno) (setf lineno (ecase name ((:treble :treble8) 2) (:bass 6) (:c 4) (:percussion 3)))) (make-instance 'clef :name name :lineno lineno)) (defmethod slots-to-be-saved append ((c clef)) '(lineno)) (defun read-clef-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'clef (read-delimited-list #\] stream t))) (set-dispatch-macro-character #\[ #\K #'read-clef-v3 *gsharp-readtable-v3*) ;;; given a clef, return the staff step of the B that should have ;;; the first flat sign in key signatures with flats (defmethod b-position ((clef clef)) (ecase (name clef) (:bass (- (lineno clef) 4)) ((:treble :treble8) (+ (lineno clef) 2)) (:c (- (lineno clef) 1)))) ;;; given a clef, return the staff step of the F that should have ;;; the first sharp sign in key signatures with sharps (defmethod f-position ((clef clef)) (ecase (name clef) (:bass (lineno clef)) ((:treble :treble8) (+ (lineno clef) 6)) (:c (+ (lineno clef) 3)))) (defmethod bottom-line ((clef clef)) (- (ecase (name clef) (:treble 32) (:bass 24) (:c 28) (:treble8 25)) (lineno clef))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Fiveline staff (defgeneric clef (fiveline-staff)) (defclass fiveline-staff (staff) ((clef :accessor clef :initarg :clef :initform (make-clef :treble)) (%keysig :accessor keysig :initarg :keysig :initform (make-array 7 :initial-element :natural)) (key-signatures :accessor key-signatures :initform nil))) (defmethod initialize-instance :after ((obj fiveline-staff) &rest args) (declare (ignore args)) (with-slots (%keysig) obj (when (vectorp %keysig) (setf %keysig (make-instance 'key-signature :staff obj :alterations %keysig))))) (defun make-fiveline-staff (&rest args &key name clef keysig) (declare (ignore name clef keysig)) (apply #'make-instance 'fiveline-staff args)) (defmethod slots-to-be-saved append ((s fiveline-staff)) '(clef %keysig)) (defun read-fiveline-staff-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'fiveline-staff (read-delimited-list #\] stream t))) (set-dispatch-macro-character #\[ #\= #'read-fiveline-staff-v3 *gsharp-readtable-v3*) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Note ;;; Notes are immutable objets. If you want to alter (say) the staff ;;; or the pitch of a note, you have to delete it and add a new note ;;; with the right characteristics. ;;; Return the pitch of the note. (defgeneric pitch (note)) ;;; Return the accidentals of the note. The value returned is one of ;;; :natural :flat :double-flat :sharp or :double-sharp. (defgeneric accidentals (note)) ;;; Return a non-negative integer indicating the number of dots of the ;;; note. The value nil is returned whenever the note takes its ;;; number of dots from the cluster to which it belongs. (defgeneric dots (note)) ;;; Returns the cluster to which the note belongs, or nil if the note ;;; currently does not belong to any cluster. (defgeneric cluster (note)) ;;; The pitch is a number from 0 to 128 ;;; ;;; The staff is a staff object. ;;; ;;; Head can be :long, :breve, :whole, :half, :filled, or nil. A ;;; value of nil means that the notehead is determined by that of the ;;; cluster to which the note belongs. ;;; ;;; Accidentals can be :natural :flat :double-flat :sharp or :double-sharp. ;;; The default is :natural. Whether a note is actually displayed ;;; preceded by one of the corresponding signs is a matter of context and ;;; display style. ;;; ;;; The number of dots can be an integer or nil, meaning that the number ;;; of dots is taken from the cluster. The default value is nil. ;;; ;;; The actual duration of the note is computed from the note head, the ;;; number of beams of the cluster to which the note belongs, and the ;;; number of dots in the usual way. (defclass note (gsharp-object) ((cluster :initform nil :initarg :cluster :accessor cluster) (pitch :initarg :pitch :reader pitch :type (integer 0 127)) (staff :initarg :staff :reader staff :type staff) (head :initform nil :initarg :head :reader head :type (or (member :long :breve :whole :half :filled) null)) (accidentals :initform :natural :initarg :accidentals :reader accidentals ;; FIXME: we want :TYPE ACCIDENTAL here but need to ;; sort out order of definition for that to be useful. #+nil #+nil :type (member :natural :flat :double-flat :sharp :double-sharp)) (dots :initform nil :initarg :dots :reader dots :type (or (integer 0 3) null)) (%tie-right :initform nil :initarg :tie-right :accessor tie-right) (%tie-left :initform nil :initarg :tie-left :accessor tie-left))) (defun make-note (pitch staff &rest args &key head (accidentals :natural) dots) (declare (type (integer 0 127) pitch) (type staff staff) (type (or (member :long :breve :whole :half :filled) null) head) ;; FIXME: :TYPE ACCIDENTAL #+nil #+nil (type (member :natural :flat :double-flat :sharp :double-sharp) accidentals) (type (or (integer 0 3) null) dots) (ignore head accidentals dots)) (apply #'make-instance 'note :pitch pitch :staff staff args)) (defmethod slots-to-be-saved append ((n note)) '(pitch staff head accidentals dots %tie-right %tie-left)) (defun read-note-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'note (read-delimited-list #\] stream t))) (set-dispatch-macro-character #\[ #\N #'read-note-v3 *gsharp-readtable-v3*) ;;; Return true if note1 is considered less than note2. (defun note-less (note1 note2) (< (pitch note1) (pitch note2))) ;;; Return true if note1 is considered equal to note2. (defun note-equal (note1 note2) (= (pitch note1) (pitch note2))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Tuning (support for microtonal and historical tunings/temperaments) ;;; FIXME: add name-mixin also? (defclass tuning (gsharp-object) ((master-pitch-note :initform (make-instance 'note :pitch 33 ; a above middle c :staff (make-instance 'staff)) :initarg :master-pitch-note :type note :accessor master-pitch-note) (master-pitch-freq :initform 440 :initarg :master-pitch-freq :accessor master-pitch-freq))) (defmethod slots-to-be-saved append ((tuning tuning)) '(master-pitch-note master-pitch-freq)) ;;; Returns how a note should be tuned in a given tuning ;;; in terms of a cent value. (defgeneric note-cents (note tuning)) ;;; 12-edo is provided for efficiency only. It is a ;;; special case of a regular temperament. Perhaps it ;;; should be removed? (defclass 12-edo (tuning) ()) (defmethod slots-to-be-saved append ((tuning 12-edo)) '()) (defmethod note-cents ((note note) (tuning 12-edo)) (multiple-value-bind (octave pitch) (floor (pitch note) 7) (+ (* 1200 (1+ octave)) (ecase pitch (0 0) (1 200) (2 400) (3 500) (4 700) (5 900) (6 1100)) (ecase (accidentals note) (:double-flat -200) (:sesquiflat -150) (:flat -100) (:semiflat -50) (:natural 0) (:semisharp 50) (:sharp 100) (:sesquisharp 150) (:double-sharp 200))))) ;;; regular temperaments are temperaments that ;;; retain their interval sizes regardless of modulation, as opposed to ;;; irregular temperaments. (defclass regular-temperament (tuning) ((octave-cents :initform 1200 :initarg :octave-cents :accessor octave-cents) (fifth-cents :initform 700 :initarg :fifth-cents :accessor fifth-cents) (quartertone-cents :initform 50 :initarg :quartertone-cents :accessor quartertone-cents) ;; TODO: Add cent sizes of various microtonal accidentals, perhaps in an alist? )) (defmethod slots-to-be-saved append ((tuning regular-temperament)) '(octave-cents fifth-cents)) (defmethod note-cents ((note note) (tuning regular-temperament)) (let ((octaves 1) (fifths 0) (sharps 0) ;; short for 7 fifths up and 4 octaves down (quartertones 0)) (incf octaves (floor (pitch note) 7)) (ecase (mod (pitch note) 7) (0 (progn)) (1 (progn (incf octaves -1) (incf fifths 2))) (2 (progn (incf octaves -2) (incf fifths 4))) (3 (progn (incf octaves 1) (incf fifths -1))) (4 (progn (incf fifths 1))) (5 (progn (incf octaves -1) (incf fifths 3))) (6 (progn (incf octaves -2) (incf fifths 5)))) (ecase (accidentals note) (:double-flat (incf sharps -2)) (:sesquiflat (incf sharps -1) (incf quartertones -1)) (:flat (incf sharps -1)) (:semiflat (incf quartertones -1)) (:natural) (:semisharp (incf quartertones 1)) (:sharp (incf sharps 1)) (:sesquisharp (incf sharps 1) (incf quartertones 1)) (:double-sharp (incf sharps 2))) (incf octaves (* -4 sharps)) (incf fifths (* 7 sharps)) (+ (* octaves (octave-cents tuning)) (* fifths (fifth-cents tuning)) (* quartertones (quartertone-cents tuning))))) ;;; TODO: (defclass irregular-temperament ...) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Melody element (defclass melody-element (rhythmic-element) ()) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Key signature (defgeneric alterations (key-signature) (:documentation "return the alterations in the form of a 7-element array where each element is either :natural, :sharp, or :flat according to how each staff position should be altered")) (defgeneric more-sharps (key-signature &optional n) (:documentation "make the key signature N alterations sharper by removing some flats and/or adding some sharps")) (defgeneric more-flats (key-signature &optional n) (:documentation "make the key signature N alterations flatter by removing some sharps and/or adding some flats")) (defclass key-signature (element) ((%staff :initarg :staff :reader staff) (%alterations :initform (make-array 7 :initial-element :natural) :initarg :alterations :reader alterations))) (defun make-key-signature (staff &rest args &key alterations) (declare (type (or null (simple-vector 7)) alterations) (ignore alterations)) (apply #'make-instance 'key-signature :staff staff args)) (defmethod slots-to-be-saved append ((k key-signature)) '(%staff %alterations)) (defmethod more-sharps ((sig key-signature) &optional (n 1)) (let ((alt (alterations sig))) (loop repeat n do (cond ((eq (aref alt 3) :flat) (setf (aref alt 3) :natural)) ((eq (aref alt 0) :flat) (setf (aref alt 0) :natural)) ((eq (aref alt 4) :flat) (setf (aref alt 4) :natural)) ((eq (aref alt 1) :flat) (setf (aref alt 1) :natural)) ((eq (aref alt 5) :flat) (setf (aref alt 5) :natural)) ((eq (aref alt 2) :flat) (setf (aref alt 2) :natural)) ((eq (aref alt 6) :flat) (setf (aref alt 6) :natural)) ((eq (aref alt 3) :natural) (setf (aref alt 3) :sharp)) ((eq (aref alt 0) :natural) (setf (aref alt 0) :sharp)) ((eq (aref alt 4) :natural) (setf (aref alt 4) :sharp)) ((eq (aref alt 1) :natural) (setf (aref alt 1) :sharp)) ((eq (aref alt 5) :natural) (setf (aref alt 5) :sharp)) ((eq (aref alt 2) :natural) (setf (aref alt 2) :sharp)) ((eq (aref alt 6) :natural) (setf (aref alt 6) :sharp)))))) (defmethod more-flats ((sig key-signature) &optional (n 1)) (let ((alt (alterations sig))) (loop repeat n do (cond ((eq (aref alt 6) :sharp) (setf (aref alt 6) :natural)) ((eq (aref alt 2) :sharp) (setf (aref alt 2) :natural)) ((eq (aref alt 5) :sharp) (setf (aref alt 5) :natural)) ((eq (aref alt 1) :sharp) (setf (aref alt 1) :natural)) ((eq (aref alt 4) :sharp) (setf (aref alt 4) :natural)) ((eq (aref alt 0) :sharp) (setf (aref alt 0) :natural)) ((eq (aref alt 3) :sharp) (setf (aref alt 3) :natural)) ((eq (aref alt 6) :natural) (setf (aref alt 6) :flat)) ((eq (aref alt 2) :natural) (setf (aref alt 2) :flat)) ((eq (aref alt 5) :natural) (setf (aref alt 5) :flat)) ((eq (aref alt 1) :natural) (setf (aref alt 1) :flat)) ((eq (aref alt 4) :natural) (setf (aref alt 4) :flat)) ((eq (aref alt 0) :natural) (setf (aref alt 0) :flat)) ((eq (aref alt 3) :natural) (setf (aref alt 3) :flat)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Cluster ;;; Return a list of the notes of the cluster (defgeneric notes (cluster)) ;;; Add a note to the cluster. It is an error if there is already a ;;; note in the cluster with the same staff and the same pitch. (defgeneric add-note (cluster note)) ;;; Find a note in a cluster. The comparison is made using only the ;;; pitch of the supplied note. If the note does not exist nil is returned. (defgeneric find-note (cluster note)) ;;; Delete a note from the cluster to which it belongs. It is an ;;; error to call this function if the note currently does not belong ;;; to any cluster. (defgeneric remove-note (note)) (defclass cluster (melody-element) ((notes :initform '() :initarg :notes :accessor notes) (stem-direction :initform :auto :initarg :stem-direction :accessor stem-direction))) (defmethod initialize-instance :after ((c cluster) &rest args) (declare (ignore args)) (loop for note in (notes c) do (setf (cluster note) c))) (defun make-cluster (&rest args [156 lines skipped]

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 22 Oct '07

22 Oct '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv7742 Modified Files: buffer.lisp lyrics.lisp Log Message: Got rid of the print-character slot which was used in the old I/O mechanism. --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/10/22 09:39:23 1.55 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/10/22 10:03:40 1.56 @@ -58,8 +58,7 @@ (defgeneric bottom-line (clef)) (defclass clef (gsharp-object name-mixin) - ((print-character :allocation :class :initform #\K) - (lineno :reader lineno :initarg :lineno + ((lineno :reader lineno :initarg :lineno :type (or (integer 0 8) null)))) (defun make-clef (name &key lineno) @@ -123,8 +122,7 @@ (defgeneric clef (fiveline-staff)) (defclass fiveline-staff (staff) - ((print-character :allocation :class :initform #\=) - (clef :accessor clef :initarg :clef :initform (make-clef :treble)) + ((clef :accessor clef :initarg :clef :initform (make-clef :treble)) (%keysig :accessor keysig :initarg :keysig :initform (make-array 7 :initial-element :natural)) (key-signatures :accessor key-signatures :initform nil))) @@ -196,8 +194,7 @@ ;;; number of dots in the usual way. (defclass note (gsharp-object) - ((print-character :allocation :class :initform #\N) - (cluster :initform nil :initarg :cluster :accessor cluster) + ((cluster :initform nil :initarg :cluster :accessor cluster) (pitch :initarg :pitch :reader pitch :type (integer 0 127)) (staff :initarg :staff :reader staff :type staff) (head :initform nil :initarg :head :reader head @@ -499,8 +496,7 @@ (defgeneric remove-note (note)) (defclass cluster (melody-element) - ((print-character :allocation :class :initform #\%) - (notes :initform '() :initarg :notes :accessor notes) + ((notes :initform '() :initarg :notes :accessor notes) (stem-direction :initform :auto :initarg :stem-direction :accessor stem-direction))) (defmethod initialize-instance :after ((c cluster) &rest args) @@ -588,8 +584,7 @@ ;;; Rest (defclass rest (melody-element) - ((print-character :allocation :class :initform #\-) - (staff :initarg :staff :reader staff) + ((staff :initarg :staff :reader staff) (staff-pos :initarg :staff-pos :initform 4 :reader staff-pos))) (defun make-rest (staff &rest args @@ -726,8 +721,7 @@ (defmethod remove-element :before ((element element) (bar bar)) (maybe-update-key-signatures bar)) -(defclass melody-bar (bar) - ((print-character :allocation :class :initform #\|))) +(defclass melody-bar (bar) ()) (defun make-melody-bar (&rest args &key elements) (declare (type list elements) @@ -769,8 +763,7 @@ (defgeneric remove-bar (bar)) (defclass slice (gsharp-object) - ((print-character :allocation :class :initform #\/) - (layer :initform nil :initarg :layer :accessor layer) + ((layer :initform nil :initarg :layer :accessor layer) (bars :initform '() :initarg :bars :accessor bars))) (defmethod initialize-instance :after ((s slice) &rest args) @@ -892,8 +885,7 @@ ;;; melody layer -(defclass melody-layer (layer) - ((print-character :allocation :class :initform #\_))) +(defclass melody-layer (layer) ()) (defun read-melody-layer-v3 (stream char n) (declare (ignore char n)) @@ -978,8 +970,7 @@ (defgeneric remove-layer (layer)) (defclass segment (gsharp-object) - ((print-character :allocation :class :initform #\S) - (buffer :initform nil :initarg :buffer :accessor buffer) + ((buffer :initform nil :initarg :buffer :accessor buffer) (layers :initform '() :initarg :layers :accessor layers) (tempo :initform 128 :initarg :tempo :accessor tempo) (tuning :initform (make-instance '12-edo) @@ -1080,8 +1071,7 @@ (defvar *default-left-margin* 20) (defclass buffer (gsharp-object esa-buffer-mixin) - ((print-character :allocation :class :initform #\B) - (segments :initform '() :initarg :segments :accessor segments) + ((segments :initform '() :initarg :segments :accessor segments) (staves :initform (list (make-fiveline-staff)) :initarg :staves :accessor staves) ;; the min width determines the preferred geographic distance after the --- /project/gsharp/cvsroot/gsharp/lyrics.lisp 2007/10/22 09:39:23 1.1 +++ /project/gsharp/cvsroot/gsharp/lyrics.lisp 2007/10/22 10:03:40 1.2 @@ -4,8 +4,7 @@ ;;; ;;; staff -(defclass lyrics-staff (staff) - ((print-character :allocation :class :initform #\L))) +(defclass lyrics-staff (staff) ()) (defun make-lyrics-staff (&rest args &key name) (declare (ignore name)) @@ -24,8 +23,7 @@ ;;; Lyrics element (defclass lyrics-element (rhythmic-element) - ((print-character :allocation :class :initform #\A) - (staff :initarg :staff :reader staff) + ((staff :initarg :staff :reader staff) (text :initarg :text :initform (make-array 5 :adjustable t :element-type 'fixnum :fill-pointer 0) :reader text) @@ -75,8 +73,7 @@ ;;; ;;; Lyrics bar -(defclass lyrics-bar (bar) - ((print-character :allocation :class :initform #\C))) +(defclass lyrics-bar (bar) ()) (defun make-lyrics-bar (&rest args &key elements) (declare (type list elements) @@ -109,8 +106,7 @@ ;;; ;;; Lyrics layer -(defclass lyrics-layer (layer) - ((print-character :allocation :class :initform #\M))) +(defclass lyrics-layer (layer) ()) (defun read-lyrics-layer-v3 (stream char n) (declare (ignore char n))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 22 Oct '07

22 Oct '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv32104 Modified Files: buffer.lisp gsharp.asd Added Files: lyrics.lisp Log Message: Factored out lyrics from buffer.lisp to a new file. --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/10/22 07:13:50 1.54 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/10/22 09:39:23 1.55 @@ -151,23 +151,6 @@ #'read-fiveline-staff-v3 *gsharp-readtable-v3*) -;;; lyric - -(defclass lyrics-staff (staff) - ((print-character :allocation :class :initform #\L))) - -(defun make-lyrics-staff (&rest args &key name) - (declare (ignore name)) - (apply #'make-instance 'lyrics-staff args)) - -(defun read-lyrics-staff-v3 (stream char n) - (declare (ignore char n)) - (apply #'make-instance 'lyrics-staff (read-delimited-list #\] stream t))) - -(set-dispatch-macro-character #\[ #\L - #'read-lyrics-staff-v3 - *gsharp-readtable-v3*) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Note @@ -636,58 +619,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; -;;; Lyrics element - -(defclass lyrics-element (rhythmic-element) - ((print-character :allocation :class :initform #\A) - (staff :initarg :staff :reader staff) - (text :initarg :text - :initform (make-array 5 :adjustable t :element-type 'fixnum :fill-pointer 0) - :reader text) - (%tie-right :initform nil :initarg :tie-right :accessor tie-right) - (%tie-left :initform nil :initarg :tie-left :accessor tie-left))) - -(defmethod initialize-instance :after ((elem lyrics-element) &rest args) - (declare (ignore args)) - (with-slots (text) elem - (unless (adjustable-array-p text) - (let ((length (length text))) - (setf text (make-array length :adjustable t :element-type 'fixnum - :fill-pointer length :initial-contents text)))))) - -(defun make-lyrics-element (staff &rest args - &key (notehead :filled) (lbeams 0) (rbeams 0) - (dots 0) (xoffset 0)) - (declare (type staff staff) - (type (member :long :breve :whole :half :filled) notehead) - (type (integer 0 5) lbeams) - (type (integer 0 5) rbeams) - (type (integer 0 3) dots) - (type number xoffset) - (ignore notehead lbeams rbeams dots xoffset)) - (apply #'make-instance 'lyrics-element - :staff staff args)) - -(defmethod slots-to-be-saved append ((elem lyrics-element)) - '(staff text)) - -(defun read-lyrics-element-v3 (stream char n) - (declare (ignore char n)) - (apply #'make-instance 'lyrics-element (read-delimited-list #\] stream t))) - -(set-dispatch-macro-character #\[ #\A - #'read-lyrics-element-v3 - *gsharp-readtable-v3*) - -(defmethod append-char ((elem lyrics-element) char) - (vector-push-extend char (text elem))) - -(defmethod erase-char ((elem lyrics-element)) - (unless (zerop (fill-pointer (text elem))) - (decf (fill-pointer (text elem))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; ;;; Bar ;;; It is recommended that the concept of a bar be hidden from the @@ -815,26 +746,6 @@ #'read-melody-bar-v3 *gsharp-readtable-v3*) -(defclass lyrics-bar (bar) - ((print-character :allocation :class :initform #\C))) - -(defun make-lyrics-bar (&rest args &key elements) - (declare (type list elements) - (ignore elements)) - (apply #'make-instance 'lyrics-bar args)) - -(defmethod make-bar-for-staff ((staff lyrics-staff) &rest args &key elements) - (declare (ignore elements)) - (apply #'make-instance 'lyrics-bar args)) - -(defun read-lyrics-bar-v3 (stream char n) - (declare (ignore char n)) - (apply #'make-instance 'lyrics-bar (read-delimited-list #\] stream t))) - -(set-dispatch-macro-character #\[ #\C - #'read-lyrics-bar-v3 - *gsharp-readtable-v3*) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Slice @@ -918,16 +829,6 @@ (add-bar (make-melody-bar) slice 0))) (setf slice nil))) -(defmethod remove-bar ((bar lyrics-bar)) - (with-slots (slice) bar - (assert slice () 'bar-not-in-slice) - (with-slots (bars) slice - (setf bars (delete bar bars :test #'eq)) - (unless bars - ;; make sure there is one bar left - (add-bar (make-lyrics-bar) slice 0))) - (setf slice nil))) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Layer @@ -1006,23 +907,6 @@ (declare (ignore staves head body tail)) (apply #'make-instance 'melody-layer args)) -;;; lyrics layer - -(defclass lyrics-layer (layer) - ((print-character :allocation :class :initform #\M))) - -(defun read-lyrics-layer-v3 (stream char n) - (declare (ignore char n)) - (apply #'make-instance 'lyrics-layer (read-delimited-list #\] stream t))) - -(set-dispatch-macro-character #\[ #\M - #'read-lyrics-layer-v3 - *gsharp-readtable-v3*) - -(defmethod make-layer-for-staff ((staff lyrics-staff) &rest args &key staves head body tail &allow-other-keys) - (declare (ignore staves head body tail)) - (apply #'make-instance 'lyrics-layer args)) - (defmethod slices ((layer layer)) (with-slots (head body tail) layer (list head body tail))) --- /project/gsharp/cvsroot/gsharp/gsharp.asd 2007/10/18 15:02:47 1.17 +++ /project/gsharp/cvsroot/gsharp/gsharp.asd 2007/10/22 09:39:23 1.18 @@ -27,6 +27,7 @@ "sdl" "score-pane" "buffer" + "lyrics" "numbering" "Obseq/obseq" "measure" --- /project/gsharp/cvsroot/gsharp/lyrics.lisp 2007/10/22 09:39:23 NONE +++ /project/gsharp/cvsroot/gsharp/lyrics.lisp 2007/10/22 09:39:23 1.1 (in-package :gsharp-buffer) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; staff (defclass lyrics-staff (staff) ((print-character :allocation :class :initform #\L))) (defun make-lyrics-staff (&rest args &key name) (declare (ignore name)) (apply #'make-instance 'lyrics-staff args)) (defun read-lyrics-staff-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'lyrics-staff (read-delimited-list #\] stream t))) (set-dispatch-macro-character #\[ #\L #'read-lyrics-staff-v3 *gsharp-readtable-v3*) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Lyrics element (defclass lyrics-element (rhythmic-element) ((print-character :allocation :class :initform #\A) (staff :initarg :staff :reader staff) (text :initarg :text :initform (make-array 5 :adjustable t :element-type 'fixnum :fill-pointer 0) :reader text) (%tie-right :initform nil :initarg :tie-right :accessor tie-right) (%tie-left :initform nil :initarg :tie-left :accessor tie-left))) (defmethod initialize-instance :after ((elem lyrics-element) &rest args) (declare (ignore args)) (with-slots (text) elem (unless (adjustable-array-p text) (let ((length (length text))) (setf text (make-array length :adjustable t :element-type 'fixnum :fill-pointer length :initial-contents text)))))) (defun make-lyrics-element (staff &rest args &key (notehead :filled) (lbeams 0) (rbeams 0) (dots 0) (xoffset 0)) (declare (type staff staff) (type (member :long :breve :whole :half :filled) notehead) (type (integer 0 5) lbeams) (type (integer 0 5) rbeams) (type (integer 0 3) dots) (type number xoffset) (ignore notehead lbeams rbeams dots xoffset)) (apply #'make-instance 'lyrics-element :staff staff args)) (defmethod slots-to-be-saved append ((elem lyrics-element)) '(staff text)) (defun read-lyrics-element-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'lyrics-element (read-delimited-list #\] stream t))) (set-dispatch-macro-character #\[ #\A #'read-lyrics-element-v3 *gsharp-readtable-v3*) (defmethod append-char ((elem lyrics-element) char) (vector-push-extend char (text elem))) (defmethod erase-char ((elem lyrics-element)) (unless (zerop (fill-pointer (text elem))) (decf (fill-pointer (text elem))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Lyrics bar (defclass lyrics-bar (bar) ((print-character :allocation :class :initform #\C))) (defun make-lyrics-bar (&rest args &key elements) (declare (type list elements) (ignore elements)) (apply #'make-instance 'lyrics-bar args)) (defmethod make-bar-for-staff ((staff lyrics-staff) &rest args &key elements) (declare (ignore elements)) (apply #'make-instance 'lyrics-bar args)) (defun read-lyrics-bar-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'lyrics-bar (read-delimited-list #\] stream t))) (set-dispatch-macro-character #\[ #\C #'read-lyrics-bar-v3 *gsharp-readtable-v3*) (defmethod remove-bar ((bar lyrics-bar)) (with-slots (slice) bar (assert slice () 'bar-not-in-slice) (with-slots (bars) slice (setf bars (delete bar bars :test #'eq)) (unless bars ;; make sure there is one bar left (add-bar (make-lyrics-bar) slice 0))) (setf slice nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Lyrics layer (defclass lyrics-layer (layer) ((print-character :allocation :class :initform #\M))) (defun read-lyrics-layer-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'lyrics-layer (read-delimited-list #\] stream t))) (set-dispatch-macro-character #\[ #\M #'read-lyrics-layer-v3 *gsharp-readtable-v3*) (defmethod make-layer-for-staff ((staff lyrics-staff) &rest args &key staves head body tail &allow-other-keys) (declare (ignore staves head body tail)) (apply #'make-instance 'lyrics-layer args))

1 0

[gsharp-cvs] CVS gsharp
by rstrandh 22 Oct '07

22 Oct '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv1519 Modified Files: buffer.lisp Log Message: Implemented a simplified I/O mechanism with less redundancy. --- /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/09/18 21:19:03 1.53 +++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/10/22 07:13:50 1.54 @@ -12,24 +12,25 @@ (set-syntax-from-char #\] #\) *gsharp-readtable-v3*) (set-syntax-from-char #\] #\) *gsharp-readtable-v4*) -(defclass gsharp-object () ()) +(defgeneric slots-to-be-saved (object) + (:method-combination append :most-specific-last)) -(defgeneric print-gsharp-object (obj stream) - (:method-combination progn)) +(defun save-object (object stream) + (pprint-logical-block (stream nil :prefix "[" :suffix "]") + (format stream "~s ~2i" (class-name (class-of object))) + (loop for slot-name in (slots-to-be-saved object) + do (let ((slot (find slot-name (sb-mop:class-slots (class-of object)) + :key #'sb-mop:slot-definition-name + :test #'eq))) + (format stream "~_~W ~W " + (car (sb-mop:slot-definition-initargs slot)) + (slot-value object (sb-mop:slot-definition-name slot))))))) -(defmethod print-gsharp-object :around ((obj gsharp-object) stream) - (format stream "~s ~2i" (class-name (class-of obj))) - (call-next-method)) - -;;; (defmethod print-object :around ((obj gsharp-object) stream) -;;; (format stream "[~a " (slot-value obj 'print-character)) -;;; (call-next-method) -;;; (format stream "] ")) +(defclass gsharp-object () ()) (defmethod print-object ((obj gsharp-object) stream) (if *print-circle* - (pprint-logical-block (stream nil :prefix "[" :suffix "]") - (print-gsharp-object obj stream)) + (save-object obj stream) (print-unreadable-object (obj stream :type t :identity t)))) (defgeneric name (obj)) @@ -37,8 +38,8 @@ (defclass name-mixin () ((name :initarg :name :accessor name))) -(defmethod print-gsharp-object progn ((obj name-mixin) stream) - (format stream "~_:name ~W " (name obj))) +(defmethod slots-to-be-saved append ((obj name-mixin)) + '(name)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -73,8 +74,8 @@ (:percussion 3)))) (make-instance 'clef :name name :lineno lineno)) -(defmethod print-gsharp-object progn ((c clef) stream) - (format stream "~_:lineno ~W " (lineno c))) +(defmethod slots-to-be-saved append ((c clef)) + '(lineno)) (defun read-clef-v3 (stream char n) (declare (ignore char n)) @@ -139,8 +140,8 @@ (declare (ignore name clef keysig)) (apply #'make-instance 'fiveline-staff args)) -(defmethod print-gsharp-object progn ((s fiveline-staff) stream) - (format stream "~_:clef ~W ~_:keysig ~W " (clef s) (keysig s))) +(defmethod slots-to-be-saved append ((s fiveline-staff)) + '(clef %keysig)) (defun read-fiveline-staff-v3 (stream char n) (declare (ignore char n)) @@ -240,12 +241,8 @@ (ignore head accidentals dots)) (apply #'make-instance 'note :pitch pitch :staff staff args)) -(defmethod print-gsharp-object progn ((n note) stream) - (with-slots (pitch staff head accidentals dots %tie-right %tie-left) n - (format stream - "~_:pitch ~W ~_:staff ~W ~_:head ~W ~_:accidentals ~W ~_:dots ~W ~ - ~@[~_:tie-right ~W ~]~@[~_:tie-left ~W ~]" - pitch staff head accidentals dots %tie-right %tie-left))) +(defmethod slots-to-be-saved append ((n note)) + '(pitch staff head accidentals dots %tie-right %tie-left)) (defun read-note-v3 (stream char n) (declare (ignore char n)) @@ -279,9 +276,8 @@ :initarg :master-pitch-freq :accessor master-pitch-freq))) -(defmethod print-gsharp-object progn ((tuning tuning) stream) - (format stream "~_:master-pitch-note ~W ~_:master-pitch-freq ~W " - (master-pitch-note tuning) (master-pitch-freq tuning))) +(defmethod slots-to-be-saved append ((tuning tuning)) + '(master-pitch-note master-pitch-freq)) ;;; Returns how a note should be tuned in a given tuning ;;; in terms of a cent value. @@ -293,9 +289,8 @@ (defclass 12-edo (tuning) ()) -(defmethod print-gsharp-object progn ((tuning 12-edo) stream) - ;; no parameters to save - ) +(defmethod slots-to-be-saved append ((tuning 12-edo)) + '()) (defmethod note-cents ((note note) (tuning 12-edo)) (multiple-value-bind (octave pitch) (floor (pitch note) 7) @@ -322,9 +317,8 @@ ;; TODO: Add cent sizes of various microtonal accidentals, perhaps in an alist? )) -(defmethod print-gsharp-object progn ((tuning regular-temperament) stream) - (format stream "~_:octave-cents ~W ~_:fifth-cents ~W " - (octave-cents tuning) (fifth-cents tuning))) +(defmethod slots-to-be-saved append ((tuning regular-temperament)) + '(octave-cents fifth-cents)) (defmethod note-cents ((note note) (tuning regular-temperament)) (let ((octaves 1) @@ -371,10 +365,8 @@ ((bar :initform nil :initarg :bar :accessor bar) (xoffset :initform 0 :initarg :xoffset :accessor xoffset))) -(defmethod print-gsharp-object progn ((e element) stream) - (with-slots (notehead rbeams lbeams dots xoffset) e - (format stream - "~_:xoffset ~W " xoffset))) +(defmethod slots-to-be-saved append ((e element)) + '(xoffset)) (defmethod duration ((element element)) 0) (defmethod rbeams ((element element)) 0) @@ -410,11 +402,8 @@ (lbeams :initform 0 :initarg :lbeams :accessor lbeams) (dots :initform 0 :initarg :dots :accessor dots))) -(defmethod print-gsharp-object progn ((e rhythmic-element) stream) - (with-slots (notehead rbeams lbeams dots) e - (format stream - "~_:notehead ~W ~_:rbeams ~W ~_:lbeams ~W ~_:dots ~W " - notehead rbeams lbeams dots))) +(defmethod slots-to-be-saved append ((e rhythmic-element)) + '(notehead rbeams lbeams dots)) (defmethod undotted-duration ((element rhythmic-element)) (ecase (notehead element) @@ -467,10 +456,8 @@ (ignore alterations)) (apply #'make-instance 'key-signature :staff staff args)) -(defmethod print-gsharp-object progn ((k key-signature) stream) - (with-slots (%staff %alterations) k - (format stream - "~_:staff ~W ~_:alterations ~W " %staff %alterations))) +(defmethod slots-to-be-saved append ((k key-signature)) + '(%staff %alterations)) (defmethod more-sharps ((sig key-signature) &optional (n 1)) (let ((alt (alterations sig))) @@ -551,9 +538,8 @@ (ignore notehead lbeams rbeams dots xoffset notes stem-direction)) (apply #'make-instance 'cluster args)) -(defmethod print-gsharp-object progn ((c cluster) stream) - (with-slots (stem-direction notes) c - (format stream "~_:stem-direction ~W ~_:notes ~W " stem-direction notes))) +(defmethod slots-to-be-saved append ((c cluster)) + '(stem-direction notes)) (defun read-cluster-v3 (stream char n) (declare (ignore char n)) @@ -637,9 +623,8 @@ (apply #'make-instance 'rest :staff staff args)) -(defmethod print-gsharp-object progn ((s rest) stream) - (with-slots (staff staff-pos) s - (format stream "~_:staff ~W ~_:staff-pos ~W " staff staff-pos))) +(defmethod slots-to-be-saved append ((s rest)) + '(staff staff-pos)) (defun read-rest-v3 (stream char n) (declare (ignore char n)) @@ -683,9 +668,8 @@ (apply #'make-instance 'lyrics-element :staff staff args)) -(defmethod print-gsharp-object progn ((elem lyrics-element) stream) - (with-slots (staff text) elem - (format stream "~_:staff ~W ~_:text ~W " staff text))) +(defmethod slots-to-be-saved append ((elem lyrics-element)) + '(staff text)) (defun read-lyrics-element-v3 (stream char n) (declare (ignore char n)) @@ -738,8 +722,8 @@ (loop for element in (elements b) do (setf (bar element) b))) -(defmethod print-gsharp-object progn ((b bar) stream) - (format stream "~_:elements ~W " (elements b))) +(defmethod slots-to-be-saved append ((b bar)) + '(elements)) ;;; The duration of a bar is simply the sum of durations ;;; of its elements. We might want to improve on the @@ -888,8 +872,8 @@ (ignore bars)) (apply #'make-instance 'slice args)) -(defmethod print-gsharp-object progn ((s slice) stream) - (format stream "~_:bars ~W " (bars s))) +(defmethod slots-to-be-saved append ((s slice)) + '(bars)) (defun read-slice-v3 (stream char n) (declare (ignore char n)) @@ -994,10 +978,8 @@ (layer (body l)) l (layer (tail l)) l)) -(defmethod print-gsharp-object progn ((l layer) stream) - (with-slots (head body tail staves) l - (format stream "~_:staves ~W ~_:head ~W ~_:body ~W ~_:tail ~W " - staves head body tail))) +(defmethod slots-to-be-saved append ((l layer)) + '(staves head body tail)) (defgeneric make-layer-for-staff (staff &rest args &key staves head body tail &allow-other-keys)) @@ -1128,9 +1110,8 @@ (loop for layer in layers do (setf (segment layer) s)))) -(defmethod print-gsharp-object progn ((s segment) stream) - (format stream "~_:layers ~W ~_:tempo ~W ~_:tuning ~W " - (layers s) (tempo s) (tuning s))) +(defmethod slots-to-be-saved append ((s segment)) + '(layers tempo tuning)) (defun read-segment-v3 (stream char n) (declare (ignore char n)) @@ -1247,11 +1228,8 @@ (loop for segment in segments do (setf (buffer segment) b)))) -(defmethod print-gsharp-object progn ((b buffer) stream) - (with-slots (staves segments min-width spacing-style right-edge left-offset left-margin) b - (format stream - "~_:min-width ~W ~_:spacing-style ~W ~_:right-edge ~W ~_:left-offset ~W ~_:left-margin ~W ~_:staves ~W ~_:segments ~W " - min-width spacing-style right-edge left-offset left-margin staves segments ))) +(defmethod slots-to-be-saved append ((b buffer)) + '(min-width spacing-style right-edge left-offset left-margin staves segments)) (defun read-buffer-v3 (stream char n) (declare (ignore char n))

1 0

[gsharp-cvs] CVS gsharp
by mjonsson 20 Oct '07

20 Oct '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv1017 Modified Files: play.lisp Log Message: Report an error to the user if the midi-player fails (sbcl only) --- /project/gsharp/cvsroot/gsharp/play.lisp 2007/06/28 12:58:17 1.9 +++ /project/gsharp/cvsroot/gsharp/play.lisp 2007/10/20 18:41:25 1.10 @@ -77,6 +77,16 @@ (incf time (* *tempo* duration)))) (bars slice) durations)))) +(define-condition midi-player-failed (gsharp-condition) + ((midi-player :initarg :midi-player) + (exit-code :initarg :exit-code)) + (:report + (lambda (condition stream) + (with-slots (midi-player exit-code) condition + (format stream + "Midi player ~S returned exit code ~S, indicating that an error occurred." + midi-player exit-code))))) + (defun play-tracks (tracks) (let ((midifile (make-instance 'midifile :format 1 @@ -88,10 +98,16 @@ (append *midi-player-arguments* (list *midi-temp-file*))) #+sbcl - (sb-ext:run-program *midi-player* - (append *midi-player-arguments* - (list *midi-temp-file*)) - :search t) + (let ((process + (sb-ext:run-program *midi-player* + (append *midi-player-arguments* + (list *midi-temp-file*)) + :search t))) + (sb-ext:process-wait process) + (when (not (zerop (sb-ext:process-exit-code process))) + (error 'midi-player-failed + :midi-player *midi-player* + :exit-code (sb-ext:process-exit-code process)))) #+clisp (ext:run-program *midi-player* :arguments (append *midi-player-arguments*

1 0

[gsharp-cvs] CVS gsharp/Mxml/tests
by crhodes 18 Oct '07

18 Oct '07

Update of /project/gsharp/cvsroot/gsharp/Mxml/tests In directory clnet:/tmp/cvs-serv30948/Mxml/tests Added Files: 2staves.gsh README assorted_accidentals.gsh assorted_accidentals.xml bars.gsh bars.xml clefs.gsh clefs.xml durations.gsh durations.xml flags.gsh forced_naturals.gsh forced_naturals.xml funny_durations.gsh hellochord.gsh hellochord.xml helloworld.gsh helloworld.xml just_voices.xml keychange.gsh keysigs_on_staves.gsh keysigs_on_staves.xml lyrics-test.gsh lyrics.gsh lyrics.xml other_voices.gsh other_voices.xml overlapping_layers.gsh parts.xml position.lisp rests.gsh rests.xml segments.gsh staves.gsh staves.xml tie.gsh tie.xml Log Message: Add MusicXML support. Initial work from Brian Gruber (funded by Google's Summer of Code); subsequent development by Christophe Rhodes. It's far from perfect now, but it needs checking in so that people can play with it. It adds dependencies (puri and cxml) to gsharp; if this is a problem, we could make gsharp-mxml a separate system. Git logs (from git tree at <http://www-jcsu.jesus.cam.ac.uk/~csr21/git/gsharp-mxml/.git>) follow: commit 994cd15ec9f480be41515e699f22e7de1687d0ca Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 24 13:19:41 2007 +0100 Add a restart to the same-duration case. It's not good enough, but it allows interactive fixing key signatures in the middle of the bar. commit cdc2098fac5399303e9515bc81ea65020ec8f109 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 11:07:28 2007 +0100 Only add durations from rhythmic elements. commit acc6cb410cd55dfe59eb30fe608b101a62651ae9 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 10:45:12 2007 +0100 Whoops. Fix export of notes with no displayed accidentals (from overzealous alteration of CASE -> ECASE commit dd8d72cac434a8c5a1932aa46db6447e08d9b6ad Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 10:41:09 2007 +0100 Support for longs in MusicXML (import and export) commit eab440b56b086e766dbd405a3fea44d9976f1a1f Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 09:16:07 2007 +0100 Long ("lunga") patch from HEAD commit 8cb34a4879ebb4dce06d8b99da761dfa6ad24cf9 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:43:51 2007 +0100 Support semi- and sesqui- accidentals commit 6ba8208d1f8475552a95f35a5e896248110b0efd Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:25:16 2007 +0100 Really support breves (and breve rests) -- on output too. commit a9c36278de0145c12f34123a29815809030b97c2 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:17:09 2007 +0100 Slightly batched commit (several changes). * support :breve noteheads * better stringcase macro (and use it) * temporarily hack in "full" = "breve" for Goldsmiths use * use ECASE in one or two places to remove compiler warnings. commit 3a3b980576f0d09ddee4de12f6f7b260932a5552 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:14:54 2007 +0100 Slightly friendlier (with friends like this...) Import and Export commands. Sets the filepath and name of the buffer on import; sensible export default pathname. commit 7d72a2a4a28f9668271189ebaf862518ada34877 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:13:31 2007 +0100 Whitespace commit b497d6f5111f20f5e8ac9a059578d3caaab1b832 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 17 21:33:29 2007 +0100 space requirements fix from HEAD commit 65d173efbcfa78e5edaf1adb9bceb0f7d619002d Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 17 12:04:08 2007 +0100 Update to Brian Gruber's version of 17th September commit 91d98d9e2a8d69418edd264ab6293a2f1dbc5a9f Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 17 11:54:53 2007 +0100 Brian Gruber's patch of August 20th --- /project/gsharp/cvsroot/gsharp/Mxml/tests/2staves.gsh 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/2staves.gsh 2007/10/18 15:02:58 1.1 G#V4 [GSHARP-BUFFER:BUFFER :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 :left-margin 20 :staves (#1=[GSHARP-BUFFER:FIVELINE-STAFF :clef [GSHARP-BUFFER:CLEF :lineno 2 :name :TREBLE ] :keysig [GSHARP-BUFFER:KEY-SIGNATURE :staff #1# :alterations #(:NATURAL :NATURAL :NATURAL :NATURAL :NATURAL :NATURAL :NATURAL) :xoffset 0 ] :name "default staff" ] #2=[GSHARP-BUFFER:FIVELINE-STAFF :clef [GSHARP-BUFFER:CLEF :lineno 2 :name :TREBLE ] :keysig [GSHARP-BUFFER:KEY-SIGNATURE :staff #2# :alterations #(:NATURAL :NATURAL :NATURAL :NATURAL :NATURAL :NATURAL :NATURAL) :xoffset 0 ] :name "below" ]) :segments ([GSHARP-BUFFER:SEGMENT :layers ([GSHARP-BUFFER:MELODY-LAYER :staves (#2# #1#) :head [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:MELODY-BAR :elements COMMON-LISP:NIL ]) ] :body [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 33 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 ] [GSHARP-BUFFER:CLUSTER :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 34 :staff #2# :head :FILLED :accidentals :NATURAL :dots 0 ]) :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 ]) ]) ] :tail [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:MELODY-BAR :elements COMMON-LISP:NIL ]) ] :name "default layer" ]) :tempo 128 ]) ] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/README 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/README 2007/10/18 15:02:58 1.1 Files with matching names SHOULD roundtrip, excepting the ones involving lyrics. --- /project/gsharp/cvsroot/gsharp/Mxml/tests/assorted_accidentals.gsh 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/assorted_accidentals.gsh 2007/10/18 15:02:58 1.1 G#V4 [GSHARP-BUFFER:BUFFER :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 :left-margin 20 :staves (#1=[GSHARP-BUFFER:FIVELINE-STAFF :clef [GSHARP-BUFFER:CLEF :lineno 2 :name :TREBLE ] :keysig [GSHARP-BUFFER:KEY-SIGNATURE :staff #1# :alterations #(:NATURAL :NATURAL :NATURAL :NATURAL :NATURAL :NATURAL :FLAT) :xoffset 0 ] :name "default staff" ]) :segments ([GSHARP-BUFFER:SEGMENT :layers ([GSHARP-BUFFER:MELODY-LAYER :staves (#1#) :head [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:MELODY-BAR :elements COMMON-LISP:NIL ]) ] :body [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 28 :staff #1# :head :FILLED :accidentals :FLAT :dots 0 ]) :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 ] [GSHARP-BUFFER:CLUSTER :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 29 :staff #1# :head :FILLED :accidentals :DOUBLE-FLAT :dots 0 ]) :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 ] [GSHARP-BUFFER:CLUSTER :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 30 :staff #1# :head :FILLED :accidentals :SHARP :dots 0 ]) :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 ] [GSHARP-BUFFER:CLUSTER :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 31 :staff #1# :head :FILLED :accidentals :DOUBLE-SHARP :dots 0 ]) :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 ] [GSHARP-BUFFER:CLUSTER :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 34 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) :notehead :WHOLE :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 28 :staff #1# :head :FILLED :accidentals :SEMISHARP :dots 0 ]) :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 ] [GSHARP-BUFFER:CLUSTER :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 29 :staff #1# :head :FILLED :accidentals :SESQUISHARP :dots 0 ]) :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 ] [GSHARP-BUFFER:CLUSTER :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 30 :staff #1# :head :FILLED :accidentals :SEMIFLAT :dots 0 ]) :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 ] [GSHARP-BUFFER:CLUSTER :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 31 :staff #1# :head :FILLED :accidentals :SESQUIFLAT :dots 0 ]) :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 ]) ]) ] :tail [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:MELODY-BAR :elements COMMON-LISP:NIL ]) ] :name "default layer" ]) :tempo 128 :tuning [GSHARP-BUFFER:12-EDO :master-pitch-note [GSHARP-BUFFER:NOTE :pitch 33 :staff [GSHARP-BUFFER:STAFF :name "default staff" ] :head COMMON-LISP:NIL :accidentals :NATURAL :dots COMMON-LISP:NIL ] :master-pitch-freq 440 ] ]) ] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/assorted_accidentals.xml 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/assorted_accidentals.xml 2007/10/18 15:02:58 1.1 <?xml version="1.0" encoding="UTF-8" standalone="no"?> <!DOCTYPE score-partwise PUBLIC "-//Recordare//DTD MusicXML 1.1 Partwise//EN" "http://www.musicxml.org/dtds/partwise.dtd"> <score-partwise version="1.1"> <part-list> <score-part id="P1"> <part-name>Music</part-name> </score-part> </part-list> <part id="P1"> <measure number="1"> <attributes> <divisions>1</divisions> <key> <fifths>-1</fifths> </key> <clef> <sign>G</sign> <line>2</line> </clef> </attributes> <note> <pitch> <step>C</step> <alter>-1</alter> <octave>4</octave> </pitch> <duration>4</duration> <type>whole</type> <accidental>flat</accidental> </note> <note> <pitch> <step>D</step> <alter>-2</alter> <octave>4</octave> </pitch> <duration>4</duration> <type>whole</type> <accidental>flat-flat</accidental> </note> <note> <pitch> <step>E</step> <alter>1</alter> <octave>4</octave> </pitch> <duration>4</duration> <type>whole</type> <accidental>sharp</accidental> </note> <note> <pitch> <step>F</step> <alter>2</alter> <octave>4</octave> </pitch> <duration>4</duration> <type>whole</type> <accidental>double-sharp</accidental> </note> <note> <pitch> <step>B</step> <octave>4</octave> </pitch> <duration>4</duration> <type>whole</type> <accidental>natural</accidental> </note> </measure> </part> </score-partwise> --- /project/gsharp/cvsroot/gsharp/Mxml/tests/bars.gsh 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/bars.gsh 2007/10/18 15:02:58 1.1 G#V4 [GSHARP-BUFFER:BUFFER :min-width 17 :spacing-style 0.4 :right-edge 700 :left-offset 30 :left-margin 20 :staves (#1=[GSHARP-BUFFER:FIVELINE-STAFF :clef [GSHARP-BUFFER:CLEF :lineno 2 :name :TREBLE ] :keysig [GSHARP-BUFFER:KEY-SIGNATURE :staff #1# :alterations #(:NATURAL :NATURAL :NATURAL :NATURAL :NATURAL :NATURAL :NATURAL) :xoffset 0 ] :name #2="default staff" ]) :segments ([GSHARP-BUFFER:SEGMENT :layers ([GSHARP-BUFFER:MELODY-LAYER :staves (#1#) :head [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:MELODY-BAR :elements COMMON-LISP:NIL ]) ] :body [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 33 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 ]) ] [GSHARP-BUFFER:MELODY-BAR :elements ([GSHARP-BUFFER:CLUSTER :stem-direction :AUTO :notes ([GSHARP-BUFFER:NOTE :pitch 34 :staff #1# :head :FILLED :accidentals :NATURAL :dots 0 ]) :notehead :FILLED :rbeams 0 :lbeams 0 :dots 0 :xoffset 0 ]) ]) ] :tail [GSHARP-BUFFER:SLICE :bars ([GSHARP-BUFFER:MELODY-BAR :elements COMMON-LISP:NIL ]) ] :name "default layer" ]) :tempo 128 :tuning [GSHARP-BUFFER:12-EDO :master-pitch-note [GSHARP-BUFFER:NOTE :pitch 33 :staff [GSHARP-BUFFER:STAFF :name #2# ] :head COMMON-LISP:NIL :accidentals :NATURAL :dots COMMON-LISP:NIL ] :master-pitch-freq 440 ] ]) ] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/bars.xml 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/bars.xml 2007/10/18 15:02:58 1.1 <?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE score-partwise PUBLIC "-//Recordare//DTD MusicXML 1.1 Partwise//EN" "http://www.musicxml.org/dtds/partwise.dtd"> <score-partwise version="1.1"> <part-list> <score-part id="P1"> <part-name>P1</part-name> </score-part> </part-list> <part id="P1"> <measure number="1"> <attributes> <divisions>1</divisions> <key> <fifths>0</fifths> </key> <clef> <sign>G</sign> <line>2</line> </clef> </attributes> <note> <pitch> <step>A</step> <octave>4</octave> </pitch> <duration>4</duration> <type>whole</type> </note> </measure> <measure number="2"> <note> <pitch> <step>B</step> <octave>4</octave> </pitch> <duration>4</duration> <type>whole</type> </note> </measure> </part> [1 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/clefs.gsh 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/clefs.gsh 2007/10/18 15:02:58 1.1 [76 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/clefs.xml 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/clefs.xml 2007/10/18 15:02:58 1.1 [120 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/durations.gsh 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/durations.gsh 2007/10/18 15:02:58 1.1 [324 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/durations.xml 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/durations.xml 2007/10/18 15:02:58 1.1 [458 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/flags.gsh 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/flags.gsh 2007/10/18 15:02:58 1.1 [522 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/forced_naturals.gsh 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/forced_naturals.gsh 2007/10/18 15:02:58 1.1 [655 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/forced_naturals.xml 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/forced_naturals.xml 2007/10/18 15:02:58 1.1 [752 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/funny_durations.gsh 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/funny_durations.gsh 2007/10/18 15:02:58 1.1 [956 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/hellochord.gsh 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/hellochord.gsh 2007/10/18 15:02:58 1.1 [1047 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/hellochord.xml 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/hellochord.xml 2007/10/18 15:02:58 1.1 [1144 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/helloworld.gsh 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/helloworld.gsh 2007/10/18 15:02:58 1.1 [1186 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/helloworld.xml 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/helloworld.xml 2007/10/18 15:02:58 1.1 [1219 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/just_voices.xml 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/just_voices.xml 2007/10/18 15:02:58 1.1 [1266 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/keychange.gsh 2007/10/18 15:02:58 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/keychange.gsh 2007/10/18 15:02:58 1.1 [1514 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/keysigs_on_staves.gsh 2007/10/18 15:03:04 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/keysigs_on_staves.gsh 2007/10/18 15:03:04 1.1 [1580 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/keysigs_on_staves.xml 2007/10/18 15:03:04 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/keysigs_on_staves.xml 2007/10/18 15:03:04 1.1 [1632 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/lyrics-test.gsh 2007/10/18 15:03:04 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/lyrics-test.gsh 2007/10/18 15:03:04 1.1 [1761 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/lyrics.gsh 2007/10/18 15:03:04 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/lyrics.gsh 2007/10/18 15:03:04 1.1 [1882 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/lyrics.xml 2007/10/18 15:03:04 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/lyrics.xml 2007/10/18 15:03:04 1.1 [1942 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/other_voices.gsh 2007/10/18 15:03:04 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/other_voices.gsh 2007/10/18 15:03:04 1.1 [2277 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/other_voices.xml 2007/10/18 15:03:04 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/other_voices.xml 2007/10/18 15:03:04 1.1 [2628 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/overlapping_layers.gsh 2007/10/18 15:03:05 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/overlapping_layers.gsh 2007/10/18 15:03:05 1.1 [2761 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/parts.xml 2007/10/18 15:03:06 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/parts.xml 2007/10/18 15:03:06 1.1 [2836 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/position.lisp 2007/10/18 15:03:06 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/position.lisp 2007/10/18 15:03:06 1.1 [2854 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/rests.gsh 2007/10/18 15:03:06 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/rests.gsh 2007/10/18 15:03:06 1.1 [2940 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/rests.xml 2007/10/18 15:03:06 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/rests.xml 2007/10/18 15:03:06 1.1 [3011 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/segments.gsh 2007/10/18 15:03:06 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/segments.gsh 2007/10/18 15:03:06 1.1 [3097 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/staves.gsh 2007/10/18 15:03:06 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/staves.gsh 2007/10/18 15:03:06 1.1 [3249 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/staves.xml 2007/10/18 15:03:06 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/staves.xml 2007/10/18 15:03:06 1.1 [3292 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/tie.gsh 2007/10/18 15:03:06 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/tie.gsh 2007/10/18 15:03:06 1.1 [3358 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/tests/tie.xml 2007/10/18 15:03:06 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/tests/tie.xml 2007/10/18 15:03:06 1.1 [3417 lines skipped]

1 0

[gsharp-cvs] CVS gsharp/Mxml/mxml-dtds
by crhodes 18 Oct '07

18 Oct '07

Update of /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds In directory clnet:/tmp/cvs-serv30948/Mxml/mxml-dtds Added Files: ISOlat1.pen ISOlat2.pen MIDIEvents10.dtd attributes.dtd barline.dtd common.dtd direction.dtd identity.dtd layout.dtd link.dtd midixml.dtd midixml.xsl note.dtd opus.dtd parttime.xsl partwise.dtd score.dtd timepart.xsl timewise.dtd to10.xsl Log Message: Add MusicXML support. Initial work from Brian Gruber (funded by Google's Summer of Code); subsequent development by Christophe Rhodes. It's far from perfect now, but it needs checking in so that people can play with it. It adds dependencies (puri and cxml) to gsharp; if this is a problem, we could make gsharp-mxml a separate system. Git logs (from git tree at <http://www-jcsu.jesus.cam.ac.uk/~csr21/git/gsharp-mxml/.git>) follow: commit 994cd15ec9f480be41515e699f22e7de1687d0ca Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 24 13:19:41 2007 +0100 Add a restart to the same-duration case. It's not good enough, but it allows interactive fixing key signatures in the middle of the bar. commit cdc2098fac5399303e9515bc81ea65020ec8f109 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 11:07:28 2007 +0100 Only add durations from rhythmic elements. commit acc6cb410cd55dfe59eb30fe608b101a62651ae9 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 10:45:12 2007 +0100 Whoops. Fix export of notes with no displayed accidentals (from overzealous alteration of CASE -> ECASE commit dd8d72cac434a8c5a1932aa46db6447e08d9b6ad Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 10:41:09 2007 +0100 Support for longs in MusicXML (import and export) commit eab440b56b086e766dbd405a3fea44d9976f1a1f Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 09:16:07 2007 +0100 Long ("lunga") patch from HEAD commit 8cb34a4879ebb4dce06d8b99da761dfa6ad24cf9 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:43:51 2007 +0100 Support semi- and sesqui- accidentals commit 6ba8208d1f8475552a95f35a5e896248110b0efd Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:25:16 2007 +0100 Really support breves (and breve rests) -- on output too. commit a9c36278de0145c12f34123a29815809030b97c2 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:17:09 2007 +0100 Slightly batched commit (several changes). * support :breve noteheads * better stringcase macro (and use it) * temporarily hack in "full" = "breve" for Goldsmiths use * use ECASE in one or two places to remove compiler warnings. commit 3a3b980576f0d09ddee4de12f6f7b260932a5552 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:14:54 2007 +0100 Slightly friendlier (with friends like this...) Import and Export commands. Sets the filepath and name of the buffer on import; sensible export default pathname. commit 7d72a2a4a28f9668271189ebaf862518ada34877 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:13:31 2007 +0100 Whitespace commit b497d6f5111f20f5e8ac9a059578d3caaab1b832 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 17 21:33:29 2007 +0100 space requirements fix from HEAD commit 65d173efbcfa78e5edaf1adb9bceb0f7d619002d Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 17 12:04:08 2007 +0100 Update to Brian Gruber's version of 17th September commit 91d98d9e2a8d69418edd264ab6293a2f1dbc5a9f Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 17 11:54:53 2007 +0100 Brian Gruber's patch of August 20th --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/ISOlat1.pen 2007/10/18 15:02:48 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/ISOlat1.pen 2007/10/18 15:02:48 1.1     <!ENTITY Agrave "À" > <!ENTITY Aacute "Á" > <!ENTITY Acirc "Â" > <!ENTITY Atilde "Ã" > <!ENTITY Auml "Ä" > <!ENTITY Aring "Å" > <!ENTITY AElig "Æ" > <!ENTITY Ccedil "Ç" > <!ENTITY Egrave "È" > <!ENTITY Eacute "É" > <!ENTITY Ecirc "Ê" > <!ENTITY Euml "Ë" > <!ENTITY Igrave "Ì" > <!ENTITY Iacute "Í" > <!ENTITY Icirc "Î" > <!ENTITY Iuml "Ï" > <!ENTITY ETH "Ð" > <!ENTITY Ntilde "Ñ" > <!ENTITY Ograve "Ò" > <!ENTITY Oacute "Ó" > <!ENTITY Ocirc "Ô" > <!ENTITY Otilde "Õ" > <!ENTITY Ouml "Ö" > <!ENTITY Oslash "Ø" > <!ENTITY Ugrave "Ù" > <!ENTITY Uacute "Ú" > <!ENTITY Ucirc "Û" > <!ENTITY Uuml "Ü" > <!ENTITY Yacute "Ý" > <!ENTITY THORN "Þ" > <!ENTITY szlig "ß" > <!ENTITY agrave "à" > <!ENTITY aacute "á" > <!ENTITY acirc "â" > <!ENTITY atilde "ã" > <!ENTITY auml "ä" > <!ENTITY aring "å" > <!ENTITY aelig "æ" > <!ENTITY ccedil "ç" > <!ENTITY egrave "è" > <!ENTITY eacute "é" > <!ENTITY ecirc "ê" > <!ENTITY euml "ë" > <!ENTITY igrave "ì" > <!ENTITY iacute "í" > <!ENTITY icirc "î" > <!ENTITY iuml "ï" > <!ENTITY eth "ð" > <!ENTITY ntilde "ñ" > <!ENTITY ograve "ò" > <!ENTITY oacute "ó" > <!ENTITY ocirc "ô" > <!ENTITY otilde "õ" > <!ENTITY ouml "ö" > <!ENTITY oslash "ø" > <!ENTITY ugrave "ù" > <!ENTITY uacute "ú" > <!ENTITY ucirc "û" > <!ENTITY uuml "ü" > <!ENTITY yacute "ý" > <!ENTITY thorn "þ" > <!ENTITY yuml "ÿ" > --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/ISOlat2.pen 2007/10/18 15:02:48 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/ISOlat2.pen 2007/10/18 15:02:48 1.1    <!ENTITY abreve "ă" > <!ENTITY Abreve "Ă" > <!ENTITY amacr "ā" > <!ENTITY Amacr "Ā" > <!ENTITY aogon "ą" > <!ENTITY Aogon "Ą" > <!ENTITY cacute "ć" > <!ENTITY Cacute "Ć" > <!ENTITY ccaron "č" > <!ENTITY Ccaron "Č" > <!ENTITY ccirc "ĉ" > <!ENTITY Ccirc "Ĉ" > <!ENTITY cdot "ċ" > <!ENTITY Cdot "Ċ" > <!ENTITY dcaron "ď" > <!ENTITY Dcaron "Ď" > <!ENTITY dstrok "đ" > <!ENTITY Dstrok "Đ" > <!ENTITY ecaron "ě" > <!ENTITY Ecaron "Ě" > <!ENTITY edot "ė" > <!ENTITY Edot "Ė" > <!ENTITY emacr "ē" > <!ENTITY Emacr "Ē" > <!ENTITY eogon "ę" > <!ENTITY Eogon "Ę" > <!ENTITY gacute "ǵ" > <!ENTITY gbreve "ğ" > <!ENTITY Gbreve "Ğ" > <!ENTITY Gcedil "Ģ" > <!ENTITY gcirc "ĝ" > <!ENTITY Gcirc "Ĝ" > <!ENTITY gdot "ġ" > <!ENTITY Gdot "Ġ" > <!ENTITY hcirc "ĥ" > <!ENTITY Hcirc "Ĥ" > <!ENTITY hstrok "ħ" > <!ENTITY Hstrok "Ħ" > <!ENTITY Idot "İ" > <!ENTITY Imacr "Ī" > <!ENTITY imacr "ī" > <!ENTITY ijlig "ĳ" > <!ENTITY IJlig "Ĳ" > <!ENTITY inodot "ı" > <!ENTITY iogon "į" > <!ENTITY Iogon "Į" > <!ENTITY itilde "ĩ" > <!ENTITY Itilde "Ĩ" > <!ENTITY jcirc "ĵ" > <!ENTITY Jcirc "Ĵ" > <!ENTITY kcedil "ķ" > <!ENTITY Kcedil "Ķ" > <!ENTITY kgreen "ĸ" > <!ENTITY lacute "ĺ" > <!ENTITY Lacute "Ĺ" > <!ENTITY lcaron "ľ" > <!ENTITY Lcaron "Ľ" > <!ENTITY lcedil "ļ" > <!ENTITY Lcedil "Ļ" > <!ENTITY lmidot "ŀ" > <!ENTITY Lmidot "Ĺ" > <!ENTITY lstrok "ł" > <!ENTITY Lstrok "Ł" > <!ENTITY nacute "ń" > <!ENTITY Nacute "Ń" > <!ENTITY eng "ŋ" > <!ENTITY ENG "Ŋ" > <!ENTITY napos "ŉ" > <!ENTITY ncaron "ň" > <!ENTITY Ncaron "Ň" > <!ENTITY ncedil "ņ" > <!ENTITY Ncedil "Ņ" > <!ENTITY odblac "ő" > <!ENTITY Odblac "Ő" > <!ENTITY Omacr "Ō" > <!ENTITY omacr "ō" > <!ENTITY oelig "œ" > <!ENTITY OElig "Œ" > <!ENTITY racute "ŕ" > <!ENTITY Racute "Ŕ" > <!ENTITY rcaron "ř" > <!ENTITY Rcaron "Ř" > <!ENTITY rcedil "ŗ" > <!ENTITY Rcedil "Ŗ" > <!ENTITY sacute "ś" > <!ENTITY Sacute "Ś" > <!ENTITY scaron "š" > <!ENTITY Scaron "Š" > <!ENTITY scedil "ş" > <!ENTITY Scedil "Ş" > <!ENTITY scirc "Ŝ" > <!ENTITY Scirc "ŝ" > <!ENTITY tcaron "ť" > <!ENTITY Tcaron "Ť" > <!ENTITY tcedil "Ţ" > <!ENTITY Tcedil "ţ" > <!ENTITY tstrok "ŧ" > <!ENTITY Tstrok "Ŧ" > <!ENTITY ubreve "ŭ" > <!ENTITY Ubreve "Ŭ" > <!ENTITY udblac "ű" > <!ENTITY Udblac "Ű" > <!ENTITY umacr "ū" > <!ENTITY Umacr "Ū" > <!ENTITY uogon "ų" > <!ENTITY Uogon "Ų" > <!ENTITY uring "ů" > <!ENTITY Uring "Ů" > <!ENTITY utilde "ũ" > <!ENTITY Utilde "Ũ" > <!ENTITY wcirc "ŵ" > <!ENTITY Wcirc "Ŵ" > <!ENTITY ycirc "ŷ" > <!ENTITY Ycirc "Ŷ" > <!ENTITY Yuml "Ÿ" > <!ENTITY zacute "ź" > <!ENTITY Zacute "Ź" > <!ENTITY zcaron "ž" > <!ENTITY Zcaron "Ž" > <!ENTITY zdot "ż" > <!ENTITY Zdot "Ż" > --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/MIDIEvents10.dtd 2007/10/18 15:02:48 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/MIDIEvents10.dtd 2007/10/18 15:02:48 1.1   <!ELEMENT NoteOn EMPTY> <!ATTLIST NoteOn Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired; Note NMTOKEN #REQUIRED Velocity NMTOKEN #REQUIRED> <!ELEMENT NoteOff EMPTY> <!ATTLIST NoteOff Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired; Note NMTOKEN #REQUIRED Velocity NMTOKEN #REQUIRED> <!ELEMENT PolyKeyPressure EMPTY> <!ATTLIST PolyKeyPressure Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired; Note NMTOKEN #REQUIRED Pressure NMTOKEN #REQUIRED> <!ELEMENT ControlChange EMPTY> <!ATTLIST ControlChange Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired; Control NMTOKEN #REQUIRED Value NMTOKEN #REQUIRED> <!ELEMENT ProgramChange EMPTY> <!ATTLIST ProgramChange Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired; Number NMTOKEN #REQUIRED> <!ELEMENT ChannelKeyPressure EMPTY> <!ATTLIST ChannelKeyPressure Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired; Pressure NMTOKEN #REQUIRED> <!ELEMENT PitchBendChange EMPTY> <!ATTLIST PitchBendChange Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired; Value NMTOKEN #REQUIRED>  <!ELEMENT AllSoundOff EMPTY> <!ATTLIST AllSoundOff Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired;> <!ELEMENT ResetAllControllers EMPTY> <!ATTLIST ResetAllControllers Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired;> <!ELEMENT LocalControl EMPTY> <!ATTLIST LocalControl Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired; Value (off|on) #REQUIRED> <!ELEMENT AllNotesOff EMPTY> <!ATTLIST AllNotesOff Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired;> <!ELEMENT OmniOff EMPTY> <!ATTLIST OmniOff Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired;> <!ELEMENT OmniOn EMPTY> <!ATTLIST OmniOn Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired;> <!ELEMENT MonoMode EMPTY> <!ATTLIST MonoMode Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired; Value NMTOKEN #REQUIRED> <!ELEMENT PolyMode EMPTY> <!ATTLIST PolyMode Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired;>  <!ELEMENT ControlChange14 EMPTY> <!ATTLIST ControlChange14 Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired; Control NMTOKEN #REQUIRED Value NMTOKEN #REQUIRED> <!ELEMENT RPNChange EMPTY> <!ATTLIST RPNChange Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired; RPN NMTOKEN #REQUIRED Value NMTOKEN #REQUIRED> <!ELEMENT NRPNChange EMPTY> <!ATTLIST NRPNChange Channel (1|2|3|4|5|6|7|8|9|10|11|12|13|14|15|16) %ChannelRequired; NRPN NMTOKEN #REQUIRED Value NMTOKEN #REQUIRED>  <!ELEMENT SysEx (#PCDATA | SysExDeviceID | SysExChannel)*>  [51 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/attributes.dtd 2007/10/18 15:02:48 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/attributes.dtd 2007/10/18 15:02:48 1.1 [412 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/barline.dtd 2007/10/18 15:02:48 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/barline.dtd 2007/10/18 15:02:48 1.1 [510 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/common.dtd 2007/10/18 15:02:48 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/common.dtd 2007/10/18 15:02:48 1.1 [1154 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/direction.dtd 2007/10/18 15:02:49 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/direction.dtd 2007/10/18 15:02:49 1.1 [1770 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/identity.dtd 2007/10/18 15:02:49 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/identity.dtd 2007/10/18 15:02:49 1.1 [1869 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/layout.dtd 2007/10/18 15:02:55 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/layout.dtd 2007/10/18 15:02:55 1.1 [1989 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/link.dtd 2007/10/18 15:02:55 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/link.dtd 2007/10/18 15:02:55 1.1 [2049 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/midixml.dtd 2007/10/18 15:02:57 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/midixml.dtd 2007/10/18 15:02:57 1.1 [2270 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/midixml.xsl 2007/10/18 15:02:57 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/midixml.xsl 2007/10/18 15:02:57 1.1 [2327 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/note.dtd 2007/10/18 15:02:57 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/note.dtd 2007/10/18 15:02:57 1.1 [3353 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/opus.dtd 2007/10/18 15:02:57 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/opus.dtd 2007/10/18 15:02:57 1.1 [3419 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/parttime.xsl 2007/10/18 15:02:57 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/parttime.xsl 2007/10/18 15:02:57 1.1 [3592 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/partwise.dtd 2007/10/18 15:02:57 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/partwise.dtd 2007/10/18 15:02:57 1.1 [3741 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/score.dtd 2007/10/18 15:02:57 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/score.dtd 2007/10/18 15:02:57 1.1 [4050 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/timepart.xsl 2007/10/18 15:02:57 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/timepart.xsl 2007/10/18 15:02:57 1.1 [4226 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/timewise.dtd 2007/10/18 15:02:57 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/timewise.dtd 2007/10/18 15:02:57 1.1 [4375 lines skipped] --- /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/to10.xsl 2007/10/18 15:02:57 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml-dtds/to10.xsl 2007/10/18 15:02:57 1.1 [4552 lines skipped]

1 0

[gsharp-cvs] CVS gsharp/Mxml
by crhodes 18 Oct '07

18 Oct '07

Update of /project/gsharp/cvsroot/gsharp/Mxml In directory clnet:/tmp/cvs-serv30948/Mxml Added Files: commands.lisp mxml.lisp Log Message: Add MusicXML support. Initial work from Brian Gruber (funded by Google's Summer of Code); subsequent development by Christophe Rhodes. It's far from perfect now, but it needs checking in so that people can play with it. It adds dependencies (puri and cxml) to gsharp; if this is a problem, we could make gsharp-mxml a separate system. Git logs (from git tree at <http://www-jcsu.jesus.cam.ac.uk/~csr21/git/gsharp-mxml/.git>) follow: commit 994cd15ec9f480be41515e699f22e7de1687d0ca Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 24 13:19:41 2007 +0100 Add a restart to the same-duration case. It's not good enough, but it allows interactive fixing key signatures in the middle of the bar. commit cdc2098fac5399303e9515bc81ea65020ec8f109 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 11:07:28 2007 +0100 Only add durations from rhythmic elements. commit acc6cb410cd55dfe59eb30fe608b101a62651ae9 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 10:45:12 2007 +0100 Whoops. Fix export of notes with no displayed accidentals (from overzealous alteration of CASE -> ECASE commit dd8d72cac434a8c5a1932aa46db6447e08d9b6ad Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 10:41:09 2007 +0100 Support for longs in MusicXML (import and export) commit eab440b56b086e766dbd405a3fea44d9976f1a1f Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 09:16:07 2007 +0100 Long ("lunga") patch from HEAD commit 8cb34a4879ebb4dce06d8b99da761dfa6ad24cf9 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:43:51 2007 +0100 Support semi- and sesqui- accidentals commit 6ba8208d1f8475552a95f35a5e896248110b0efd Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:25:16 2007 +0100 Really support breves (and breve rests) -- on output too. commit a9c36278de0145c12f34123a29815809030b97c2 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:17:09 2007 +0100 Slightly batched commit (several changes). * support :breve noteheads * better stringcase macro (and use it) * temporarily hack in "full" = "breve" for Goldsmiths use * use ECASE in one or two places to remove compiler warnings. commit 3a3b980576f0d09ddee4de12f6f7b260932a5552 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:14:54 2007 +0100 Slightly friendlier (with friends like this...) Import and Export commands. Sets the filepath and name of the buffer on import; sensible export default pathname. commit 7d72a2a4a28f9668271189ebaf862518ada34877 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:13:31 2007 +0100 Whitespace commit b497d6f5111f20f5e8ac9a059578d3caaab1b832 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 17 21:33:29 2007 +0100 space requirements fix from HEAD commit 65d173efbcfa78e5edaf1adb9bceb0f7d619002d Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 17 12:04:08 2007 +0100 Update to Brian Gruber's version of 17th September commit 91d98d9e2a8d69418edd264ab6293a2f1dbc5a9f Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 17 11:54:53 2007 +0100 Brian Gruber's patch of August 20th --- /project/gsharp/cvsroot/gsharp/Mxml/commands.lisp 2007/10/18 15:02:48 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/commands.lisp 2007/10/18 15:02:48 1.1 (in-package :gsharp) ;;; like print-buffer-filename in gui.lisp (defun export-buffer-filename () (let* ((buffer (current-buffer)) (filepath (filepath buffer)) (name (name buffer)) (defaults (or filepath (merge-pathnames (make-pathname :name name) (user-homedir-pathname))))) (merge-pathnames (make-pathname :type "xml") defaults))) ;;; like directory-of-current-buffer in esa-io.lisp (defun directory-of-current-buffer () "Extract the directory part of the filepath to the file in the current buffer. If the current buffer does not have a filepath, the path to the user's home directory will be returned." (make-pathname :directory (pathname-directory (or (filepath (current-buffer)) (user-homedir-pathname))))) (define-gsharp-command (com-import-musicxml :name t) ((pathname 'pathname :prompt "Import From: " :prompt-mode :raw :default (directory-of-current-buffer) :default-type 'pathname :insert-default t)) (let* ((buffer (gsharp-mxml::parse-mxml (gsharp-mxml::musicxml-document pathname))) (input-state (make-input-state)) (cursor (make-initial-cursor buffer)) (view (make-instance 'orchestra-view :buffer buffer :cursor cursor))) (setf (view (car (windows *application-frame*))) view (filepath buffer) (merge-pathnames (make-pathname :type "gsh") pathname) (name buffer) (file-namestring (filepath buffer)) (input-state *application-frame*) input-state) (select-layer cursor (car (layers (segment (current-cursor))))))) (define-gsharp-command (com-export-musicxml :name t) ((pathname 'pathname :prompt "Export To: " :prompt-mode :raw :default (export-buffer-filename) :default-type 'pathname :insert-default t)) (let ((string (gsharp-mxml::write-mxml (current-buffer)))) (with-open-file (s pathname :if-does-not-exist :create :if-exists :supersede :direction :output) (write-string string s)))) --- /project/gsharp/cvsroot/gsharp/Mxml/mxml.lisp 2007/10/18 15:02:48 NONE +++ /project/gsharp/cvsroot/gsharp/Mxml/mxml.lisp 2007/10/18 15:02:48 1.1 (in-package :gsharp-mxml) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Utility functions, macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmacro test-make-xml (obj id) `(cxml:with-xml-output (cxml:make-rod-sink :indentation 2 :canonical nil) (make-xml ,obj ,id))) (defun write-buffer-to-xml-file (buffer filename) (with-open-file (s filename :direction :output) (write-string (write-mxml buffer) s))) (defun pcdata (thing) (string-trim '(#\Space #\Tab #\Newline) (dom:node-value (dom:first-child thing)))) (defun named-pcdata (node tag-name) (if (has-element-type node tag-name) (pcdata (elt (dom:get-elements-by-tag-name node tag-name) 0)) nil)) (eval-when (:compile-toplevel :load-toplevel :execute) (defun expander-for-stringcase (keyform cases exhaustivep) (let ((nkey (gensym "KEY"))) (flet ((expand-case (case) (destructuring-bind (keys &rest forms) case (cond ((member keys '(t otherwise)) (when exhaustivep (warn "~S found in ~S" keys 'estringcase)) `(t ,@forms)) ((stringp keys) `((string= ,keys ,nkey) ,@forms)) ((and (consp keys) (every #'stringp keys)) `((or ,@(loop for k in keys collect `(string= ,k ,nkey))) ,@forms)) (t (warn "Unrecognized keys: ~S" keys)))))) `(let ((,nkey ,keyform)) (cond ,@(loop for case in cases collect (expand-case case)) ,@(when exhaustivep `((t (error "~S failed to match any key in ~S" ,nkey 'estringcase)))))))))) (defmacro stringcase (keyform &body cases) (expander-for-stringcase keyform cases nil)) (defmacro estringcase (keyform &body cases) (expander-for-stringcase keyform cases t)) (defun has-element-type (node type-name) (> (length (dom:get-elements-by-tag-name node type-name)) 0)) (defmacro for-named-elements ((name varname node) &body body) (let ((elements (gensym))) `(let ((,elements (dom:get-elements-by-tag-name ,node ,name))) (sequence:dosequence (,varname ,elements) ,@body)))) (defmacro for-children ((varname node) &body body) (let ((children (gensym))) `(let ((,children (dom:child-nodes ,node))) (sequence:dosequence (,varname ,children) ,@body)))) (defun map-all-lists-maximally (fn id-base &rest all-lists) (loop with lists = (copy-list all-lists) for i from id-base until (every #'null lists) collecting (apply fn i (mapcar #'car lists)) do (map-into lists #'cdr lists))) (defun split-if (predicate list) (loop for x in list if (funcall predicate x) collect x into a else collect x into b end finally (return (values a b)))) (defun find-if-nthcdr (predicate n sequence) "Finds the nth element that satisfies the predicate, and returns the cdr with that element as the head" (let ((i 0)) (do ((e sequence (cdr sequence))) ((= i n) e) (when (funcall predicate (car e)) (incf i))))) ;; perhaps these should go in utilities.lisp (defun unicode-to-string (unicode) (map 'string #'gsharp-utilities:unicode-to-char unicode)) (defun string-to-unicode (string) (map 'vector #'gsharp-utilities:char-to-unicode string)) ;;;;;;;;;;;;;;; ;; Notes on mapping ;; ;; gsh maps to mxml pretty well: ;; staff == staff ;; voice == layer ;; cluster == chord ;; ;; Gsharp allows staffs to be in more than one layer, which isn't ;; explicit in mxml but is there: a note has to be in one staff, but ;; the notes in a chord can be in different ones while in the same ;; voice. ;; ;; the mapping seems to break down in that while mxml allows notes in ;; the same chord to be in different voices (though i'm not sure what ;; that would mean), a cluster in gsharp belongs to one layer. this ;; isn't a problem though, because the mapping of chord to cluster is ;; not really one-to-one. ;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;; ;; Import ;;;;;;;;;;;; (defun parse-mxml-note-duration (note-element) "Given a MusicXML note element, return the appropriate Gsharp notehead, dots and beams values." ;; valid types: 256th, 128th, 64th, 32nd, 16th, ;; eighth, quarter, half, whole, breve, and long (let ((notehead (if (has-element-type note-element "type") (estringcase (named-pcdata note-element "type") (("256th" "128th" "64th" "32nd" "16th" "eighth" "quarter") :filled) ("half" :half) ("whole" :whole) (("breve" "full") :breve) ("long" :long)) :filled)) (beams (if (has-element-type note-element "type") (estringcase (named-pcdata note-element "type") ("256th" 6) ("128th" 5) ("64th" 4) ("32nd" 3) ("16th" 2) ("eighth" 1) (("quarter" "half" "whole" "breve" "full" "long") 0)) 0)) (dots (length (dom:get-elements-by-tag-name note-element "dot")))) (values notehead beams dots))) (defparameter *step-to-basenote* '((#\C . 0) (#\D . 1) (#\E . 2) (#\F . 3) (#\G . 4) (#\A . 5) (#\B . 6))) (defun xmlnote-to-gsh (step octave) ;; C4 is middle C is 28 (let ((basenum (cdr (assoc (char-upcase (character step)) *step-to-basenote*)))) (+ 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. (let ((alters (dom:get-elements-by-tag-name note "alter"))) (if (= 0 (length alters)) :natural (let ((alter (pcdata (elt alters 0)))) (stringcase alter ("1" :sharp) ("0" :natural) ("-1" :flat) ("2" :double-sharp) ("1.5" :sesquisharp) ("0.5" :semisharp) ("-0.5" :semiflat) ("-1.5" :sesquiflat) ("-2" :double-flat) (t :natural)))))) (defun parse-mxml-note-staff-number (note) (if (has-element-type note "staff") (1- (parse-integer (named-pcdata note "staff"))) 0)) (defun parse-mxml-note-staff (note staves) "Given an xml note element and a list of all the staff objects, return the staff object the note is supposed to be assigned to. If none is specified, returns the first (hopefully default) staff." (let ((melody-staves (remove-if #'(lambda (s) (not (typep s 'fiveline-staff))) staves))) (elt melody-staves (parse-mxml-note-staff-number note)))) (defun parse-mxml-pitched-note (note staves) (let* ((staff (parse-mxml-note-staff note staves)) (step (named-pcdata note "step")) (octave (parse-integer (named-pcdata note "octave"))) (pitch (xmlnote-to-gsh step octave)) (accidentals (parse-mxml-accidental note)) (tie-left nil) (tie-right nil)) (for-named-elements ("tied" tie note) (estringcase (dom:get-attribute tie "type") ("start" (setf tie-right t)) ("stop" (setf tie-left t)))) (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 ;; multiple notes in a chord that have different durations, types, ;; and dots, something which Gsharp does not support in any way. ;; However, this is not something often run into: if 2 notes struck ;; simultaneously have different rhythmic properties, they are ;; almost always to be notated in separate voices. Supporting the ;; rare case here is quite complicated, as it requires the ;; spontaneous creation of another layer to accommodate it, so for ;; now, this code will assume that all notes in a chord have the ;; same type and dots as the first one mentioned in the MusicXML ;; file. Suggested revision: throw a condition asking the user if ;; they want to omit the note or make it the same duration as the ;; others. ;; Also, this breaks if you have a rest in a chord, which you can ;; have in MusicXML, but I'm not really sure what that would be. (let ((bar (elt bars (if (has-element-type xnote "voice") (1- (parse-integer (named-pcdata xnote "voice"))) 0))) (advance 0)) (multiple-value-bind (notehead beams dots) (parse-mxml-note-duration xnote) (when (has-element-type xnote "lyric") (let* ((xlyric (elt (dom:get-elements-by-tag-name xnote "lyric") 0)) (lyrics-staff (cadr (find-if-nthcdr #'(lambda (s) (not (typep s 'lyrics-staff))) (parse-mxml-note-staff-number xnote) staves))) (lyrics-layer (gethash lyrics-staff lyrics-layer-hash)) (lyrics-bar (car (last (bars (body lyrics-layer))))) (lyrics-element (make-lyrics-element lyrics-staff :notehead notehead :lbeams beams :rbeams beams :dots dots))) ;; TODO there can be multiple lyrics on a given xml-note, ;; presumably for verses or something. Right now this just ;; ignores all but the first one, but this should be addressed. (loop for c across (string-to-unicode (named-pcdata xlyric "text")) do (append-char lyrics-element c)) (add-element-at-duration lyrics-element lyrics-bar *parsing-duration-gmeasure-position*))) (when (has-element-type xnote "rest") (let ((new-rest (make-rest (parse-mxml-note-staff xnote staves) :notehead notehead :lbeams beams :rbeams beams :dots dots))) (add-element-at-duration new-rest bar *parsing-duration-gmeasure-position*) (setf advance (duration new-rest)))) (when (has-element-type xnote "pitch") (progn (unless (has-element-type xnote "chord") (multiple-value-bind (notehead beams dots) (parse-mxml-note-duration xnote) (setf *parsing-in-cluster* (make-cluster :notehead notehead :lbeams beams :rbeams beams :dots dots))) (add-element-at-duration *parsing-in-cluster* bar *parsing-duration-gmeasure-position*) (setf advance (duration *parsing-in-cluster*))) (add-note *parsing-in-cluster* (parse-mxml-pitched-note xnote staves)))) (incf *parsing-duration-gmeasure-position* advance)))) (defun add-element-at-duration (element bar duration-position) ;; go through the bar, adding up the 'duration' value of each element. ;; if the total is less than the desired duration-position, ;; add an empty cluster of the appropriate length, and then add the new element. ;; when the sum is greater than the duration where the element should be placed, look at what the last element was ;; if it's not an empty element ;; throw some kind of error ;; else ;; concatenate empty elements together ;; if there's not enough room, (this is a fairly complicated calculation), error ;; else split up the empty cluster and insert the new element (loop for ecdr = (elements bar) then (cdr ecdr) for e = (car ecdr) for position from 0 until (null ecdr) for edur = (duration e) summing edur into total-duration until (> total-duration duration-position) finally (if (<= total-duration duration-position) ;;(this is going at the end of the bar) (progn (dolist (empty-cluster (generate-empty-clusters (- duration-position total-duration))) (add-element empty-cluster bar position) (incf position)) (add-element element bar position)) (if (is-empty e) (let ((empty-duration (loop for ee in ecdr until (not (is-empty ee)) summing (duration ee)))) ;; make sure there is enough empty space (if (> (duration element) empty-duration) (error "There is not enough empty space to put this element") (progn ;; remove all the empty space (loop for ee in ecdr until (not (is-empty ee)) do (remove-element ee bar)) ;; add back the needed empty preceding space (dolist (empty-cluster (generate-empty-clusters (- duration-position (- total-duration edur)))) (add-element empty-cluster bar position) (incf position)) ;; add the element (add-element element bar position) (incf position) ;; add the trailing empty space (dolist (empty-cluster (generate-empty-clusters (- empty-duration (- duration-position (- total-duration edur)) (duration element)))) (add-element empty-cluster bar position) (incf position))))) ;; FIXME: this restart isn't actually good enough; it ;; is legitimate to have a new element at the same ;; offset from the start of the bar as a previous ;; element, as long as that previous element had zero ;; duration (e.g. key signature) (restart-case (error "There is already a non-empty element here") (add-anyway () (add-element element bar position) (incf position))))))) (defgeneric is-empty (element)) (defmethod is-empty ((element element)) nil) [685 lines skipped]

1 0

[gsharp-cvs] CVS gsharp
by crhodes 18 Oct '07

18 Oct '07

Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv30948 Modified Files: gsharp.asd packages.lisp Log Message: Add MusicXML support. Initial work from Brian Gruber (funded by Google's Summer of Code); subsequent development by Christophe Rhodes. It's far from perfect now, but it needs checking in so that people can play with it. It adds dependencies (puri and cxml) to gsharp; if this is a problem, we could make gsharp-mxml a separate system. Git logs (from git tree at <http://www-jcsu.jesus.cam.ac.uk/~csr21/git/gsharp-mxml/.git>) follow: commit 994cd15ec9f480be41515e699f22e7de1687d0ca Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 24 13:19:41 2007 +0100 Add a restart to the same-duration case. It's not good enough, but it allows interactive fixing key signatures in the middle of the bar. commit cdc2098fac5399303e9515bc81ea65020ec8f109 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 11:07:28 2007 +0100 Only add durations from rhythmic elements. commit acc6cb410cd55dfe59eb30fe608b101a62651ae9 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 10:45:12 2007 +0100 Whoops. Fix export of notes with no displayed accidentals (from overzealous alteration of CASE -> ECASE commit dd8d72cac434a8c5a1932aa46db6447e08d9b6ad Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 10:41:09 2007 +0100 Support for longs in MusicXML (import and export) commit eab440b56b086e766dbd405a3fea44d9976f1a1f Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Wed Sep 19 09:16:07 2007 +0100 Long ("lunga") patch from HEAD commit 8cb34a4879ebb4dce06d8b99da761dfa6ad24cf9 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:43:51 2007 +0100 Support semi- and sesqui- accidentals commit 6ba8208d1f8475552a95f35a5e896248110b0efd Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:25:16 2007 +0100 Really support breves (and breve rests) -- on output too. commit a9c36278de0145c12f34123a29815809030b97c2 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:17:09 2007 +0100 Slightly batched commit (several changes). * support :breve noteheads * better stringcase macro (and use it) * temporarily hack in "full" = "breve" for Goldsmiths use * use ECASE in one or two places to remove compiler warnings. commit 3a3b980576f0d09ddee4de12f6f7b260932a5552 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:14:54 2007 +0100 Slightly friendlier (with friends like this...) Import and Export commands. Sets the filepath and name of the buffer on import; sensible export default pathname. commit 7d72a2a4a28f9668271189ebaf862518ada34877 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Tue Sep 18 15:13:31 2007 +0100 Whitespace commit b497d6f5111f20f5e8ac9a059578d3caaab1b832 Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 17 21:33:29 2007 +0100 space requirements fix from HEAD commit 65d173efbcfa78e5edaf1adb9bceb0f7d619002d Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 17 12:04:08 2007 +0100 Update to Brian Gruber's version of 17th September commit 91d98d9e2a8d69418edd264ab6293a2f1dbc5a9f Author: Christophe Rhodes <csr21(a)omega.localdomain> Date: Mon Sep 17 11:54:53 2007 +0100 Brian Gruber's patch of August 20th --- /project/gsharp/cvsroot/gsharp/gsharp.asd 2007/07/11 15:28:13 1.16 +++ /project/gsharp/cvsroot/gsharp/gsharp.asd 2007/10/18 15:02:47 1.17 @@ -20,7 +20,7 @@ :defaults *gsharp-directory*)) collect `(:file ,(pathname-name p) :pathname ,p)))))) -(gsharp-defsystem (:gsharp :depends-on (:mcclim :flexichain :midi)) +(gsharp-defsystem (:gsharp :depends-on (:mcclim :flexichain :midi :puri :cxml)) "packages" "utilities" "mf" @@ -38,4 +38,6 @@ "modes" "play" "gui" - "fontview") + "fontview" + "Mxml/mxml" + "Mxml/commands") --- /project/gsharp/cvsroot/gsharp/packages.lisp 2007/08/07 11:06:09 1.62 +++ /project/gsharp/cvsroot/gsharp/packages.lisp 2007/10/18 15:02:47 1.63 @@ -177,6 +177,10 @@ #:play-segment #:play-buffer)) +(defpackage :gsharp-mxml + (:use :cl :gsharp-buffer :gsharp-measure) + (:shadowing-import-from :gsharp-buffer #:rest)) + (defpackage :gsharp (:use :clim :clim-lisp :gsharp-utilities :esa :esa-buffer :esa-io :gsharp-buffer :gsharp-cursor :gsharp-drawing :gsharp-numbering

1 0