Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv22023 Modified Files: buffer.lisp gui.lisp packages.lisp Log Message: Put back some of the constructor functions. Added more documentation about buffer protocols. Date: Wed Nov 2 06:01:11 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.20 gsharp/buffer.lisp:1.21 --- gsharp/buffer.lisp:1.20 Tue Nov 1 19:08:02 2005 +++ gsharp/buffer.lisp Wed Nov 2 06:01:10 2005 @@ -38,18 +38,18 @@ (lineno :reader lineno :initarg :lineno :type (or (integer 2 6) null)))) -(defmethod initialize-instance :after ((c clef) &rest args) - (declare (ignore args)) - (with-slots (lineno name) c - (check-type name (member :treble :bass :c :percussion)) - (unless (slot-boundp c 'lineno) - (setf lineno - (ecase name +(defun make-clef (name &key lineno) + (declare (type (member :treble :bass :c :percussion) name) + (type (or (integer 2 6) null) lineno)) + (when (null lineno) + (setf lineno + (ecase name (:treble 2) (:bass 6) (:c 4) - (:percussion 3)))))) - + (:percussion 3)))) + (make-instance 'clef :name name :lineno lineno)) + (defmethod print-object :after ((c clef) stream) (format stream ":lineno ~W " (lineno c))) @@ -75,12 +75,14 @@ (defclass fiveline-staff (staff) ((print-character :allocation :class :initform #\=) - (clef :accessor clef :initarg :clef :initform (make-instance 'clef :name :treble)) + (clef :accessor clef :initarg :clef :initform (make-clef :treble)) (keysig :accessor keysig :initarg :keysig - :initform (make-array 7 :initial-element :natural))) - (:default-initargs - :name "default staff")) + :initform (make-array 7 :initial-element :natural)))) +(defun make-fiveline-staff (&rest args &key name clef keysig) + (declare (ignore name clef keysig)) + (apply #'make-instance 'fiveline-staff args)) + (defmethod print-object :after ((s fiveline-staff) stream) (format stream ":clef ~W :keysig ~W " (clef s) (keysig s))) @@ -97,6 +99,10 @@ (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))) @@ -152,15 +158,26 @@ (defclass note (gsharp-object) ((print-character :allocation :class :initform #\N) (cluster :initform nil :initarg :cluster :accessor cluster) - (pitch :initarg :pitch :reader pitch :type (integer 0 128)) - (staff :initarg :staff :reader staff :type (or staff null)) + (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)) (accidentals :initform :natural :initarg :accidentals :reader accidentals :type (member :natural :flat :double-flat :sharp :double-sharp)) (dots :initform nil :initarg :dots :reader dots - :type (or integer null)))) + :type (or (integer 0 3) null)))) + +(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)) + (apply #'make-instance 'note :pitch pitch :staff staff args)) (defmethod print-object :after ((n note) stream) (with-slots (pitch staff head accidentals dots) n @@ -214,10 +231,10 @@ (defclass element (gsharp-object) ((bar :initform nil :initarg :bar :accessor bar) - (notehead :initarg :notehead :accessor notehead) - (rbeams :initarg :rbeams :accessor rbeams) - (lbeams :initarg :lbeams :accessor lbeams) - (dots :initarg :dots :accessor dots) + (notehead :initform :whole :initarg :notehead :accessor notehead) + (rbeams :initform 0 :initarg :rbeams :accessor rbeams) + (lbeams :initform 0 :initarg :lbeams :accessor lbeams) + (dots :initform 0 :initarg :dots :accessor dots) (xoffset :initform 0 :initarg :xoffset :accessor xoffset))) (defmethod print-object :after ((e element) stream) @@ -270,14 +287,26 @@ (defclass cluster (melody-element) ((print-character :allocation :class :initform #\%) (notes :initform '() :initarg :notes :accessor notes) - (stem-direction :initarg :stem-direction :accessor stem-direction) - (stem-length :initform nil :initarg :stem-length :accessor stem-length))) + (stem-direction :initform :auto :initarg :stem-direction :accessor stem-direction))) (defmethod initialize-instance :after ((c cluster) &rest args) (declare (ignore args)) (loop for note in (notes 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)) + (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)) + (apply #'make-instance 'cluster args)) + (defmethod print-object :after ((c cluster) stream) (with-slots (stem-direction notes) c (format stream ":stem-direction ~W :notes ~W " stem-direction notes))) @@ -332,6 +361,20 @@ (staff :initarg :staff :reader staff) (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)) + (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)) + (apply #'make-instance 'rest + :staff staff args)) + (defmethod print-object :after ((s rest) stream) (with-slots (staff staff-pos) s (format stream ":staff ~W :staff-pos ~W " staff staff-pos))) @@ -842,7 +885,7 @@ (defclass buffer (gsharp-object) ((print-character :allocation :class :initform #\B) (segments :initform '() :initarg :segments :accessor segments) - (staves :initform (list (make-instance 'fiveline-staff)) + (staves :initform (list (make-fiveline-staff)) :initarg :staves :accessor staves) (min-width :initform *default-min-width* :initarg :min-width :accessor min-width) (spacing-style :initform *default-spacing-style* :initarg :spacing-style :accessor spacing-style) Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.36 gsharp/gui.lisp:1.37 --- gsharp/gui.lisp:1.36 Tue Nov 1 19:08:02 2005 +++ gsharp/gui.lisp Wed Nov 2 06:01:10 2005 @@ -165,9 +165,8 @@ (lbeams (lbeams cluster)) (dots (dots cluster)) (notes (notes cluster)) - (stem-direction (stem-direction cluster)) - (stem-length (stem-length cluster))) - (declare (ignore stem-direction stem-length notehead lbeams rbeams dots)) + (stem-direction (stem-direction cluster))) + (declare (ignore stem-direction notehead lbeams rbeams dots)) (loop for note in notes do (draw-ellipse* pane xpos (* 15 (note-position note)) 7 0 0 7) (score-pane:draw-accidental pane (accidentals note) @@ -564,12 +563,12 @@ (defun insert-cluster () (let* ((state (input-state *application-frame*)) (cursor (cursor *application-frame*)) - (cluster (make-instance 'cluster - :rbeams (if (eq (notehead state) :filled) (rbeams state) 0) - :lbeams (if (eq (notehead state) :filled) (lbeams state) 0) - :dots (dots state) - :notehead (notehead state) - :stem-direction (stem-direction state)))) + (cluster (make-cluster + :notehead (notehead state) + :lbeams (if (eq (notehead state) :filled) (lbeams state) 0) + :rbeams (if (eq (notehead state) :filled) (rbeams state) 0) + :dots (dots state) + :stem-direction (stem-direction state)))) (insert-element cluster cursor) (forward-element cursor) cluster)) @@ -580,9 +579,7 @@ (defun insert-note (pitch cluster) (let* ((state (input-state *application-frame*)) (staff (car (staves (layer (slice (bar cluster)))))) - (note (make-instance 'note - :pitch pitch - :staff staff + (note (make-note pitch staff :head (notehead state) :accidentals (aref (keysig staff) (mod pitch 7)) :dots (dots state)))) @@ -627,12 +624,11 @@ (define-gsharp-command com-insert-rest () (let* ((state (input-state *application-frame*)) (cursor (cursor *application-frame*)) - (rest (make-instance 'rest + (rest (make-rest (car (staves (layer (cursor *application-frame*)))) :rbeams (if (eq (notehead state) :filled) (rbeams state) 0) :lbeams (if (eq (notehead state) :filled) (lbeams state) 0) :dots (dots state) - :notehead (notehead state) - :staff (car (staves (layer (cursor *application-frame*))))))) + :notehead (notehead state)))) (insert-element rest cursor) (forward-element cursor) rest)) @@ -735,9 +731,7 @@ (let ((element (cur-element))) (if (typep element 'cluster) (let* ((note (cur-note)) - (new-note (make-instance 'note - :pitch (1- (pitch note)) - :staff (staff note) + (new-note (make-note (1- (pitch note)) (staff note) :head (head note) :accidentals (accidentals note) :dots (dots note)))) @@ -753,10 +747,10 @@ (cursor (cursor *application-frame*))) (backward-element cursor) (delete-element cursor) - (insert-element (make-instance 'rest + (insert-element (make-rest staff + :staff-pos (- staff-pos 2) :notehead notehead :dots dots - :rbeams rbeams :lbeams lbeams - :staff staff :staff-pos (- staff-pos 2)) + :rbeams rbeams :lbeams lbeams) cursor) (forward-element cursor))))) @@ -764,9 +758,7 @@ (let ((element (cur-element))) (if (typep element 'cluster) (let* ((note (cur-note)) - (new-note (make-instance 'note - :pitch (1+ (pitch note)) - :staff (staff note) + (new-note (make-note (1+ (pitch note)) (staff note) :head (head note) :accidentals (accidentals note) :dots (dots note)))) @@ -782,19 +774,17 @@ (cursor (cursor *application-frame*))) (backward-element cursor) (delete-element cursor) - (insert-element (make-instance 'rest + (insert-element (make-rest staff + :staff-pos (+ staff-pos 2) :notehead notehead :dots dots - :rbeams rbeams :lbeams lbeams - :staff staff :staff-pos (+ staff-pos 2)) + :rbeams rbeams :lbeams lbeams) cursor) (forward-element cursor))))) (define-gsharp-command com-sharper () (let* ((cluster (cur-cluster)) (note (cur-note)) - (new-note (make-instance 'note - :pitch (pitch note) - :staff (staff note) + (new-note (make-note (pitch note) (staff note) :head (head note) :accidentals (ecase (accidentals note) (:double-sharp :double-sharp) @@ -810,9 +800,7 @@ (define-gsharp-command com-flatter () (let* ((cluster (cur-cluster)) (note (cur-note)) - (new-note (make-instance 'note - :pitch (pitch note) - :staff (staff note) + (new-note (make-note (pitch note) (staff note) :head (head note) :accidentals (ecase (accidentals note) (:double-sharp :sharp) @@ -925,7 +913,7 @@ (let ((staff (accept 'score-pane:fiveline-staff :prompt "Set clef of staff")) (type (accept 'clef-type :prompt "Type of clef")) (line (accept 'integer :prompt "Line of clef"))) - (setf (clef staff) (make-instance 'clef :name type :lineno line)))) + (setf (clef staff) (make-clef type :lineno line)))) (define-gsharp-command com-higher () (incf (last-note (input-state *application-frame*)) 7)) @@ -1054,9 +1042,9 @@ (ecase (accept 'staff-type :prompt "Type") (:fiveline (let* ((clef-name (accept 'clef-type :prompt "Clef type of new staff")) (line (accept 'integer :prompt "Line of clef")) - (clef (make-instance 'clef :name clef-name :lineno line))) - (make-instance 'fiveline-staff :name name :clef clef))) - (:lyrics (make-instance 'lyrics-staff :name name))))) + (clef (make-clef clef-name :lineno line))) + (make-fiveline-staff :name name :clef clef))) + (:lyrics (make-lyrics-staff :name name))))) (define-gsharp-command (com-insert-staff-before :name t) () (add-staff-before-staff (accept 'score-pane:staff :prompt "Insert staff before staff") Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.22 gsharp/packages.lisp:1.23 --- gsharp/packages.lisp:1.22 Tue Nov 1 19:08:02 2005 +++ gsharp/packages.lisp Wed Nov 2 06:01:10 2005 @@ -36,16 +36,18 @@ (defpackage :gsharp-buffer (:use :common-lisp :gsharp-utilities) (:shadow #:rest) - (:export #:clef #:name #:lineno - #:staff #:fiveline-staff - #:lyrics-staff + (:export #:clef #:name #:lineno #:make-clef + #:staff #:fiveline-staff #:make-fiveline-staff + #:lyrics-staff #:make-lyrics-staff #:gsharp-condition - #:pitch #:accidentals #:dots #:note + #:pitch #:accidentals #:dots #:note #:make-note #:note-less #:note-equal #:bar #:notehead #:rbeams #:lbeams #:dots #:element #:melody-element #:notes - #:add-note #:find-note #:remove-note #:cluster - #:rest #:lyrics-element + #:add-note #:find-note #:remove-note + #:cluster #:make-cluster + #:rest #:make-rest + #:lyrics-element #:make-lyrics-element #:slice #:elements #:nb-elements #:elementno #:add-element #:remove-element #:bar #:make-bar @@ -64,7 +66,7 @@ #:rename-staff #:add-staff-to-layer #:remove-staff-from-layer - #:stem-direction #:stem-length #:undotted-duration #:duration + #:stem-direction #:undotted-duration #:duration #:clef #:keysig #:staff-pos #:xoffset #:read-everything #:save-buffer-to-stream #:line-width #:min-width #:spacing-style #:right-edge #:left-offset #:left-margin #:text #:append-char #:erase-char