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))