[gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp gsharp/packages.lisp

[Robert Strandh]

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv22660

Modified Files:
	buffer.lisp gui.lisp packages.lisp 
Log Message:
Improved on the constructors for buffer-related classes.

Date: Mon Nov  7 21:00:52 2005
Author: rstrandh

Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.23 gsharp/buffer.lisp:1.24
--- gsharp/buffer.lisp:1.23	Thu Nov  3 04:40:13 2005
+++ gsharp/buffer.lisp	Mon Nov  7 21:00:52 2005
@@ -477,6 +477,8 @@
 (defmethod print-object :after ((b bar) stream)
   (format stream ":elements ~W " (elements b)))
 
+(defgeneric make-bar-for-staff (staff &rest args &key elements))
+
 (defmethod nb-elements ((bar bar))
   (length (elements bar)))
 
@@ -518,6 +520,10 @@
 	   (ignore elements))
   (apply #'make-instance 'melody-bar args))
 
+(defmethod make-bar-for-staff ((staff fiveline-staff) &rest args &key elements)
+  (declare (ignore elements))
+  (apply #'make-instance 'melody-bar args))
+
 (defun read-melody-bar-v3 (stream char n)
   (declare (ignore char n))
   (apply #'make-instance 'melody-bar (read-delimited-list #\] stream t)))
@@ -534,6 +540,10 @@
 	   (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)))
@@ -672,8 +682,15 @@
    (tail :initarg :tail :accessor tail))
   (:default-initargs :name "default layer"))
 
-(defmethod initialize-instance :after ((l layer) &rest args)
+(defmethod initialize-instance :after ((l layer) &rest args &key head body tail)
   (declare (ignore args))
+  (let ((staff (car (staves l))))
+    (unless head
+      (setf (head l) (make-slice :bars (list (make-bar-for-staff staff)))))
+    (unless body 
+      (setf (body l) (make-slice :bars (list (make-bar-for-staff staff)))))
+    (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))
@@ -683,25 +700,19 @@
     (format stream ":staves ~W :head ~W :body ~W :tail ~W "
 	    staves head body tail)))
 
+(defgeneric make-layer-for-staff (staff &rest args &key staves head body tail))
+
+(defun make-layer (staves &rest args &key head body tail)
+  (declare (type list staves)
+	   (type (or slice null) head body tail)
+	   (ignore head body tail))
+  (apply #'make-layer-for-staff (car staves) :staves staves args))	   
+
 ;;; melody layer
 
 (defclass melody-layer (layer)
   ((print-character :allocation :class :initform #\_)))
 
-(defmethod make-layer (name (initial-staff fiveline-staff))
-  (flet ((make-initialized-slice ()
-	   (make-slice :bars (list (make-melody-bar)))))
-    (let* ((head (make-initialized-slice))
-	   (body (make-initialized-slice))
-	   (tail (make-initialized-slice))
-	   (result (make-instance 'melody-layer
-		      :name name :staves (list initial-staff)
-		      :head head :body body :tail tail)))
-      (setf (slot-value head 'layer) result
-	    (slot-value body 'layer) result
-	    (slot-value tail 'layer) result)
-      result)))
-  
 (defun read-melody-layer-v3 (stream char n)
   (declare (ignore char n))
   (apply #'make-instance 'melody-layer (read-delimited-list #\] stream t)))
@@ -710,25 +721,15 @@
   #'read-melody-layer-v3
   *gsharp-readtable-v3*)
 
+(defmethod make-layer-for-staff ((staff fiveline-staff) &rest args &key staves head body tail)
+  (declare (ignore staves head body tail))
+  (apply #'make-instance 'melody-layer args))
+
 ;;; lyrics layer
 
 (defclass lyrics-layer (layer)
   ((print-character :allocation :class :initform #\M)))
 
-(defmethod make-layer (name (initial-staff lyrics-staff))
-  (flet ((make-initialized-slice ()
-	   (make-slice :bars (list (make-lyrics-bar)))))
-    (let* ((head (make-initialized-slice))
-	   (body (make-initialized-slice))
-	   (tail (make-initialized-slice))
-	   (result (make-instance 'lyrics-layer
-		      :name name :staves (list initial-staff)
-		      :head head :body body :tail tail)))
-      (setf (slot-value head 'layer) result
-	    (slot-value body 'layer) result
-	    (slot-value tail 'layer) result)
-      result)))
-
 (defun read-lyrics-layer-v3 (stream char n)
   (declare (ignore char n))
   (apply #'make-instance 'lyrics-layer (read-delimited-list #\] stream t)))
@@ -737,6 +738,10 @@
   #'read-lyrics-layer-v3
   *gsharp-readtable-v3*)
 
+(defmethod make-layer-for-staff ((staff lyrics-staff) &rest args &key staves head body tail)
+  (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)))
@@ -817,7 +822,7 @@
   (with-slots (layers) s
     (when (null layers)
       (assert (not (null staff)))
-      (push (make-layer "Default layer" staff) layers))
+      (push (make-layer (list staff)) layers))
     (loop for layer in layers
 	  do (setf (segment layer) s))))
 
@@ -864,7 +869,7 @@
       (setf layers (delete layer layers :test #'eq))
       ;; make sure there is one layer left
       (unless layers
-	(add-layer (make-layer "Default layer" (car (staves (buffer segment))))
+	(add-layer (make-layer (staves (buffer segment)))
 		   segment)))
     (setf segment nil)))
 


Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.39 gsharp/gui.lisp:1.40
--- gsharp/gui.lisp:1.39	Mon Nov  7 06:23:57 2005
+++ gsharp/gui.lisp	Mon Nov  7 21:00:52 2005
@@ -441,7 +441,7 @@
 (define-gsharp-command (com-add-layer :name t) ()
   (let* ((name (acquire-unique-layer-name "Name of new layer"))
 	 (staff (accept 'score-pane:staff :prompt "Initial staff of new layer"))
-	 (new-layer (make-layer name staff)))
+	 (new-layer (make-layer staff :name name)))
     (add-layer new-layer (segment (cursor *application-frame*)))
     (select-layer (cursor *application-frame*) new-layer)))
     


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.25 gsharp/packages.lisp:1.26
--- gsharp/packages.lisp:1.25	Mon Nov  7 06:23:57 2005
+++ gsharp/packages.lisp	Mon Nov  7 21:00:52 2005
@@ -55,8 +55,9 @@
 	   #:lyrics-bar #:make-lyrics-bar
 	   #:layer #:lyrics-layer #:melody-layer
 	   #:bars #:nb-bars #:barno #:add-bar #:remove-bar
-	   #:slice
+	   #:slice #:make-slice
 	   #:segment #:slices #:sliceno
+	   #:make-layer-for-staff #:make-bar-for-staff
 	   #:head #:body #:tail #:make-layer #:buffer
 	   #:layers #:nb-layers #:layerno
 	   #:add-layer #:remove-layer #:segment