[gsharp-cvs] CVS gsharp
rstrandh
rstrandh at common-lisp.net
Mon Oct 22 09:39:23 UTC 2007
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))
More information about the Gsharp-cvs
mailing list