Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv3417
Modified Files: buffer.lisp gui.lisp packages.lisp Log Message: Removed the function MAKE-NOTE in favor of MAKE-INSTANCE 'NOTE
Date: Mon Oct 31 19:24:39 2005 Author: rstrandh
Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.11 gsharp/buffer.lisp:1.12 --- gsharp/buffer.lisp:1.11 Mon Oct 31 03:16:27 2005 +++ gsharp/buffer.lisp Mon Oct 31 19:24:39 2005 @@ -132,29 +132,12 @@ ;;; currently does not belong to any cluster. (defgeneric cluster (note))
-(defclass note (gsharp-object) - ((print-character :allocation :class :initform #\N) - (cluster :initform nil :initarg :cluster :accessor cluster) - (pitch :initarg :pitch :reader pitch) - (staff :initarg :staff :reader staff) - (head :initarg :head :reader head) - (accidentals :initarg :accidentals :reader accidentals) - (dots :initarg :dots :reader dots))) - -(defmethod print-object :after ((n note) stream) - (with-slots (pitch staff head accidentals dots) n - (format stream - ":pitch ~W :staff ~W :head ~W :accidentals ~W :dots ~W " - pitch staff head accidentals dots))) - -;;; Make a note with the pitch and staff given. -;;; ;;; The pitch is a number from 0 to 128 ;;; ;;; The staff is a staff object. ;;; ;;; Head can be :whole, :half, :filled, or nil. A value of nil means -;;; that the note head is determined by that of the cluster to which the +;;; 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. @@ -163,22 +146,27 @@ ;;; display style. ;;; ;;; The number of dots can be an integer or nil, meaning that the number -;;; of dots is taken from the cluster. +;;; 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. -(defun make-note (pitch &optional staff - (head nil) (accidentals :natural) (dots nil)) - (declare (type (integer 0 128) pitch) - (type (or staff null) staff) - (type (or (member :whole :half :filled) null) head) - (type (member :natural :flat :double-flat :sharp :double-sharp) accidentals) - (type (or integer null) dots)) - (make-instance 'note - :pitch pitch :staff staff - :head head :accidentals accidentals :dots dots)) - + +(defclass note (gsharp-object) + ((print-character :allocation :class :initform #\N) + (cluster :initform nil :initarg :cluster :accessor cluster) + (pitch :initarg :pitch :reader pitch) + (staff :initarg :staff :reader staff) + (head :initform nil :initarg :head :reader head) + (accidentals :initform :natural :initarg :accidentals :reader accidentals) + (dots :initform nil :initarg :dots :reader dots))) + +(defmethod print-object :after ((n note) stream) + (with-slots (pitch staff head accidentals dots) n + (format stream + ":pitch ~W :staff ~W :head ~W :accidentals ~W :dots ~W " + pitch staff head accidentals dots))) + (defun read-note-v3 (stream char n) (declare (ignore char n)) (apply #'make-instance 'note (read-delimited-list #] stream t)))
Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.28 gsharp/gui.lisp:1.29 --- gsharp/gui.lisp:1.28 Mon Oct 31 02:49:47 2005 +++ gsharp/gui.lisp Mon Oct 31 19:24:39 2005 @@ -579,11 +579,12 @@ (defun insert-note (pitch cluster) (let* ((state (input-state *application-frame*)) (staff (car (staves (layer (slice (bar cluster)))))) - (note (make-note pitch - staff - (notehead state) - (aref (keysig staff) (mod pitch 7)) - (dots state)))) + (note (make-instance 'note + :pitch pitch + :staff staff + :head (notehead state) + :accidentals (aref (keysig staff) (mod pitch 7)) + :dots (dots state)))) (setf *current-cluster* cluster *current-note* note) (add-note cluster note))) @@ -732,11 +733,12 @@ (let ((element (cur-element))) (if (typep element 'cluster) (let* ((note (cur-note)) - (new-note (make-note (1- (pitch note)) - (staff note) - (head note) - (accidentals note) - (dots note)))) + (new-note (make-instance 'note + :pitch (1- (pitch note)) + :staff (staff note) + :head (head note) + :accidentals (accidentals note) + :dots (dots note)))) (remove-note note) (add-note element new-note) (setf *current-note* new-note)) @@ -760,11 +762,12 @@ (let ((element (cur-element))) (if (typep element 'cluster) (let* ((note (cur-note)) - (new-note (make-note (1+ (pitch note)) - (staff note) - (head note) - (accidentals note) - (dots note)))) + (new-note (make-instance 'note + :pitch (1+ (pitch note)) + :staff (staff note) + :head (head note) + :accidentals (accidentals note) + :dots (dots note)))) (remove-note note) (add-note element new-note) (setf *current-note* new-note)) @@ -787,16 +790,17 @@ (define-gsharp-command com-sharper () (let* ((cluster (cur-cluster)) (note (cur-note)) - (new-note (make-note (pitch note) - (staff note) - (head note) - (ecase (accidentals note) - (:double-sharp :double-sharp) - (:sharp :double-sharp) - (:natural :sharp) - (:flat :natural) - (:double-flat :flat)) - (dots note)))) + (new-note (make-instance 'note + :pitch (pitch note) + :staff (staff note) + :head (head note) + :accidentals (ecase (accidentals note) + (:double-sharp :double-sharp) + (:sharp :double-sharp) + (:natural :sharp) + (:flat :natural) + (:double-flat :flat)) + :dots (dots note)))) (remove-note note) (add-note cluster new-note) (setf *current-note* new-note))) @@ -804,16 +808,17 @@ (define-gsharp-command com-flatter () (let* ((cluster (cur-cluster)) (note (cur-note)) - (new-note (make-note (pitch note) - (staff note) - (head note) - (ecase (accidentals note) - (:double-sharp :sharp) - (:sharp :natural) - (:natural :flat) - (:flat :double-flat) - (:double-flat :double-flat)) - (dots note)))) + (new-note (make-instance 'note + :pitch (pitch note) + :staff (staff note) + :head (head note) + :accidentals (ecase (accidentals note) + (:double-sharp :sharp) + (:sharp :natural) + (:natural :flat) + (:flat :double-flat) + (:double-flat :double-flat)) + :dots (dots note)))) (remove-note note) (add-note cluster new-note) (setf *current-note* new-note)))
Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.14 gsharp/packages.lisp:1.15 --- gsharp/packages.lisp:1.14 Mon Oct 31 03:16:27 2005 +++ gsharp/packages.lisp Mon Oct 31 19:24:39 2005 @@ -41,7 +41,7 @@ #:lyrics-staff #:make-lyrics-staff #:gsharp-condition #:pitch #:accidentals #:dots #:note - #:make-note #:note-less #:note-equal #:bar + #:note-less #:note-equal #:bar #:notehead #:rbeams #:lbeams #:dots #:element #:melody-element #:notes #:add-note #:find-note #:remove-note #:cluster #:make-cluster