[gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp gsharp/packages.lisp
Robert Strandh
rstrandh at common-lisp.net
Mon Oct 31 18:24:40 UTC 2005
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
More information about the Gsharp-cvs
mailing list