[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/gsharp.asd gsharp/measure.lisp gsharp/packages.lisp

Robert Strandh rstrandh at common-lisp.net
Mon Nov 21 20:37:46 UTC 2005


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

Modified Files:
	drawing.lisp gsharp.asd measure.lisp packages.lisp 
Log Message:
moved the computation of relative x offsets of notes from drawing.lisp
to measure.lisp.  This required some reorganization of packages.lisp and
gsharp.asd as well.

Date: Mon Nov 21 21:37:45 2005
Author: rstrandh

Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.31 gsharp/drawing.lisp:1.32
--- gsharp/drawing.lisp:1.31	Mon Nov 21 03:11:08 2005
+++ gsharp/drawing.lisp	Mon Nov 21 21:37:45 2005
@@ -4,9 +4,7 @@
   ((yoffset :initform 0 :accessor staff-yoffset)))
 
 (define-added-mixin dnote () note
-  (;; the relative x offset of the note with respect to the cluster
-   (final-relative-note-xoffset :accessor final-relative-note-xoffset)
-   (final-accidental :initform nil :accessor final-accidental)
+  ((final-accidental :initform nil :accessor final-accidental)
    ;; The relative x offset of the accidental of the note with respect
    ;; to the cluster.  A value of nil indicates that accidental has
    ;; not been placed yet
@@ -433,36 +431,6 @@
   (loop for note in notes do
 	(draw-note pane note notehead dots (final-absolute-note-xoffset note) (note-position note))))
 
-;;; given a group of notes (i.e. a list of notes, all displayed on the
-;;; same staff, compute their final x offsets.  This is a question of
-;;; determining whether the note goes to the right or to the left of
-;;; the stem.  The head-note of the stem goes to the left of an
-;;; up-stem and to the right of a down-stem.  The x offset of a cluster
-;;; gives the x position of the head-note. 
-(defun compute-final-relative-note-xoffsets (group direction)
-  (setf group (sort (copy-list group)
-		    (if (eq direction :up)
-			(lambda (x y) (< (note-position x) (note-position y)))
-			(lambda (x y) (> (note-position x) (note-position y))))))
-  (score-pane:with-suspended-note-offset offset
-    ;; the first element of the group is the head-note
-    (setf (final-relative-note-xoffset (car group)) 0)
-    ;; OFFSET is a positive quantity that determines the 
-    ;; absolute difference between the x offset of a suspended
-    ;; note and that of a normally positioned note. 
-    (when (eq direction :down) (setf offset (- offset)))
-    (loop for note in (cdr group)
-	  and old-note = (car group) then note
-	  do (let* ((pos (note-position note))
-		    (old-pos (note-position old-note))
-		    ;; if adjacent notes are just one staff step apart, 
-		    ;; then one must be suspended. 
-		    (dx (if (= (abs (- pos old-pos)) 1) offset 0))) 
-	       (setf (final-relative-note-xoffset note) dx)
-	       ;; go back to ordinary offset
-	       (when (= (abs (- pos old-pos)) 1)
-		 (setf note old-note))))))
-
 ;;; Given a list of notes to be displayed on the same staff line, for
 ;;; each note, compute the accidental to be displayed as a function of
 ;;; the accidentals of the note and the key signature of the staff.
@@ -610,15 +578,6 @@
 	       (setf (final-relative-accidental-xoffset choice)
 		     (accidental-min-xoffset choice notes staff-step))))))
 
-;;; given a list of notes, group them so that every note in the group
-;;; is displayed on the same staff.  Return the list of groups. 
-(defun group-notes-by-staff (notes)
-  (let ((groups '()))
-    (loop while notes do
-	  (push (remove (staff (car notes)) notes :test-not #'eq :key #'staff) groups)
-	  (setf notes (remove (staff (car notes)) notes :test #'eq :key #'staff)))
-    groups))
-
 ;;; draw a cluster.  The stem direction and the stem position have
 ;;; already been computed.  
 ;;; 1. Group notes by staff.
@@ -639,7 +598,6 @@
 	(score-pane:with-vertical-score-position (pane stem-yoffset)
 	  (draw-flags pane element x direction stem-pos)))
       (loop for group in groups do 
-	    (compute-final-relative-note-xoffsets group direction)
 	    (compute-final-accidentals group)
 	    (compute-final-relative-accidental-xoffset group x direction)
 	    (draw-notes pane group (dots element) (notehead element))


Index: gsharp/gsharp.asd
diff -u gsharp/gsharp.asd:1.1 gsharp/gsharp.asd:1.2
--- gsharp/gsharp.asd:1.1	Tue Nov  1 18:19:51 2005
+++ gsharp/gsharp.asd	Mon Nov 21 21:37:45 2005
@@ -27,13 +27,13 @@
    "gf"
    "sdl"
    "charmap"
+   "score-pane"
    "buffer"
    "numbering"
    "Obseq/obseq"
    "measure"
    "postscript"
    "glyphs"
-   "score-pane"
    "beaming"
    "drawing"
    "cursor"


Index: gsharp/measure.lisp
diff -u gsharp/measure.lisp:1.11 gsharp/measure.lisp:1.12
--- gsharp/measure.lisp:1.11	Mon Nov 21 03:11:08 2005
+++ gsharp/measure.lisp	Mon Nov 21 21:37:45 2005
@@ -18,7 +18,17 @@
 ;;; Note
 
 (defrclass rnote note
-  ())
+  (;; the relative x offset of the note with respect to the cluster
+   (final-relative-note-xoffset :accessor final-relative-note-xoffset)))
+
+;;; given a list of notes, group them so that every note in the group
+;;; is displayed on the same staff.  Return the list of groups. 
+(defun group-notes-by-staff (notes)
+  (let ((groups '()))
+    (loop while notes do
+	  (push (remove (staff (car notes)) notes :test-not #'eq :key #'staff) groups)
+	  (setf notes (remove (staff (car notes)) notes :test #'eq :key #'staff)))
+    groups))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
@@ -342,6 +352,39 @@
   (append (merge 'list (butlast bar1) (butlast bar2) #'<)
 	  (list (max (car (last bar1)) (car (last bar2))))))
 
+;;; given a group of notes (i.e. a list of notes, all displayed on the
+;;; same staff, compute their final x offsets.  This is a question of
+;;; determining whether the note goes to the right or to the left of
+;;; the stem.  The head-note of the stem goes to the left of an
+;;; up-stem and to the right of a down-stem.  The x offset of a cluster
+;;; gives the x position of the head-note. 
+(defun compute-final-relative-note-xoffsets (group direction)
+  (setf group (sort (copy-list group)
+		    (if (eq direction :up)
+			(lambda (x y) (< (note-position x) (note-position y)))
+			(lambda (x y) (> (note-position x) (note-position y))))))
+  (score-pane:with-suspended-note-offset offset
+    ;; the first element of the group is the head-note
+    (setf (final-relative-note-xoffset (car group)) 0)
+    ;; OFFSET is a positive quantity that determines the 
+    ;; absolute difference between the x offset of a suspended
+    ;; note and that of a normally positioned note. 
+    (when (eq direction :down) (setf offset (- offset)))
+    (loop for note in (cdr group)
+	  and old-note = (car group) then note
+	  do (let* ((pos (note-position note))
+		    (old-pos (note-position old-note))
+		    ;; if adjacent notes are just one staff step apart, 
+		    ;; then one must be suspended. 
+		    (dx (if (= (abs (- pos old-pos)) 1) offset 0))) 
+	       (setf (final-relative-note-xoffset note) dx)
+	       ;; go back to ordinary offset
+	       (when (= (abs (- pos old-pos)) 1)
+		 (setf note old-note))))))
+
+(defun compute-staff-group-parameters (staff-group stem-direction)
+  (compute-final-relative-note-xoffsets staff-group stem-direction))
+
 ;;; compute some important parameters of an element
 (defgeneric compute-element-parameters (element))
 
@@ -350,20 +393,26 @@
 
 (defmethod compute-element-parameters ((element cluster))
   (when (non-empty-cluster-p element)
-    (compute-top-bot-pos element)))
+    (compute-top-bot-pos element)
+    (loop for staff-group in (group-notes-by-staff (notes element))
+	  do (compute-staff-group-parameters staff-group (final-stem-direction element)))))
 
 (defun compute-beam-group-parameters (elements)
   (let ((any-element-modified nil))
     (loop for element in elements
 	  do (when (modified-p element)
-	       (compute-element-parameters element)
-	       (setf any-element-modified t)
-	       (setf (modified-p element) nil)))
+	       (when (non-empty-cluster-p element)
+		 (compute-top-bot-pos element))
+	       (setf any-element-modified t)))
     (when any-element-modified
       (if (null (cdr elements))
 	  (when (non-empty-cluster-p (car elements))
 	    (compute-final-stem-direction (car elements)))
-	  (compute-final-stem-directions elements)))))
+	  (compute-final-stem-directions elements)))
+    (loop for element in elements
+	  do (when (modified-p element)
+	       (compute-element-parameters element)
+	       (setf (modified-p element) nil)))))
 
 ;;; Given a list of the elements of a bar, return a list of beam
 ;;; groups.  A beam group is defined to be either a singleton list or
@@ -416,18 +465,19 @@
 ;;; to indicate the position of the measure in the sequence of all
 ;;; measures of the buffer.
 (defun compute-measure (bars spacing-style seg-pos bar-pos)
-  (loop for bar in bars
-	do (when (modified-p bar)
-	     (compute-bar-parameters bar)
-	     (setf (modified-p bar) nil)))
-  (let* ((start-times (remove-duplicates
-		       (reduce #'combine-bars
-			       (mapcar #'start-times bars))))
-	 (durations (abs-rel start-times))
-	 (min-dist (reduce #'min durations))
-	 (coeff (loop for duration in durations
-		      sum (expt duration spacing-style))))
-    (make-measure min-dist coeff start-times seg-pos bar-pos bars)))
+  (score-pane:with-staff-size 6
+    (loop for bar in bars
+	  do (when (modified-p bar)
+	       (compute-bar-parameters bar)
+	       (setf (modified-p bar) nil)))
+    (let* ((start-times (remove-duplicates
+			 (reduce #'combine-bars
+				 (mapcar #'start-times bars))))
+	   (durations (abs-rel start-times))
+	   (min-dist (reduce #'min durations))
+	   (coeff (loop for duration in durations
+			sum (expt duration spacing-style))))
+      (make-measure min-dist coeff start-times seg-pos bar-pos bars))))
 
 ;;; Compute all the measures of a segment by stepping through all the
 ;;; bars in parallel as long as there is at least one simultaneous bar.


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.31 gsharp/packages.lisp:1.32
--- gsharp/packages.lisp:1.31	Mon Nov 21 03:11:08 2005
+++ gsharp/packages.lisp	Mon Nov 21 21:37:45 2005
@@ -1,3 +1,16 @@
+(defpackage :esa
+  (:use :clim-lisp :clim)
+  (:export #:minibuffer-pane #:display-message
+	   #:esa-pane-mixin #:previous-command
+	   #:info-pane #:master-pane
+	   #:esa-frame-mixin #:windows #:recordingp #:executingp
+	   #:*numeric-argument-p* #:*current-gesture*
+	   #:esa-top-level #:simple-command-loop
+	   #:global-esa-table #:keyboard-macro-table
+           #:help-table
+	   #:set-key
+           #:find-applicable-command-table))
+
 (defpackage :gsharp-utilities
   (:shadow built-in-class)
   (:use :clim-lisp :clim-mop)
@@ -33,6 +46,20 @@
 	   #:+glyph-flags-up-two+ #:+glyph-flags-up-three+ #:+glyph-flags-up-four+
 	   #:+glyph-flags-up-five+))
 
+(defpackage :score-pane
+  (:use :clim :clim-extensions :clim-lisp :sdl :esa)
+  (:shadow #:rest)
+  (:export #:draw-fiveline-staff #:draw-lyrics-staff
+	   #:draw-stem #:draw-right-stem #:draw-left-stem 
+	   #:draw-ledger-line #:draw-bar-line #:draw-beam #:staff-step
+	   #:draw-notehead #:draw-accidental #:draw-clef #:draw-rest #:draw-dot
+	   #:draw-flags-up #:draw-flags-down
+	   #:with-score-pane #:with-vertical-score-position
+	   #:with-staff-size #:with-notehead-right-offsets
+	   #:with-suspended-note-offset
+	   #:with-notehead-left-offsets #:with-light-glyphs #:score-pane
+	   #:clef #:staff #:fiveline-staff #:lyrics-staff #:notehead))
+
 (defpackage :gsharp-buffer
   (:use :common-lisp :gsharp-utilities)
   (:shadow #:rest)
@@ -104,7 +131,8 @@
 	   #:measure-seq-cost
 	   #:note-position #:non-empty-cluster-p
 	   #:top-note #:bot-note #:top-note-pos #:bot-note-pos
-	   #:beam-groups #:final-stem-direction))
+	   #:beam-groups #:final-stem-direction
+	   #:group-notes-by-staff #:final-relative-note-xoffset))
 
 (defpackage :gsharp-postscript
   (:use :clim :clim-lisp)
@@ -131,33 +159,6 @@
 	   #:8th-flag-down #:extend-flag-down #:whole-rest #:half-rest
 	   #:quarter-rest #:8th-rest #:16th-rest #:32nd-rest #:64th-rest
 	   #:128th-rest #:measure-rest #:double-whole-rest))
-
-(defpackage :esa
-  (:use :clim-lisp :clim)
-  (:export #:minibuffer-pane #:display-message
-	   #:esa-pane-mixin #:previous-command
-	   #:info-pane #:master-pane
-	   #:esa-frame-mixin #:windows #:recordingp #:executingp
-	   #:*numeric-argument-p* #:*current-gesture*
-	   #:esa-top-level #:simple-command-loop
-	   #:global-esa-table #:keyboard-macro-table
-           #:help-table
-	   #:set-key
-           #:find-applicable-command-table))
-
-(defpackage :score-pane
-  (:use :clim :clim-extensions :clim-lisp :sdl :esa)
-  (:shadow #:rest)
-  (:export #:draw-fiveline-staff #:draw-lyrics-staff
-	   #:draw-stem #:draw-right-stem #:draw-left-stem 
-	   #:draw-ledger-line #:draw-bar-line #:draw-beam #:staff-step
-	   #:draw-notehead #:draw-accidental #:draw-clef #:draw-rest #:draw-dot
-	   #:draw-flags-up #:draw-flags-down
-	   #:with-score-pane #:with-vertical-score-position
-	   #:with-staff-size #:with-notehead-right-offsets
-	   #:with-suspended-note-offset
-	   #:with-notehead-left-offsets #:with-light-glyphs #:score-pane
-	   #:clef #:staff #:fiveline-staff #:lyrics-staff #:notehead))
 
 (defpackage :gsharp-beaming
   (:use :common-lisp)




More information about the Gsharp-cvs mailing list