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)