[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