[gsharp-cvs] CVS gsharp
rstrandh
rstrandh at common-lisp.net
Tue Jan 16 05:21:39 UTC 2007
Update of /project/gsharp/cvsroot/gsharp
In directory clnet:/tmp/cvs-serv21727
Modified Files:
buffer.lisp
Log Message:
Untabify to make editing with Climacs easier.
--- /project/gsharp/cvsroot/gsharp/buffer.lisp 2006/09/14 14:34:47 1.39
+++ /project/gsharp/cvsroot/gsharp/buffer.lisp 2007/01/16 05:21:39 1.40
@@ -54,14 +54,14 @@
(defclass clef (gsharp-object name-mixin)
((print-character :allocation :class :initform #\K)
(lineno :reader lineno :initarg :lineno
- :type (or (integer 2 6) null))))
+ :type (or (integer 2 6) null))))
(defun make-clef (name &key lineno)
(declare (type (member :treble :treble8 :bass :c :percussion) name)
- (type (or (integer 2 6) null) lineno))
+ (type (or (integer 2 6) null) lineno))
(when (null lineno)
(setf lineno
- (ecase name
+ (ecase name
((:treble :treble8) 2)
(:bass 6)
(:c 4)
@@ -115,15 +115,15 @@
((print-character :allocation :class :initform #\=)
(clef :accessor clef :initarg :clef :initform (make-clef :treble))
(%keysig :accessor keysig :initarg :keysig
- :initform (make-array 7 :initial-element :natural))
+ :initform (make-array 7 :initial-element :natural))
(key-signatures :accessor key-signatures :initform nil)))
-
+
(defmethod initialize-instance :after ((obj fiveline-staff) &rest args)
(declare (ignore args))
(with-slots (%keysig) obj
(when (vectorp %keysig)
(setf %keysig
- (make-instance 'key-signature :staff obj :alterations %keysig)))))
+ (make-instance 'key-signature :staff obj :alterations %keysig)))))
(defun make-fiveline-staff (&rest args &key name clef keysig)
(declare (ignore name clef keysig))
@@ -207,32 +207,32 @@
(pitch :initarg :pitch :reader pitch :type (integer 0 127))
(staff :initarg :staff :reader staff :type staff)
(head :initform nil :initarg :head :reader head
- :type (or (member :whole :half :filled) null))
+ :type (or (member :whole :half :filled) null))
(accidentals :initform :natural :initarg :accidentals :reader accidentals
- :type (member :natural :flat :double-flat
- :sharp :double-sharp))
+ :type (member :natural :flat :double-flat
+ :sharp :double-sharp))
(dots :initform nil :initarg :dots :reader dots
- :type (or (integer 0 3) null))
+ :type (or (integer 0 3) null))
(%tie-right :initform nil :initarg :tie-right :accessor tie-right)
(%tie-left :initform nil :initarg :tie-left :accessor tie-left)))
(defun make-note (pitch staff &rest args &key head (accidentals :natural) dots)
(declare (type (integer 0 127) pitch)
- (type staff staff)
- (type (or (member :whole :half :filled) null) head)
- (type (member :natural :flat :double-flat
- :sharp :double-sharp)
- accidentals)
- (type (or (integer 0 3) null) dots)
- (ignore head accidentals dots))
+ (type staff staff)
+ (type (or (member :whole :half :filled) null) head)
+ (type (member :natural :flat :double-flat
+ :sharp :double-sharp)
+ accidentals)
+ (type (or (integer 0 3) null) dots)
+ (ignore head accidentals dots))
(apply #'make-instance 'note :pitch pitch :staff staff args))
(defmethod print-gsharp-object :after ((n note) stream)
(with-slots (pitch staff head accidentals dots %tie-right %tie-left) n
(format stream
- "~_:pitch ~W ~_:staff ~W ~_:head ~W ~_:accidentals ~W ~_:dots ~W ~
+ "~_:pitch ~W ~_:staff ~W ~_:head ~W ~_:accidentals ~W ~_:dots ~W ~
~@[~_:tie-right ~W ~]~@[~_:tie-left ~W ~]"
- pitch staff head accidentals dots %tie-right %tie-left)))
+ pitch staff head accidentals dots %tie-right %tie-left)))
(defun read-note-v3 (stream char n)
(declare (ignore char n))
@@ -265,7 +265,7 @@
(defmethod print-gsharp-object :after ((e element) stream)
(with-slots (notehead rbeams lbeams dots xoffset) e
(format stream
- "~_:xoffset ~W " xoffset)))
+ "~_:xoffset ~W " xoffset)))
(defmethod duration ((element element)) 0)
(defmethod rbeams ((element element)) 0)
@@ -304,21 +304,21 @@
(defmethod print-gsharp-object :after ((e rhythmic-element) stream)
(with-slots (notehead rbeams lbeams dots) e
(format stream
- "~_:notehead ~W ~_:rbeams ~W ~_:lbeams ~W ~_:dots ~W "
- notehead rbeams lbeams dots)))
+ "~_:notehead ~W ~_:rbeams ~W ~_:lbeams ~W ~_:dots ~W "
+ notehead rbeams lbeams dots)))
(defmethod undotted-duration ((element rhythmic-element))
(ecase (notehead element)
(:whole 1)
(:half 1/2)
(:filled (/ (expt 2 (+ 2 (max (rbeams element)
- (lbeams element))))))))
+ (lbeams element))))))))
(defmethod duration ((element rhythmic-element))
(let ((duration (undotted-duration element)))
(do ((dot-duration (/ duration 2) (/ dot-duration 2))
- (nb-dots (dots element) (1- nb-dots)))
- ((zerop nb-dots))
+ (nb-dots (dots element) (1- nb-dots)))
+ ((zerop nb-dots))
(incf duration dot-duration))
duration))
@@ -349,54 +349,54 @@
(defclass key-signature (element)
((%staff :initarg :staff :reader staff)
(%alterations :initform (make-array 7 :initial-element :natural)
- :initarg :alterations :reader alterations)))
+ :initarg :alterations :reader alterations)))
(defun make-key-signature (staff &rest args &key alterations)
(declare (type (or null (simple-vector 7)) alterations)
- (ignore alterations))
+ (ignore alterations))
(apply #'make-instance 'key-signature :staff staff args))
(defmethod print-gsharp-object :after ((k key-signature) stream)
(with-slots (%staff %alterations) k
(format stream
- "~_:staff ~W ~_:alterations ~W " %staff %alterations)))
+ "~_:staff ~W ~_:alterations ~W " %staff %alterations)))
(defmethod more-sharps ((sig key-signature) &optional (n 1))
(let ((alt (alterations sig)))
(loop repeat n
- do (cond ((eq (aref alt 3) :flat) (setf (aref alt 3) :natural))
- ((eq (aref alt 0) :flat) (setf (aref alt 0) :natural))
- ((eq (aref alt 4) :flat) (setf (aref alt 4) :natural))
- ((eq (aref alt 1) :flat) (setf (aref alt 1) :natural))
- ((eq (aref alt 5) :flat) (setf (aref alt 5) :natural))
- ((eq (aref alt 2) :flat) (setf (aref alt 2) :natural))
- ((eq (aref alt 6) :flat) (setf (aref alt 6) :natural))
- ((eq (aref alt 3) :natural) (setf (aref alt 3) :sharp))
- ((eq (aref alt 0) :natural) (setf (aref alt 0) :sharp))
- ((eq (aref alt 4) :natural) (setf (aref alt 4) :sharp))
- ((eq (aref alt 1) :natural) (setf (aref alt 1) :sharp))
- ((eq (aref alt 5) :natural) (setf (aref alt 5) :sharp))
- ((eq (aref alt 2) :natural) (setf (aref alt 2) :sharp))
- ((eq (aref alt 6) :natural) (setf (aref alt 6) :sharp))))))
+ do (cond ((eq (aref alt 3) :flat) (setf (aref alt 3) :natural))
+ ((eq (aref alt 0) :flat) (setf (aref alt 0) :natural))
+ ((eq (aref alt 4) :flat) (setf (aref alt 4) :natural))
+ ((eq (aref alt 1) :flat) (setf (aref alt 1) :natural))
+ ((eq (aref alt 5) :flat) (setf (aref alt 5) :natural))
+ ((eq (aref alt 2) :flat) (setf (aref alt 2) :natural))
+ ((eq (aref alt 6) :flat) (setf (aref alt 6) :natural))
+ ((eq (aref alt 3) :natural) (setf (aref alt 3) :sharp))
+ ((eq (aref alt 0) :natural) (setf (aref alt 0) :sharp))
+ ((eq (aref alt 4) :natural) (setf (aref alt 4) :sharp))
+ ((eq (aref alt 1) :natural) (setf (aref alt 1) :sharp))
+ ((eq (aref alt 5) :natural) (setf (aref alt 5) :sharp))
+ ((eq (aref alt 2) :natural) (setf (aref alt 2) :sharp))
+ ((eq (aref alt 6) :natural) (setf (aref alt 6) :sharp))))))
(defmethod more-flats ((sig key-signature) &optional (n 1))
(let ((alt (alterations sig)))
(loop repeat n
- do (cond ((eq (aref alt 6) :sharp) (setf (aref alt 6) :natural))
- ((eq (aref alt 2) :sharp) (setf (aref alt 2) :natural))
- ((eq (aref alt 5) :sharp) (setf (aref alt 5) :natural))
- ((eq (aref alt 1) :sharp) (setf (aref alt 1) :natural))
- ((eq (aref alt 4) :sharp) (setf (aref alt 4) :natural))
- ((eq (aref alt 0) :sharp) (setf (aref alt 0) :natural))
- ((eq (aref alt 3) :sharp) (setf (aref alt 3) :natural))
- ((eq (aref alt 6) :natural) (setf (aref alt 6) :flat))
- ((eq (aref alt 2) :natural) (setf (aref alt 2) :flat))
- ((eq (aref alt 5) :natural) (setf (aref alt 5) :flat))
- ((eq (aref alt 1) :natural) (setf (aref alt 1) :flat))
- ((eq (aref alt 4) :natural) (setf (aref alt 4) :flat))
- ((eq (aref alt 0) :natural) (setf (aref alt 0) :flat))
- ((eq (aref alt 3) :natural) (setf (aref alt 3) :flat))))))
-
+ do (cond ((eq (aref alt 6) :sharp) (setf (aref alt 6) :natural))
+ ((eq (aref alt 2) :sharp) (setf (aref alt 2) :natural))
+ ((eq (aref alt 5) :sharp) (setf (aref alt 5) :natural))
+ ((eq (aref alt 1) :sharp) (setf (aref alt 1) :natural))
+ ((eq (aref alt 4) :sharp) (setf (aref alt 4) :natural))
+ ((eq (aref alt 0) :sharp) (setf (aref alt 0) :natural))
+ ((eq (aref alt 3) :sharp) (setf (aref alt 3) :natural))
+ ((eq (aref alt 6) :natural) (setf (aref alt 6) :flat))
+ ((eq (aref alt 2) :natural) (setf (aref alt 2) :flat))
+ ((eq (aref alt 5) :natural) (setf (aref alt 5) :flat))
+ ((eq (aref alt 1) :natural) (setf (aref alt 1) :flat))
+ ((eq (aref alt 4) :natural) (setf (aref alt 4) :flat))
+ ((eq (aref alt 0) :natural) (setf (aref alt 0) :flat))
+ ((eq (aref alt 3) :natural) (setf (aref alt 3) :flat))))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Cluster
@@ -425,19 +425,19 @@
(defmethod initialize-instance :after ((c cluster) &rest args)
(declare (ignore args))
(loop for note in (notes c)
- do (setf (cluster note) c)))
+ do (setf (cluster note) c)))
(defun make-cluster (&rest args
- &key (notehead :filled) (lbeams 0) (rbeams 0) (dots 0)
- (xoffset 0) notes (stem-direction :auto))
+ &key (notehead :filled) (lbeams 0) (rbeams 0) (dots 0)
+ (xoffset 0) notes (stem-direction :auto))
(declare (type (member :whole :half :filled) notehead)
- (type (integer 0 5) lbeams)
- (type (integer 0 5) rbeams)
- (type (integer 0 3) dots)
- (type number xoffset)
- (type list notes)
- (type (member :up :down :auto) stem-direction)
- (ignore notehead lbeams rbeams dots xoffset notes stem-direction))
+ (type (integer 0 5) lbeams)
+ (type (integer 0 5) rbeams)
+ (type (integer 0 3) dots)
+ (type number xoffset)
+ (type list notes)
+ (type (member :up :down :auto) stem-direction)
+ (ignore notehead lbeams rbeams dots xoffset notes stem-direction))
(apply #'make-instance 'cluster args))
(defmethod print-gsharp-object :after ((c cluster) stream)
@@ -463,10 +463,10 @@
(defmethod add-note ((cluster cluster) (note note))
(with-slots (notes) cluster
(assert (not (find note notes :test #'note-equal))
- ()
- 'note-already-in-cluster)
+ ()
+ 'note-already-in-cluster)
(setf notes (merge 'list notes (list note) #'note-less)
- (cluster note) cluster)))
+ (cluster note) cluster)))
(defmethod find-note ((cluster cluster) (note note))
(with-slots (notes) cluster
@@ -513,18 +513,18 @@
(staff-pos :initarg :staff-pos :initform 4 :reader staff-pos)))
(defun make-rest (staff &rest args
- &key (staff-pos 4) (notehead :filled) (lbeams 0) (rbeams 0)
- (dots 0) (xoffset 0))
+ &key (staff-pos 4) (notehead :filled) (lbeams 0) (rbeams 0)
+ (dots 0) (xoffset 0))
(declare (type staff staff)
- (type integer staff-pos)
- (type (member :whole :half :filled) notehead)
- (type (integer 0 5) lbeams)
- (type (integer 0 5) rbeams)
- (type (integer 0 3) dots)
- (type number xoffset)
- (ignore staff-pos notehead lbeams rbeams dots xoffset))
+ (type integer staff-pos)
+ (type (member :whole :half :filled) notehead)
+ (type (integer 0 5) lbeams)
+ (type (integer 0 5) rbeams)
+ (type (integer 0 3) dots)
+ (type number xoffset)
+ (ignore staff-pos notehead lbeams rbeams dots xoffset))
(apply #'make-instance 'rest
- :staff staff args))
+ :staff staff args))
(defmethod print-gsharp-object :after ((s rest) stream)
(with-slots (staff staff-pos) s
@@ -546,8 +546,8 @@
((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)
+ :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)))
@@ -556,21 +556,21 @@
(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))))))
+ (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))
+ &key (notehead :filled) (lbeams 0) (rbeams 0)
+ (dots 0) (xoffset 0))
(declare (type staff staff)
- (type (member :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))
+ (type (member :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))
+ :staff staff args))
(defmethod print-gsharp-object :after ((elem lyrics-element) stream)
(with-slots (staff text) elem
@@ -625,7 +625,7 @@
(defmethod initialize-instance :after ((b bar) &rest args)
(declare (ignore args))
(loop for element in (elements b)
- do (setf (bar element) b)))
+ do (setf (bar element) b)))
(defmethod print-gsharp-object :after ((b bar) stream)
(format stream "~_:elements ~W " (elements b)))
@@ -678,7 +678,7 @@
(defun make-melody-bar (&rest args &key elements)
(declare (type list elements)
- (ignore elements))
+ (ignore elements))
(apply #'make-instance 'melody-bar args))
(defmethod make-bar-for-staff ((staff fiveline-staff) &rest args &key elements)
@@ -698,7 +698,7 @@
(defun make-lyrics-bar (&rest args &key elements)
(declare (type list elements)
- (ignore elements))
+ (ignore elements))
(apply #'make-instance 'lyrics-bar args))
(defmethod make-bar-for-staff ((staff lyrics-staff) &rest args &key elements)
@@ -743,11 +743,11 @@
(defmethod initialize-instance :after ((s slice) &rest args)
(declare (ignore args))
(loop for bar in (bars s)
- do (setf (slice bar) s)))
+ do (setf (slice bar) s)))
(defun make-slice (&rest args &key bars)
(declare (type list bars)
- (ignore bars))
+ (ignore bars))
(apply #'make-instance 'slice args))
(defmethod print-gsharp-object :after ((s slice) stream)
@@ -792,8 +792,8 @@
(with-slots (bars) slice
(setf bars (delete bar bars :test #'eq))
(unless bars
- ;; make sure there is one bar left
- (add-bar (make-melody-bar) slice 0)))
+ ;; make sure there is one bar left
+ (add-bar (make-melody-bar) slice 0)))
(setf slice nil)))
(defmethod remove-bar ((bar lyrics-bar))
@@ -802,8 +802,8 @@
(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)))
+ ;; make sure there is one bar left
+ (add-bar (make-lyrics-bar) slice 0)))
(setf slice nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -853,21 +853,21 @@
(unless tail
(setf (tail l) (make-slice :bars (list (make-bar-for-staff staff))))))
(setf (layer (head l)) l
- (layer (body l)) l
- (layer (tail l)) l))
+ (layer (body l)) l
+ (layer (tail l)) l))
(defmethod print-gsharp-object :after ((l layer) stream)
(with-slots (head body tail staves) l
(format stream "~_:staves ~W ~_:head ~W ~_:body ~W ~_:tail ~W "
[169 lines skipped]
More information about the Gsharp-cvs
mailing list